FORTRAN Modules Source

Below are the headers from the FORTRAN modules of the decades-pp library. The source code can be found in the repository on github.

c_airspd.for

C
C ROUTINE          C_AIRSPD SUBROUTINE FORTVAX
C     
C PURPOSE          Derives Indicated and True Airspedd (paras 516 & 517)
C
C DESCRIPTION      True Air Speed is the component of air flow parallel to
C                  the Aircraft's longitudinal axis.
C
C                  IAS =  340.294 
C                         * Mach no. 
C                         * SQRT(Static Pressure[mb]/ 1013.25)      in ms-1
C
C                  TAS =  A/S correction factor 
C                         * 340.294 
C                         * Mach no. 
C                         * SQRT(De-iced True Air Temp[K] / 288.15) in ms-1
C                  
C                  where:
C
C                    288.15   is ICAO Standard temperature [K] at zero altitude.
C                    340.294  is speed of sound [ms-1]         at zero altitude.
C                    Mach no. is computed by subroutine S_MACH.
C
C                  Flagging - If a value can't be computed, due to missing data
C                  missing constants, divide be zeroes, etc, a value of 0 is
C                  used, flagged with a three.  If a value is outside its 
C                  limits for range or rate of change, it is flagged with a two.
C                  If there are no problems with the data it is flagged with 0.
C                  Any flags on input data are propagated through subsequent 
C                  calculations.
C
C VERSION          1.00  020190   A.D.HENNINGS
C
C ARGUMENTS        For Indicated Airspeed:
C                    RDER(IN,576) REAL*4 IN  Derived static pressure in mb
C                    RDER(IN,577) REAL*4 IN  Derived Pitot static pressure in mb
C                                            (samples IN = 1,32 )
C                    RDER(OP,516) REAL*4 OUT Derived Indicated Airspeed  ms-1
C                                            (samples OP = 1,32 )
C                  For True Airspeed:
C                    RCONST(1)    REAL*4 IN  True Airspeed correction factor  
C                    RDER(IN,576) REAL*4 IN  Derived static pressure in mb
C                    RDER(IN,577) REAL*4 IN  Derived Pitot static pressure in mb
C                    RDER(IN,520) REAL*4 IN  Derived De-iced True air temp deg K
C                                            (samples IN = 1,32 )
C                    RDER(IN,525) REAL*4 IN  Derived Non-Deiced True air temp deg K
C                                            (samples IN = 1,32 )
C                    RDER(OP,517) REAL*4 OUT Derived True Airspeed  ms-1
C                                            (samples OP = 1,32 )
C
C SUBPROGRAMS      S_MACH, S_QCPT, ITSTFLG, ISETFLG
C
C REFERENCES       Code adapted from MRF1/HORACE
C                  n.b. RCONST(1) (Air speed correction factor 'K' should be
C                       determined by 'K & Gamma' aircraft runs. The value
C                       in RCONST(1) is unity. Experimental values have been
C                       found between 0.98 and 1.02; (HORACE used 1.002 from 
C                       June 1988 - Jan 1990., value suggested by S.Nicholls
C                       after JASIN experiment).
C
C CHANGES          V1.01  02/06/93  Limit on max rate of change between
C                  adjacent samples has been increased to 3.3 m/s.  This is
C                  based on analysis of the high turbulence A257 flight, where
C                  the histogram of rates of change showed meaningful changes
C                  of up to 3.0 m/s between adjacent samples. (WDNJ)
C                  Also changed so that data with flags of 2 are processed
C                  rather than rejected and flags are stripped from data before
C                  processing. (WDNJ)
C
C                  V1.02 20/06/06 If TAT_DI flag is 2 or more, then takes
C                  temperature input from TAT_NDI (Phil Brown)
C
C*******************************************************************************
      SUBROUTINE C_AIRSPD(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.02'
C
      IMPLICIT  INTEGER*4 (I)
      IMPLICIT  REAL*4    (R)
      INTEGER*4 IRAW(64,512),IFRQ(512)
      REAL*4    RCONST(64),RDER(64,1024)

      DATA      R516ERCNT,R517ERCNT /2*1.0/       !Stores S_QCPT error counts
      DATA      RLV516,RLV517       /2*0.0/       !Stores latest values
      DATA      RLT516,RLT517       /2*0.0/       !Stores latest times
                                                      
      PARAMETER IDATFRQ=32             !Output frequency
      PARAMETER R516MX=140.            !Maximum value for IAS - m/s
      PARAMETER R516MN=0.              !Minimum value for IAS - m/s
      PARAMETER R516RG=3.3             !Max diff between IAS 32 Hz samples - m/s
      PARAMETER R517MX=215.            !Maximum value for TAS - m/s
      PARAMETER R517MN=0.              !Minimum value for TAS - m/s
      PARAMETER R517RG=3.3             !Max diff between TAS 32 Hz samples - m/s
C
C Note that if this routine does not compute the IAS or TAS for any reason then
C CALIBRATE will automatically use values of zero flagged with threes.
C
      SAVE
      RSEC=RDER(1,515)                            !Time, secs past midnight
      ICORFLG=ITSTFLG(RCONST(1))                  !Note correction factr flg
      DO IS=1,IDATFRQ                             !For each data sample
        ISTPFLG=ITSTFLG(RDER(IS,576))             !Note Static press flag
        IPSPFLG=ITSTFLG(RDER(IS,577))             !Note Pitot Static flag
        ITATFLG_DI=ITSTFLG(RDER(IS,520))          !Note DI True Air temp flag
        ITATFLG_NDI=ITSTFLG(RDER(IS,525))         !Note NDI True Air temp flag
        RSTP=RDER(IS,576)                         !Take latest STP
        RTAT_DI=RDER(IS,520)                         !Take latest DI TAT
        RTAT_NDI=RDER(IS,525)                         !Take latest NDI TAT
        CALL ISETFLG(RSTP,0)                      !Clear flag from data
        CALL ISETFLG(RTAT_DI,0)                      !Clear flag from data
        CALL ISETFLG(RTAT_NDI,0)                      !Clear flag from data
C
C Derive Mach Number
C
        IMACFLG=3                                 !Default flag on Mach no
        ITMPFLG=MAX(ISTPFLG,IPSPFLG)     
        IF(ITMPFLG.LT.3.AND.RSTP.GT.0) THEN       !If no flag 3 data
          CALL S_MACH(RDER(IS,576),RDER(IS,577),RMACH) !Compute Mach number
          IMACFLG=ITSTFLG(RMACH)                  !Note Mach no flag
          CALL ISETFLG(RMACH,0)                   !Clear flag from data
        END IF
C
C Derive Indicated Air Speed
C
        IIASFLG=MAX(IMACFLG,ISTPFLG)
        IF(IIASFLG.LT.3.AND.RSTP.GT.0) THEN       !If no flag 3 data
          RDER(IS,516)=340.294*RMACH*SQRT(RSTP/1013.25) !Derive IAS
          CALL S_QCPT(RSEC,RLT516,RDER(IS,516),RLV516, !Quality control point
     -        R516MX,R516MN,R516RG,3.,R516ERCNT,IQFLAG)
          IIASFLG=MAX(IIASFLG,IQFLAG)             !Check Q/C flag
          CALL ISETFLG(RDER(IS,516),IIASFLG)      !Apply flag
        END IF
C
C Derive True Air Speed
C
        RDER(IS,517)=0.0
        CALL ISETFLG(RDER(IS,517),3)              ! default zero-flag3
C
        IF(ITATFLG_DI.LE.1) THEN                  ! If DI TAT OK use for calcs
          ITASFLG=MAX(IMACFLG,ITATFLG_DI,ICORFLG)           
          IF(ITASFLG.LT.3.AND.RTAT_DI.GT.0) THEN       !If no flag 3 data
            RDER(IS,517)=RCONST(1)*340.294*RMACH*SQRT(RTAT_DI/288.15) !Derive TAS
            CALL S_QCPT(RSEC,RLT517,RDER(IS,517),RLV517, !Quality control point
     -          R517MX,R517MN,R517RG,3.,R517ERCNT,IQFLAG)
            ITASFLG=MAX(ITASFLG,IQFLAG)             !Check Q/C flag
            CALL ISETFLG(RDER(IS,517),ITASFLG)      !Apply flag
          ENDIF
        ELSE                                      ! otherwise use NDI TAT
          ITASFLG=MAX(IMACFLG,ITATFLG_NDI,ICORFLG)           
          IF(ITASFLG.LT.3.AND.RTAT_NDI.GT.0) THEN       !If no flag 3 data
            RDER(IS,517)=RCONST(1)*340.294*RMACH*SQRT(RTAT_NDI/288.15) !Derive TAS
            CALL S_QCPT(RSEC,RLT517,RDER(IS,517),RLV517, !Quality control point
     -          R517MX,R517MN,R517RG,3.,R517ERCNT,IQFLAG)
            ITASFLG=MAX(ITASFLG,IQFLAG)             !Check Q/C flag
            CALL ISETFLG(RDER(IS,517),ITASFLG)      !Apply flag
          ENDIF
        ENDIF

      END DO                                      !Next sample
      RETURN
      END

c_check.for

C
C ROUTINE          C_CHECK SUBROUTINE FORTVAX
C
C PURPOSE          Lists the inputs and outputs to a module every call
C
C DESCRIPTION      Types out all the inputs to and all the outputs from
C                  a module in the CALIBRATION program that has been selected
C                  with the /CHECK command option.  This routine is executed
C                  once a second.
C
C VERSION          1.00  1-9-90  N.JACKSON
C
C ARGUMENTS        IM            I*4 IN The number of the module being checked
C                  IDRS(64,512)  I*4 IN The raw data array
C                  RDER(64,1024) I*4 IN The derived data array
C                  IMDINP(32,64) I*4 IN The input parameters(up to 32) for each modl
C                  IMDOUT(32,64) I*4 IN The output params (up to 32) for each module
C                  RCONST(64,64) R*4 IN The constants (up to 64) for each module
C                  INFREQ(512)   I*4 IN The frequency of each input parameter
C                  IOUTFRQ(1024) I*4 IN The frequency of each output parameter
C                  CMDNAME(64)   C*6 IN The name of each module
C
C CHANGES          1.01  13/05/93  W.D.N.JACKSON
C                  Now displays input data as 16 bit rather than 12.
C
********************************************************************************
      SUBROUTINE C_CHECK(IM,IDRS,RDER,IMDINP,IMDOUT,RCONST,INFREQ 
     &   ,IOUTFRQ,CMDNAME)
CDEC$ IDENT 'V1.01'
      INTEGER*4   IM              !The number of the module being checked
      INTEGER*4   IDRS(64,512)    !The raw data array
      REAL*4      RDER(64,1024)   !The derived data array
      INTEGER*4   IMDINP(32,64)   !The input parameters(up to 32) for each modl
      INTEGER*4   IMDOUT(32,64)   !The output params (up to 32) for each module
      REAL*4      RCONST(64,64)   !The constants (up to 64) for each module
      INTEGER*4   INFREQ(512)     !The frequency of each input parameter
      INTEGER*4   IOUTFRQ(1024)   !The frequency of each output parameter
      CHARACTER   CMDNAME(64)*6   !The name of each module
      INTEGER*4   ITSTFLG
      REAL*4      RQRQ

      CHARACTER   CTIM*8
      PARAMETER TT=6

      CALL C_SPMCTIM(NINT(RDER(1,515)),CTIM) !Get the time from para 515 as string
      WRITE(TT,*) CMDNAME(IM)//' for '//CTIM !Write module name and time
C
C Search backwards through constants for first valid one
C Message if none found
C Else write out each valid constant
C
      IC=64                            !Search backwards for constants
      DO WHILE(ITSTFLG(RCONST(IC,IM)).EQ.3.AND.IC.GE.1)
        IC=IC-1
      END DO
      IF(IC.EQ.0) THEN                 !Message if none found
        WRITE(TT,*) 'No constants'
      ELSE
        WRITE(TT,*) 'Constants:'       !Else print them
        DO I=1,IC
          WRITE(TT,10,IOSTAT=IOS)
     &    RCONST(I,IM),ITSTFLG(RCONST(I,IM))
        ENDDO
      END IF
C
C For each parameter in the input list for the module, list all values 
C together with the flag indicator value.
C
      II=1                             !Pointer in module list
      DO WHILE(IMDINP(II,IM).NE.0.AND.II.LE.32) !For each input param
        IP=IMDINP(II,IM)               !Parameter number
        WRITE(TT,*) 'Input parameter ',IP
        IF(IP.LE.512) THEN             !Write raw data as integers
           IF(INFREQ(IP).GT.0) THEN
            DO I=1,INFREQ(IP)
              WRITE(TT,11,IOSTAT=IOS)   
     &        IDRS(I,IP).AND.'FFFF'X 
     &        ,ITSTFLG(IDRS(I,IP))
            ENDDO
           END IF
        ELSE                           !Write derived data as real
          IF(IOUTFRQ(IP).GT.0) THEN
            DO I=1,IOUTFRQ(IP)
              RQRQ=RDER(I,IP)
              CALL ISETFLG(RQRQ,0)
              WRITE(TT,10,IOSTAT=IOS) 
     &        RQRQ,ITSTFLG(RDER(I,IP))
            END DO
          END IF
        END IF
        II=II+1
      END DO
C
C For each parameter in the output list for the module, list all values
C together with the flag indicator value.
C
      II=1                             !Pointer into module list
      DO WHILE(IMDOUT(II,IM).NE.0.AND.II.LE.32) !For each parameter
        IP=IMDOUT(II,IM)               !Parameter number
        WRITE(TT,*) 'Output parameter ',IP !Write out all values
        IF(IOUTFRQ(IP).GT.0) THEN
          DO I=1,IOUTFRQ(IP) 
              RQRQ=RDER(I,IP)
              CALL ISETFLG(RQRQ,0)
            WRITE(TT,10,IOSTAT=IOS)
     &      RQRQ,ITSTFLG(RDER(I,IP))
          ENDDO
        END IF 
        II=II+1
      END DO
      WRITE(TT,*) ' '                  !Blank line at end
      RETURN
10    FORMAT(5(1PE11.4E1,I2,2X))
11    FORMAT(8(I6,I2,2X))
      END

c_comr.for

C
C ROUTINE	C_COMR SUBROUTINE FORTVAX
C
C PURPOSE	A subroutine to calculate Carbon monoxide.
C
C DESCRIPTION	The CO analyser outputs one measurement.
C		This is input to the program as DRS bits, and converted
C		into PPB by multiplying the DRS bits by a calibration factor.
C
C
C TO COMPILE	$FORT C_COMR
C
C VERSION	1.00  8-Jul-2004  	D.Tiddeman
C               1.01  27-OCT-2005
C               1.02
C               1.03 31-JAN-2007 R Purvis Changed timedelay after cal to 20
C               1.04 18-SEP-2007 R Purvis	RCONST(5) added for correction factor
C               1.05 30-JUL-2010 S Bauguitte increased CO flag count threshold from 8000 to 10000
C               1.06 15-OCT-2012 A Wellpott CO upper threshold flagging added. Now values above 
C                                4995 are flagged with 3
C                                                                
C ARGUMENTS	IRAW(1,154) - on entry contains the raw CO signal
C               IRAW(1,223) - on entry contains raw RVSM airspeed
C               IRAW(1,113) - cal info ?
C               RCONST(1,2,3,4) XO and X1 voltage cal for CO, v to ppb, ppb offs
C		RDER(1,782) - on exit contains the derived CO signal
C
C*******************************************************************************
      SUBROUTINE C_COMR(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.06'
      IMPLICIT NONE
      INTEGER*4 IRAW(64,1024),IFRQ(512)                 
      INTEGER*4   IFLG,IS,ITSTFLG
      REAL*4 COMR,RERR
      REAL*4 RCONST(64),RDER(64,1024)
      INTEGER*4 IWASCAL

      SAVE IWASCAL
C
C Set default values
C
      RERR=0.
      CALL ISETFLG(RERR,3)
      RDER(1,782)=RERR

C     Copy across raw signals
C
      COMR=FLOAT(IRAW(1,154))
C
C     Convert CO DRS signals first to voltage, then apply voltage to 
C     ppb conversion, then add instrument offset.
C
      COMR=((RCONST(1)+COMR*RCONST(2))*RCONST(3)+RCONST(4))
      IF(ITSTFLG(RCONST(5)).EQ.0)COMR=COMR*RCONST(5)
C
      IFLG=0
      IF(ITSTFLG(RCONST(8)).EQ.0) THEN
        DO IS=1,32
          IF(IRAW(IS,223).LT.RCONST(8)*62) IFLG=1
        ENDDO
      ENDIF
      IF(COMR.LT.0.) IFLG=2
      IF(COMR.GT.4995.) IFLG=3
      IF(IRAW(1,154).EQ.0) IFLG=3
      IF(IRAW(1,154).EQ.'FFFF'X) IFLG=3
      IF(ITSTFLG(RCONST(6)).EQ.0.AND.ITSTFLG(RCONST(7)).EQ.0)THEN
        IF(COMR.LT.RCONST(6).OR.COMR.GT.RCONST(7))IFLG=3
      ENDIF
C      Changed on 30/07/2010 SB
C      IF(IRAW(1,113).GT.8000) IWASCAL=20
      IF(IRAW(1,113).GT.10000) IWASCAL=20
      IF(IWASCAL.GT.0)THEN
        IFLG=MAX(IFLG,2)
        IWASCAL=IWASCAL-1
      ENDIF
      CALL ISETFLG(COMR,IFLG)
      RDER(1,782)=COMR
C
      RETURN 
      END

c_geneas.for

CDEC$ IDENT 'V1.02'
C
C ROUTINE  	   C_GENEAS     SUBROUTINE FORTVAX
C     
C PURPOSE 	   Derivation of Dew point   
C
C DESCRIPTION      Calculation of Dew Point in K from General Eastern Hygrometer
C                  
C                         529- Dew Point                             [K]
C
C                  The General Eastern Hygrometer (Parameter 58) is recorded 
C                  in binary with a range of 0 to 4095 DRS bits.
C                  A control signal (Parameter 59) is also recorded which 
C                  gives an indication of the amount of heating or cooling
C                  of the mirror.
C                  The instrument should be in control if the signal is between
C                  certain limits. 
C                  Outside these limits it still produces a dew point 
C                  reading,though of doubtful accuracy, and derived data 
C                  is flagged - FLAG = 2.
C                  
C VERSION	   1.00  240190   J HARMER
C                  1.01  17-01-96 D Lauchlan
C ARGUMENTS 
C                  Constants:
C                  GEMAX      Maximum control condition signal limit RCONST(1)
C                  GEMIN      Minimum control condition signal limit RCONST(2)
C                  CALGE(1)   GE Dew point calib. constant x0        RCONST(3)
C                  CALGE(2)   GE Dew point calib. constant x1        RCONST(4)
C                  CALGE(3)   GE Dew point calib. constant x2        RCONST(5)
C
C
C                  Inputs   : 
C                  GENERAL EASTERN 1011 DEW POINT    [drs units ] Para 58
C                  GENERAL EASTERN CONTROL SIGNAL    [drs units ] Para 59
C
C                  Outputs  : 
C                  DEW POINT                            [K]      Para 529
C           
C SUBPROGRAMS
C                  ITSTFLG          Examines bits 16,17 for flags
C                  ISETFLG          Sets flag bits 16,17 = 0 --> 3
C                  S_QCPT           Performs range and rate of change check
C
C REFERENCES 	   Code adapted from MRF1/MRF2
C
C CHANGES          v1.01 17-01-96 D Lauchlan
C                  Unused variables removed
C
C                  V1.02  27/09/02  W.D.N.JACKSON
C                  Changed to include handling of 16 bit data from the new 
C                  DRS.
C------------------------------------------------------------------------------
      SUBROUTINE C_GENEAS   (IRAW,IFRQ,RCONST,RDER)
      IMPLICIT    NONE
      INTEGER*4   IRAW(64,512), IFRQ(512)
      REAL*4      RCONST(64), RDER(64,1024)

      INTEGER   ITSTFLG,IQFLAG,IFLAG3
      INTEGER   IFLAG, IFLAG1, IFLAG2, IS, IQ, IT
      REAL*4    GEMAX,GEMIN,CALGE(3)
      REAL*4    R529MX, R529MN, R529RG,RSEC,RVAL,R
      REAL*4    RLV529, RLT529 ,R529ERCNT               !Previous: Values/Time
      DATA      RLV529, RLT529 /2*0./                   !Init first time through
      DATA      R529ERCNT /1*1.0/                       !Init first time through
      
      PARAMETER (R529MX=324. , R529MN=195. , R529RG=1.)!Limits checks DEWPT [K]
C------------------------------------------------------------------------------
C Check constants and set up arrays, clear flags
      SAVE
      IFLAG=0
      IFLAG1=0
      IFLAG2=0
      IFLAG3=0
      IQFLAG=0
      DO IT=1,5
        IF (ITSTFLG(RCONST(IT)).EQ.3)IFLAG=3              !Check constant flags 
      END DO
C
      GEMAX=RCONST(1)
      GEMIN=RCONST(2)
      DO IQ=3,5
          CALGE(IQ-2)=RCONST(IQ)
      END DO
C           
      RSEC = RDER(1,515)                          !Time: seconds from midnight
C
C Calc dew point temperature from General Eastern 1011 Hygrometer
C      
      IF (IFRQ(58).GT.0.AND.IFRQ(59).GT.0) THEN
        DO IS = 1,IFRQ(58)                                !Loop thro samples
          IFLAG1 = 0                                      !Check quality flag
          IF(IRAW(IS,58).EQ.0.OR.IRAW(IS,58).EQ.'FFFF'X) IFLAG1=3
          IFLAG  = IFLAG1
          IF (IFLAG .LT. 3 ) THEN                         !If there is some data
            R=FLOAT(IRAW(IS,58))                          !Get para 58 raw data
            RDER(IS,529)=CALGE(3)*R**2 + CALGE(2)*R       !Apply calib constants
     -                          + CALGE(1)                ! [deg C]
            RDER(IS,529)=RDER(IS,529)+273.16              !Dew point [K]
            CALL S_QCPT (RSEC,RLT529,RDER(IS,529),RLV529, !Quality control point
     -                 R529MX,R529MN,R529RG,3.,R529ERCNT,IQFLAG)
            IF (IQFLAG .GT. IFLAG) IFLAG = IQFLAG         !Set worst flag
            IQ=((IS * IFRQ(59) - 1) / IFRQ(58)) + 1       !Find control signal 
            IFLAG2 = 0                                    !Check quality flag
            IF(IRAW(IS,59).EQ.0.OR.IRAW(IS,59).EQ.'FFFF'X) IFLAG2=3
            IF (IFLAG2 .GT. IFLAG) IFLAG = IFLAG2         !Set worst flag
            RVAL=FLOAT(IRAW(IS,59))                       !Get para 59 raw data
            IF (RVAL.LT.GEMIN .OR. RVAL.GT.GEMAX) THEN    !Control cond. on
                IFLAG3=2
            ELSE 
                IFLAG3=0
            ENDIF
            IF (IFLAG3.GT.IFLAG) IFLAG = IFLAG3           !Set worst flag
            CALL ISETFLG(RDER(IS,529),IFLAG)              !Put back worst flag
          ENDIF
        END DO
      ENDIF
C     RLV529= RDER(IFRQ(58),529)                          !Preserve last value
C                                                         !Done within S_QCPT
C                                                          !without the flag
C      SAVE RLT529,RLV529                                   !ANSI Fortran

      RETURN

      END

c_grflux.for

C------------------------------------------------------------------------------
C ROUTINE  	   C_RFLUX        SUBROUTINE FORTVAX       [C_RFLUX.FOR]
C     
C PURPOSE 	   CORRECT RAW FLUXES FOR PYRANOMETERS AND PYRGEOMETERS
C                  
C DESCRIPTION      Flux corrections are performed for the six instruments
C                  which are normally configured:
C                  Upward-facing :-  Clear dome and Red dome pyranometers.
C                                    Silver dome pyrgeometer.
C                  Downward-facing:- Clear dome and Red dome pyranometers.
C                                    Silver dome pyrgeometer.
C                  
C                  The actual configuration is specified by the preset array
C                  ICONF, which has six elements whose meaning interpreted as:
C                    1,4 : Clear dome pyranometer  (upper/lower)
C                    2,5 : red    "       "           "     "
C                    3,6 : Silver "   pyrgeometer     "     "
C                  (normally: ICONF(1-3) Upper instruments.
C                             ICONF(4-6) Lower instruments.)
C                  
C                 Check that the normal configuration of instruments is to
C                 be used. Any changes are indicated by the presence of a large
C                 offset to the last calibration constant for any instrument
C                 (i.e. the obscurer indicator constant).
C                 If this is present the offset is interpreted as a revised
C                 ICONF indicator for that instrument. See note below.]
C
C                  n.b. Lower instruments were fitted w.e.f. Flight H797
C                       Upper instruments were fitted w.e.f. Flight H842
C
C                  This value solely determines the control path through the
C                  routine for the processing of each instruments inputs.
C                  Should the configuration aboard the aircraft be changed
C                  the array ICONF should be adjusted accordingly.
C                  e.g. If ICONF(1) was modified := 2; it would imply that the
C                  'channel' contained raw flux, zero-offset and thermistor
C                  values for a red dome - rather than clear - pyranometer.
C                  The value of ICONF(1) i.e. 2 would determine the processing
C                  path, the selection of the appropriate set of constants
C                  to apply for correction and the range checking.
C
C NOTE             CHANGES FROM STANDARD CONFIGURATION.                    
C                  Should the configuration of BBR instruments aboard the 
C                  aircraft be changed e.g. swapping a red dome for clear dome,
C                  the array ICONF is  adjusted accordingly. The mechanism used
C                  is to add an offset to the sixth constant in the calibration 
C                  constants file (i.e. the obscurer) for that instrument.
C                  Example: If the second 'channel' (inputs 674,677,680) which
C                  in the standard configuration is a red dome pyranometer,
C                  was replaced with a second clear dome instrument, the sixth
C                  constant for the second line of the constants for C_RFLUX 
C                  would be changed from 1.0000E+0 to 21.0000E+0, the offset 
C                  decodes to "2" when detected by this program. 
C                  This is assigned to ICONF(2) and would imply that the 
C                  'channel' inputs contain raw flux, zero-offset and thermistor 
C                  values for a red dome - rather than clear dome - pyranometer,
C                  and should be range-checked for that type of output only.
C                 
C                  Corrections applied:
C                  --------------------
C                  Pyranometers (Clear and Red dome) are corrected for:
C                  - Subtraction of a zero offset (mean over past 10 seconds)
C                  - Attitude (pitch and roll) -Upper instruments only.
C                    test if flux is above a critical limit indicating a direct
C                    solar beam component.
C                      If not direct, assume diffuse and apply no attitude corr.
C                      If DIRECT, a geometric correction is used to "level"
C                      the instrument to produce the equivalent hemispheric
C                      downward flux through a horizontal surface (without
C                      inclusion of diffuse component).
C                      The ratio of the Direct:Direct+Diffuse components is
C                      assumed to be 0.95 at present. This value could be
C                      optimised for a particular atmosphere depending on the 
C                      turbidity as a function of height.
C                      
C                      Correct for COSINE effect. (MRF Technical note No.7).
C                      [Pitch and roll offsets of the instrument thermopiles
C                      relative to the aircraft INS platform are derived in
C                      flight by flying a box pattern in cloud-free skies -
C                      These offsets are then used in addition to the INS pitch
C                      and roll (meaned over two seconds). (See MRF Technical
C                      note No 4.) and these values are supplied as arguments 
C                      four and five in each set of CONSTANTS below.
C                  - Time constant of thermopile relative to INS. The mean of
C                    last two seconds of INS pitch/roll angles are used in the
C                    attitude correction, giving an effective difference of
C                    0.5 seconds.
C                  - Correct flux output for proportion of hemispheric dome 
C                    obscured by indicated obscurer pillar. (Rawlins 1986).
C
C                  Pyrgeometers (IR) are corrected for:
C                  - Zero offset (mean over past 10 seconds)
C                  - Temperature sensitivity  (Coefficients in CONSTANTS below)
C                  - Linear dependence 0.2% per degree with sensitivity defined 
C                    as unity at zero C. applied to signal. (MRF Int note No 50)
C                  - Calculation of flux (sigma T^4 correction)
C                    Flux = signal +(sigma* Tsink^4) 
C                    where sigma = Stefan-Boltzmann constant.
C                  _ Upper instrument is corrected for dome transmission
C                    effects (MRF Tech note 3)
C
C VERSION	   1.17 05-09-07   D Tiddeman  
C
C METHOD           1. First time routine is called, assign constants to named
C                     program variables/arrays.
C                     Decide on basis of input constants whether upper instr.
C                     data is available to be processed. 
C                  2. Derive/convert any intermediate results used multiply
C                     within several code sections following.
C                  3. Derive running mean zero-offsets over the past 10 seconds
C                     for each instrument 
C                     
C                  4. Calculate mean pitch and roll values for the current 
C                     second and use them to derive running means for the past 
C                     two seconds.
C                  5. Correct thermistor temperatures for non-linearity.
C                  6. Cycle through each of six instrument input channels.
C                     Use the control variable in ICONF() to select execution
C                     of appropriate code sections.
C                     In all cases; derive a signal zero-offset and reduce the
C                     signal flux by this amount.
C                     Apply temperature-dependance corrections to pyranometers.
C                     For upward-facing pyranometers the 'critical' value to
C                     discriminate between diffuse and direct-sun conditions is
C                           FCRIT  = 920.*(COS(ZENRAD))**1.28 
C                     where ZENRAD : solar zenith angle (in radians)
C                     [N.B. This approximates to the 'German' equation but is
C                      simpler, and does not produce negative values at low
C                      Sun elevations]. 
C                     Correct flux output for proportion of hemispheric dome 
C                     obscured by indicated obscurer pillar. (Rawlins 1986).
C                                                          
C                  7. Range check flux output and set a flag accordingly.
C                     Apply flag values to resulting flux output dependent on
C                     relevant flag settings.
C                  
C ARGUMENTS        RCONST(1),( 7)..(31)  - REAL*4 IN Temperature Sens. coeff a
C                  RCONST(2),( 8)..(32)  - REAL*4 IN Temperature Sens. coeff b
C                  RCONST(3),( 9)..(33)  - REAL*4 IN Temperature Sens. coeff c
C                  RCONST(4),(10)..(34)  - REAL*4 IN Pitch offset of Instrument
C                  RCONST(5),(11)..(35)  - REAL*4 IN Roll  offset of Instrument
C                  RCONST(6),(12)..(36)  - REAL*4 IN Obscurer pillar type.
C                  
C                  RDER(1,par)             REAL*4  IN Six raw flux signals W/M-2
C                             (par=673-675,682-684)
C                  RDER(1,par)             REAL*4  IN six zero-offsets   (W/M-2)
C                             (par=676-678,685-687)
C                  RDER(1,par)             REAL*4  IN six instr. temperatures K
C                             (par=679-681,688-690)
C                  RDER(32,560)            REAL*4  IN INS Roll      (degrees)
C                  RDER(32,561)            REAL*4  IN INS Pitch     (degrees)
C                  RDER(32,562)            REAL*4  IN INS heading   (degrees)
C                  RDER(1,642)             REAL*4  IN Solar azimuth (degrees)
C                  RDER(1,643)             REAL*4  IN Solar zenith  (degrees)
C
C                                                              Pos. Dome  Units
C                  RDER(1,1019)            REAL*4 OUT Corrected Upp Clear W/m-2 
C                  RDER(1,1020)            REAL*4 OUT flux.      "  Red dome " 
C                  RDER(1,1021)            REAL*4 OUT            "  I/R      "
C                  RDER(1,1022)            REAL*4 OUT           Low Clear    "
C                  RDER(1,1023)            REAL*4 OUT            "  Red dome " 
C                  RDER(1,1024)            REAL*4 OUT            "  I/R      " 
C
C SUBPROGRAMS  	   ITSTFLG, ISETFLG, S_RUNM, CORR_THM, RMEANOF, CIRC_AVRG
C
C REFERENCES 	   MRF Internal note  4.
C                   "     "      "   12.
C                   "     "      "   31.
C                   "     "      "   50.
C                   "     "      "   56.
C                  MRF Technical note 3. Pyrgeometer Corrections due to Dome
C                                        Transmission.  February 1991 Kilsby
C                  MRF Technical note 7. Report of Broad-band radiative fluxes
C                                        working group. 17/12/91      Saunders
C                  MRF Technical note 8. Pyramometer calibrationsin Ascension
C                                        of Feb.1992.   4/6/92        Seymour
C                  RAWLINS  R        D/Met.O.(MRF)/13/1      1986.
C                  SAUNDERS R         "        "   "         21/3/90
C                  SAUNDERS R        M/MRF/13/5              22/7/92
C                  
C CHANGES          10/01/91 A.D.Hennings.
C                    Ability to change ICONF to when reconfiguring instrument
C                    fit on A/C using the constants file.
C                  10/01/91 Pitch & Roll averaging changed from 3 to 2 seconds.
C                  25/01/91 Flags assessment changed; use of new flag IFLAG_SUN 
C                  29/01/91 Roll limit checking:replace ROLBAR with ABS(ROLBAR).
C                           Flags assessment changed; IFLAG_OUTPUT being max of
C                           (signal,Pitch,Roll,Zenith) flags.               
C                  30/07/91 FCRIT for Red dome now only used if no clear dome 
C                  16/10/91 Corrected pyrgeometer temp sensitivity correction
C                  20/01/92 Use INS heading instead of obsolete Omega heading.
C                  03/02/92 New subroutine CIRC_AVRG to calc INS mean heading
C                  21/07/92 Levelling of upper pyranometers changed to use 
C                           direct beam component, and cosine effect included.
C                           Recommendations of MRF Tech note 7.   (V1.13)
C                           references to Tech note 8. and M/MRF/13/5
C                  24/07/92 Pyrgeometer corrections for Dome transmission. 
C                           (Downwelling) MRF Tech note 3.             
C                  17/01/96 D Lauchlan
C                           Unused variables removed
C                  22/12/97 W D N Jackson, Flags cleared from all data before
C                           use.
C                  11/08/98 W D N Jackson, Upper pyranometer obscurer
C                           corrections changed to correct values.  The
C                           values have been incorrect in all previous versions
C                           of C_RFLUX. The error is only small. (Source 
C                           P Hignett)
C                  05/09/07 D TIDDEMAN Will use GIN attitude if available rather 
C                           then INU
C
C------------------------------------------------------------------------------
      SUBROUTINE C_GRFLUX     (IRAW,IFRQ,RCONST,RDER)          
CDEC$ IDENT 'V1.17'
C
      IMPLICIT NONE
      INTEGER*4 IRAW(64,512), IFRQ(512)
      REAL*4    RCONST(64), RDER(64,1024)

      INTEGER   ITSTFLG 
      REAL      CIRC_AVRG              !Function returning average of angles
C
C working input data and processed output arrays
C
      REAL*4 ZIN(6),                   !Zero offset samples
     &       RTHM(6),                  !Uncorrected thermistor samples
     &       RFLX(6),                  !Uncorrected flux samples
     &       THM(6),                   !Corrected thermistor samples
     &       FLX(6),                   !Corrected flux samples
     &       PITINS,ROLINS,            !Input pitch & roll (mean of 32hz) degs
     &       PITCH ,ROLL,              !Corrected pitch and roll (Rads)
     &       HDGINS,                   !Input INS heading (degrees)
     &       SOLAZM,SOLZEN,            !Input Solar Azimuth & zenith angle. Rads
     &       HDGRAD,                   !Convert Omega heading to radians
     &       ZENRAD,                   !Convert Solar Zenith ang to radians
     &       AZMRAD,                   !Convert Solar Zenith ang to radians
     &       SUNHDG                    !Sun Heading (Sol Azm-A/c Omega hdg.)Rads
C
C C0NSTANT information
C
      REAL*8    TSA(6)                       !Temperature senstvty alph,beta gm
     -         ,TSB(6)                       !
     -         ,TSG(6)                       !
     -         ,PITOFF(6)                    !Angular offset   " Pitch.
     -         ,ROLOFF(6)                    !Angular offset   " Roll.
      INTEGER*4 IOBTYP(6)                    !Obscurer type (0: none 1:short
                                             !               2: tall)
C
C flags signifying validity of input arguments and derived values.
C
      INTEGER*4 IFLAG_ANG              !Test of sun angle too low
     -         ,IFLAG_ROLL             !INS Roll
     -         ,IFLAG_PIT              !INS Pitch
     -         ,IFLAG_AZM              !Solar azimuth angle
     -         ,IFLAG_ZEN              ! "    zenith   "
     -         ,IFLAG_INHDG            !INS Heading
     -         ,IFLAG_SHDG             !Sun hdg.  Max(IFLAG_AZM and IFLAG_INHDG)
     -         ,IFLAG_SUN              !Sun attitude Max(Pitch/Roll/Zen/Ang)
     -         ,IFLAG_FLX              !Raw flux input
     -         ,IFLAG_THM              !Corrected thermistor 
     -         ,IFLAG_ZER              !Meaned zero-offset
     -         ,IFLAG_SIGNAL           !Max of (IFLAG_FLX and IFLAG_ZER)
     -         ,IFLAG_CORRN            !Max of (all correction flags relevant)
     -         ,IFLAG_OUTPUT           !Max of (IFLAG_SIGNAL and IFLAG_CORRN)
                                       ! and result of range tests on output.
     -         ,IDUM                   !Argument, return value of no interest.
     &         ,IHDG,IPIT,IROL

C  arrays , counters and pointer arguments for Zero-offset mean derivation

      REAL*4    ZBAR(6)                  !Output means over past 10 seconds
      REAL*4    ZBUF(10,6), ZSUM(6)      !Buffer and total holder
      INTEGER*4 IZP(6),     IZCNT(6)     !Buffer pointer and counter of samples.
      DATA      IZP/6*1/,   IZCNT/6*0/   !Initialise ptrs, count of good samples
C
C  arrays , counters and pointer arguments for Pitch and Roll mean derivation
C
      REAL*4    PITBAR,ROLBAR            !Output means over past 2 seconds. degs
      REAL*4    PBUF(3),RBUF(3),PSUM,RSUM!Buffers and total holders
      INTEGER*4 IPPT,IRPT,IPCNT,IRCNT    !Buffer pointer and counter of samples.
      DATA      IPPT,IRPT/1,1/           !Initialise buffer pointers
      DATA      IPCNT,IRCNT/2*0/         !Initialise count of good samples


      LOGICAL   OFIRST/.TRUE./           !Indicator as to first time through rtn

      INTEGER*4 ICONF(6)                !6 input channels (instruments). 
      DATA      ICONF/                  !Control variables- Currently set as:
     -                 1,               !Upper clear dome pyranometer in chan 1
     -                 2,               !      red   dome pyranometer in chan 2
     -                 3,               !      silverdome pyrgeometer in chan 3
     -                 4,               !Lower clear dome pyranometer in chan 4
     -                 5,               !      red   dome pyranometer in chan 5
     -                 6/               !      silverdome pyrgeometer in chan 6

      REAL*4   RMAXFLX(6),RMINFLX(6)    !Range limits on corrected flux.
      DATA     RMAXFLX/                 !Max. admissible corrected flux output
     -             1380.,               !Upward-facing  clear  dome pyranometer
     -              700.,               !               red    dome pyranometer
     -              550.,               !               silver dome pyrgeometer
     -             1380.,               !Downward-facing clear dome pyranometer
     -              700.,               !                red   dome pyranometer
     -              750 /               !                silverdome pyrgeometer
      DATA     RMINFLX/                 !Min. admissible corrected flux output
     -              -20.,               !Upward-facing  clear  dome pyranometer
     -              -20.,               !               red    dome pyranometer
     -              -20.,               !               silver dome pyrgeometer
     -              -20.,               !Downward-facing clear dome pyranometer
     -              -20.,               !                red   dome pyranometer
     -               50./               !                silverdome pyrgeometer

      REAL*4    THETA,RCOSTH              !Angle between Sun and Normal to Instr
      REAL*4    ROLLIM,THTMAX             !Roll max limit: Sun-angle max limit
      PARAMETER (ROLLIM=7.0, THTMAX=80.0) !in degrees.
C
C local variables.
C
      LOGICAL   UPPERS                   !Upper instruments fitted?
      INTEGER*4 IS,IE                    !First and last instrument 'channel'
C      SAVE IS,IE
      INTEGER*4 IN,I                     !Instrument (channel); loop index
      REAL*4    FCRIT,FCRITVAL           !Critical flux value (direct/diffuse)
      REAL*8    SIGMA,                   !Stefan-Boltzmann constant.        
     -          FOBSC,                   !Obscurer value for any instrument
     -          TH,                      !Place holder for corrected thermistor
     -          FL                       !Place holder for corrected flux
      REAL*4    DEG2RD                   !Degrees to radians conversion factor
      REAL*4    RTEMP,                   !Temp vrb: used with ICONF changes.
     -          ROBTYP                   ! "    " : specify Obscurer type used.
      INTEGER*4 ITYPE,ISIG,ICOR          !Indices to data tables
C
C  levelling corrections
C                                       !Select INDX of solar zenith angle
      INTEGER*4 INDX                    !where  INDX = NINT(SOLZEN/10) + 1
                                        !INDX
                                        !1-3: (0 -29.9 deg)
                                        !4-6: (30-59.9 deg)
                                        !7-9: (60-89.9 deg)
                                        !10:  (  >89.9 deg)

      REAL*4    CEFF(10)/1.010, 1.005, 1.005, !Correction to pyranometers for  
     &                   1.005, 1.000, 0.995, !COSINE effect dependant on solar
     &                   0.985, 0.970, 0.930, !zenith angle. Determined by expt
     &                   0.930/               !Ref: Tech note 8. Table 4       
                                               
      REAL*4    FDIR(10)/.95,.95,.95,   !(Proportion of flux from direct source
     &                   .95,.95,.95,   !for varying solar zenith angles.)     
     &                   .95,.95,.95,   !Addressed by INDX as above.            
     &                   .95/           !Ref: M/MRF/13/5                       
                                                                               
                                        
C     table of proportion of hemispheric dome obscured by each pillar-type

      REAL*4    ROBSC(3,6)               !Obscurer corrections (Type,Up|Loc)
      DATA ((ROBSC(ITYPE,IN),IN=1,6),ITYPE=1,3)/    !Ref:RAWLINS 1986       
      !    Upper Instruments  |   Lower instruments      
      !Port    Starbd  Centre  Port    Starbd  Centre
     & 00.000, 00.000, 00.000, 00.000, 00.000, 00.000,  ! No pillar (Ind=1)
     & 00.010, 00.010, 00.000, 00.000, 00.000, 00.000,  ! Short "   ( "  2)
     & 00.040, 00.040, 00.000, 00.000, 00.000, 00.000/  ! Tall  "   ( "  3)
! The following lines contain the incorrect upper pyranometer corrections which
! have been used in all previous versions of C_RFLUX (WDNJ 11/8/98).
!     & 00.016, 00.016, 00.000, 00.000, 00.000, 00.000,  ! Short "   ( "  2)
!     & 00.046, 00.046, 00.000, 00.000, 00.000, 00.000/  ! Tall  "   ( "  3)

C     logic table combining two group input flag conditions resulting in an 
C     output flag.

      INTEGER*4 IFLAG_TABLE(0:3,0:3)
      DATA ((IFLAG_TABLE(ISIG,ICOR),ICOR=0,3),ISIG=0,3)/
      !        CORRECTION
      !     0   1   2   3 
      !   -------------------                 See Saunders LM 1990 for
     -      0,  1,  3,  3,  ! 0               details of this table.
     -      1,  2,  3,  3,  ! 1  SIGNAL
     -      2,  2,  3,  3,  ! 2
     -      3,  3,  3,  3  /! 3
      
      PARAMETER (SIGMA  = 5.669E-08)      
      PARAMETER (DEG2RD = 57.295776)     
      SAVE
!-----------------------------------------------------------------------------
!+
!  1. First time routine is called, assign constants to named
!     program variables/arrays.


      IF (OFIRST) THEN   
        OFIRST= .FALSE.
!
!       Prior to Flight H842 no upper radiometers were recorded in this form;
!       hence no data constants are passed to this routine. Check for condition.
!
        UPPERS = .FALSE.
        DO IN = 1 ,18                             !Any non-zero value indicates
        IF (RCONST(IN) .NE. 0.)  UPPERS = .TRUE.  !constants are being passed 
        END DO                                    !for upper instruments too.
!
!       Set 'channel' limits accordingly.
!
        IF (UPPERS) THEN           
          IS = 1                     !all six instrument present
          IE = 6
        ELSE
          IS = 4                     !only lower instruments fitted
          IE = 6
        ENDIF

!                       Put RCONST values into program variables.)
        DO IN = IS,IE
          TSA(IN)    = RCONST((IN-1)*6 +1) !Temperature sensitivity coefficents
          TSB(IN)    = RCONST((IN-1)*6 +2) ! Alpha, Beta, Gamma                
          TSG(IN)    = RCONST((IN-1)*6 +3) !
          PITOFF(IN) = RCONST((IN-1)*6 +4) !Pitch offset of instrument
          ROLOFF(IN) = RCONST((IN-1)*6 +5) !Pitch offset of instrument

!         Check whether the configuration has been modified by examining the 
!         last constant for each instrument (=IOBTYP). If it is >10 an offset
!         has been added to it; identify this and restore correct constant.
!
          RTEMP = RCONST((IN-1)*6 +6)            !Get obscurer value (+offset?)
          IF (ABS(RTEMP) .GE. 10.0) THEN         !An offset has been added.
              RTEMP      = RTEMP/10.             !Bring the offset into the
              ICONF(IN)  = INT(RTEMP)            !truncate range |1 - 6|>ICONF()
              ROBTYP     = (RTEMP-ICONF(IN))*10. !Restore the Obscurer const.
              ICONF(IN)  = IABS(ICONF(IN))       !Config indicator must be +ve.
              IOBTYP(IN) = NINT(ROBTYP)          !assign Obscurer type in use
                                                 !(1: none, 2: short, 3: tall)

          ELSE                                   !use default ICONF values
              IOBTYP(IN) = NINT(RTEMP)           !Obscurer type in use
          ENDIF

        END DO                           !next instrument.
      ENDIF                              !of First-time-through actions.
!-

!+
!  2. Derive/convert any intermediate results used several times
!     within code sections following.
!
!     Put input data into arrays. 

      IF (UPPERS) THEN
        DO IN = 1,3                              !Upper instruments
          RFLX (IN)  = RDER(1,673+IN -1)         !  Signal       w/m-2
          ZIN  (IN)  = RDER(1,676+IN -1)         !  zero         w/m-2
          RTHM (IN)  = RDER(1,679+IN -1)         !  thermistor   deg K
        END DO
      ENDIF

      DO IN = 1,3                                !Lower instruments
        RFLX (IN+3) = RDER(1,682+IN -1)          !  Signal       w/m-2
        ZIN  (IN+3) = RDER(1,685+IN -1)          !  zero         w/m-2
        RTHM (IN+3) = RDER(1,688+IN -1)          !  thermistor   deg K
      END DO

      IROL=560
      IPIT=561
      IHDG=562
      if(ITSTFLG(RDER(1,616)).EQ.0)IROL=616
      if(ITSTFLG(RDER(1,617)).EQ.0)IPIT=617
      if(ITSTFLG(RDER(1,618)).EQ.0)IHDG=618

      HDGINS = CIRC_AVRG( RDER(1,IHDG), 32)       !Mean of INS Heading samples
                                                 !(special for circular values)
      SOLAZM        = RDER(1,642)                !Solar azimuth angle
      SOLZEN        = RDER(1,643)                !Solar zenith   "
!-

!+    set flags for corrections

      IFLAG_INHDG = ITSTFLG (HDGINS)             !Flag of INS   heading
      CALL ISETFLG(HDGINS,0)                     !Strip flag
      IFLAG_ZEN   = ITSTFLG (SOLZEN)             !Flag of solar zenith angle
      CALL ISETFLG(SOLZEN,0)                     !Strip flag
      IFLAG_AZM   = ITSTFLG (SOLAZM)             !Flag of solar azimuth angle
      CALL ISETFLG(SOLAZM,0)                     !Strip flag
      IFLAG_SHDG  = MAX(IFLAG_INHDG,IFLAG_AZM)   !Choose higher heading flag
!-

!+    Convert samples to radians measure.

      HDGRAD = HDGINS /DEG2RD            !Convert INS   heading to radians   
      ZENRAD = SOLZEN/DEG2RD             !Convert Solar Zenith ang to radians
      AZMRAD = SOLAZM/DEG2RD             !Convert Solar Zenith ang to radians
      SUNHDG = AZMRAD - HDGRAD           !Sun Heading (Solar Az-A/C hdg (INS))
!-

      IF (SOLZEN .GT. 0. .AND. SOLZEN .LT.90.)THEN !Prevent exponentiation error
      FCRIT  = 920.*(COS(ZENRAD))**1.28  !Critical flux value (direct/diffuse)
      ENDIF

!+  3. Derive running mean of zero offsets for each instrument over ten seconds
       

      DO I=IS,IE
      CALL S_RUNM(ZBUF(1,I),IZP(I),IZCNT(I),10,ZIN(I),ZSUM(I),ZBAR(I))
      END DO

!-

!+  4. means of 32hz INS PITCH & ROLL arguments for one second.

   
      CALL RMEANOF(32 ,RDER(1,IROL), ROLINS, IDUM) !Mean of INS Roll samples.
      CALL RMEANOF(32 ,RDER(1,IPIT), PITINS, IDUM) !Mean of  "  Pitch  "    .

!    then derive running mean of pitch and roll values. (meaned over two secs)

      CALL S_RUNM(RBUF,IRPT,IRCNT,2,ROLINS,RSUM,ROLBAR)         !Roll
      CALL S_RUNM(PBUF,IPPT,IPCNT,2,PITINS,PSUM,PITBAR)         !Pitch

!     Set Pitch flag, no acceptability test currently used.

      IFLAG_PIT = ITSTFLG (PITBAR)
      CALL ISETFLG(PITBAR,0)                   !Strip flag

!     Roll limit acceptable?

      IFLAG_ROLL= ITSTFLG (ROLBAR)             !Flag of meaned Roll.
      CALL ISETFLG(ROLBAR,0)                   !Strip flag
      IF ( ABS(ROLBAR) .GT. ROLLIM)            !Comparison in degrees
     -    IFLAG_ROLL= MAX(IFLAG_ROLL,1)        !Flag if Roll too great

!  5.  Correct thermistor values for linearity
      
      CALL CORR_THM (RTHM,THM)                 !Input temps deg K, output deg C

!-----------------------------------------------------------------------------

      DO IN = IS,IE                        !Cycle through available instruments

      FOBSC     = ROBSC(IOBTYP(IN),IN)     !select correction for obscurer
      IFLAG_CORRN  = 0                     !Set corrections flag to valid
      IFLAG_FLX = ITSTFLG (RFLX(IN))       !Flag of raw flux input
      CALL ISETFLG(RFLX(IN),0)             !Strip flag
      IFLAG_ZER = ITSTFLG (ZBAR(IN))       !Flag of meaned zero-offset
      CALL ISETFLG(ZBAR(IN),0)             !Strip flag
      IFLAG_THM = ITSTFLG (THM (IN))       !Flag of corrected thermistor.
      CALL ISETFLG(THM (IN),0)             !Strip flag
                                           
      IFLAG_SIGNAL= MAX(IFLAG_FLX,IFLAG_ZER) !Obtain worst of (flx,zero) flag.

      IF (IFLAG_SIGNAL .EQ. 3) THEN         !**** Check Flux validity
         FLX(IN) =  -99.                    !Set output to 'failed' value.
         IFLAG_OUTPUT=  3                   !'Failed' flag.

      !------------------------------------------------------------------
      ELSE                                  ! OK to begin correcting flux.

        FLX(IN) = RFLX(IN) - ZBAR(IN)       !Subtract meaned zero-offset.

!       Perform temperature sensitivity correction. 

          IF (IFLAG_THM .LT. 2) THEN               !Thermistor temperatures
            FL      = FLX(IN)                      !have been corrected and 
            TH      = THM(IN)                      !converted  to C by CORR_THM.
            FLX(IN) = FL /
     -               (1.+ TH*(TSA(IN)         
     -                  + TH*(TSB(IN) 
     -                  + TH* TSG(IN) )))
          ENDIF

        !----------------------------------------------------------------------
        IF (ICONF(IN) .EQ. 3 .OR. ICONF(IN) .EQ. 6) THEN  !*** Pyrgeometers only
        !----------------------------------------------------------------------

!         Perform 'sigma* Tsink^4' correction

          IF (IFLAG_THM .LT. 2) THEN               
            FL = FLX(IN)                           
            FLX(IN) =FL * (1.0/(1.0-FOBSC))+SIGMA*(TH+273.16)**4
          ENDIF 
                                         !Correction to upper Pyrgeometer for   
                                         !dome transmission of downwelling I/R. 
          IF (ICONF(IN) .EQ. 3 )THEN      
            FLX(IN) = FLX(IN) + (-6.0 + 0.0175* FLX(IN))!see Tech note 3. page 2
          ENDIF                                    

          IFLAG_CORRN = IFLAG_THM                       !Relevant corrections
          IFLAG_OUTPUT = IFLAG_TABLE(IFLAG_SIGNAL,IFLAG_CORRN)

        !----------------------------------------------------------------------
        ELSE                      !Upper and Lower Pyranometer corrections 
        !----------------------------------------------------------------------

          IF (ICONF(IN) .EQ. 4 .OR. ICONF(IN) .EQ. 5) THEN  !Lower pyranometers

             FLX(IN)= FLX(IN)*(1.0/(1.0- FOBSC))            !Obscurer corr'n. 
                                                            !All corr'n complete
             IFLAG_CORRN = 0                                !no relevant corrs
             IFLAG_OUTPUT = IFLAG_TABLE(IFLAG_SIGNAL,IFLAG_CORRN)

          ELSE                                              !Upper Pyranometers

!+          Compare incoming flux with Fcrit (Critical value) of expected flux.
!           IF Flux > Fcrit; treat irradiation as being DIRECT.      
!           ELSE             assume it is DIFFUSE irradiation.        
!             (n.b. for RED dome, Fcrit value used is 1/2 normal Fcrit.) 

            FCRITVAL = FCRIT
            IF( ICONF(1)  .NE.  1) FCRITVAL = FCRIT * .5    !1/2 For RED dome.

            IF (FLX(1)  .GT. FCRITVAL) THEN                 !*Direct or Diffuse?
!-
                                                                     
!+            DIRECT is appropriate; check angle between Sun & normal-to-
!             instrument is not > 80 deg, before correction for platform level.

              PITCH=PITBAR + PITOFF(IN) !Combine  A/C mean and Inst offset Pitch
              PITCH=PITCH/DEG2RD        !.. and convert to radians
              ROLL =ROLBAR + ROLOFF(IN) !Combine A/C  mean and Inst offset Roll 
              ROLL = ROLL/DEG2RD        !.. and convert to radians

!             Find angle between Solar zenith and normal-to-Instrument.
                                                        !Ref:Tech note 7 Page 10
                                                        !Derive cosine of angle.
              RCOSTH = SIN(ROLL)*SIN(ZENRAD)*SIN(SUNHDG)
     &              +  COS(ROLL)*COS(PITCH) *COS(ZENRAD)
     &              -  COS(ROLL)*SIN(PITCH) *SIN(ZENRAD)*COS(SUNHDG)
              THETA = ACOS(RCOSTH)            !Express angle in radians

!             Compare with maximum allowable angle. ( must be < 80 Deg)

              IF (THETA .GT. THTMAX/DEG2RD) THEN 
                IFLAG_ANG =  2                !Failed Low sun test; Flag value  
              ELSE
                IFLAG_ANG =  0                !Angle Sun/Instr acceptable.
              ENDIF                                                         

!             Apply levelling correction using combined pitch and roll, if
!             necessary conditions are met:-

              IFLAG_CORRN = MAX (IFLAG_PIT,  IFLAG_ROLL)  !A/c  Attitude flags.
              IFLAG_CORRN = MAX (IFLAG_CORRN,IFLAG_ANG)                       
              IFLAG_SUN   = MAX (IFLAG_SHDG ,IFLAG_ZEN)                       
              IFLAG_CORRN = MAX (IFLAG_CORRN,IFLAG_SUN)                       

              IFLAG_OUTPUT = IFLAG_TABLE(IFLAG_SIGNAL,IFLAG_CORRN)

              IF ( IFLAG_CORRN .LT. 2 .AND. RCOSTH .NE.0.) THEN 

! *OLD VERSION* FLX(IN) = FLX(IN) * (COS(ZENRAD)/RCOSTH)   !levelling correction

!            Correct the flux for attitude of aircraft for direct component of 
!            beam. Also include COSINE effect correction.    (Ref: M/MRF/13/5)

                INDX = NINT(SOLZEN/10) + 1
                INDX = MIN (INDX,10)
                                                              
                FLX (IN) =              FLX(IN)/      
!                         --------------------------------------------
     &            (1.- FDIR(INDX)*(1.- CEFF(INDX)*(RCOSTH/COS(ZENRAD))))
              ENDIF

            ELSE                            !* Critical value, (flux less than.)
                                            !  Diffuse case;   make Obscurer
                                            !  correction if signal is valid.

              IFLAG_CORRN  = MAX(IFLAG_PIT,  IFLAG_ROLL)  
              IFLAG_CORRN  = MAX(IFLAG_CORRN,IFLAG_ZEN)  
              IFLAG_OUTPUT = IFLAG_TABLE (IFLAG_SIGNAL,IFLAG_CORRN)  
              FLX(IN) = FLX(IN)*(1.0/(1.0- FOBSC))

            ENDIF                           !* Critical value for direct?

            IF ( IFLAG_SIGNAL .EQ. 3) THEN 
              FLX(IN) = -99.                     !set  invalid flux to obvious
            ENDIF                                !known value.

          ENDIF                             !**  Upper or Lower pyranometers?
        ENDIF                               !*** pyranometer or pyrgeometer?

!       Perform range checks on valid output fluxes.

        IF (IFLAG_OUTPUT .LT. 3 ) THEN
            IF (FLX(IN) .GT. RMAXFLX(ICONF(IN)) .OR.
     -          FLX(IN) .LT. RMINFLX(ICONF(IN))     ) THEN
               IFLAG_OUTPUT = 2             !Failed, flag result as 'suspect'
            ENDIF
        ENDIF
      ENDIF                                 !**** Flux signal validity?   

!     Assign processed flux to output parameter

      RDER(1,1018 + IN) = FLX(IN)                      !Fill output argument
      CALL ISETFLG (RDER(1,1018 + IN), IFLAG_OUTPUT)   !Set output flag

      IFLAG_CORRN       = 0
      IFLAG_SIGNAL      = 0
      IFLAG_OUTPUT      = 0
      END DO                                           !(..Control value IN)

      RETURN
      END


C-----------------------------------------------------------------------------
C ROUTINE          CORR_THM     SUBROUTINE     FORTVAX            [C_RFLUX.FOR]
C
C PURPOSE          Correct thermistors for non-linearity using a quintic eqn.
C
C DESCRIPTION      The thermistors used in the pyrgeometer/pyranometers all
C                  have characteristic non-linear temperature dependence
C                  due to the manufacturing process. If not corrected for,
C                  this can lead to errors in temperature of up to 1 deg C.
C                  The thermistor manufacturers provide a curve of the the
C                  correction needed to be applied for a range of
C                  temperatures.  A quintic equation has been fitted to this
C                  curve to give the best fit coefficients used by this routine.
C
C METHOD           The routine takes an array of six thermistor values in deg K.
C                  In turn; notes each ones flag then clears the flag.      
C                  Fits -50 deg C to +40 deg C to within +/- .07 deg C.
C                  Eqn: RT + (RCON +V.RT +W.RT^2 +X.RT^3 +Y.RT^4 +Z.RT^5)
C                  where RT  : Raw thermistor value  (converted to Celsius)
C                        RCON: A constant
C                   V,W,X,Y,Z: Coefficients of quintic equation correcting temp.
C
C                  Loop through six thermistor values:
C                  a)   note each one's flag
C                  b)   if flag indicates input is valid (flag <3)
C                       - clear the flag bits from the raw thermistor value
C                       - assign the value (converted to deg C.) to a working
C                         variable,  which becomes the input variable to a the
C                         quintic equation above.
C                       - derive the corrected output using that equation.
C                       - set input flag value in output thermistor temperature.
C                       else; for an 'invalid' flag
C                       - set the output thermistor value to zero C
C                       - set its output's flag to 3 (= invalid)
C                  next loop.
C
C                  n.b. The corrected thermistor values are not saved at the
C                       end of calibration and are only calculated for local
C                       use in deriving corrected solar fluxes.
C
C VERSION          1.02  30-07-91  A.D HENNINGS
C
C REFERENCES       Best-fit coefficients and constants taken from fitting to
C                  manufacturers calibration data sheet.
C
C ARGUMENTS        REAL*4 RTHM(6)  IN   Six uncorrected thermistor values. deg K
C                  REAL*4 THM (6) OUT   Six  corrected thermistor values.  deg C
C
C SUBPROGRAM       ITSTFLG ISETFLG
C
C CHANGES          1.01 201190 Documentation.
C                  1.02 300791 Documentation.
C                  1.03 17-01-96 D Lauchlan
C                  Unused variables removed
C                  1.04 22-03-04 D Tiddeman flag stripping before calculation 
C                  changed to prevent crashes.
C------------------------------------------------------------------------------
      SUBROUTINE CORR_THM (RTHM,THM)
CDEC$ IDENT 'V1.04'
C
      IMPLICIT NONE
      REAL*8 V,W,X,Y,Z,            !Coefficients of powers 1, 2, 3, 4 & 5
     -       RT,RCON               !placeholder  for thermistor for calc.       
      REAL*4 RTHM(6),THM(6)        !Raw Thermistor, corrected thermistor.       
      INTEGER*4 I,IFLAG ,ITSTFLG
c      LOGICAL OFIRST_TIME/.TRUE./  !   "      "
      PARAMETER (RCON = -0.774,
     -              V =  6.08E-02,
     -              W =  2.47E-03,
     -              X = -6.29E-05,
     -              Y = -8.78E-07,
     -              Z =  1.37E-08)
!

      DO  I=1,6 
      IFLAG = ITSTFLG(RTHM(I))
      CALL ISETFLG(RTHM(I),0)                      !Clear flag before calc.
      IF (IFLAG .LT. 3) THEN
        RT     = RTHM(I) - 273.16                  !convert to Celsius
        THM(I) = RT + (RCON + RT*(V+ RT*(W+RT*(X+RT*(Y+RT*Z)))))                
        CALL ISETFLG(THM(I),IFLAG)                 !Replace original flag.
      ELSE
        THM(I) = 0.0                               !Set thermistors to failed.
        CALL ISETFLG(THM(I),3)                     !and flag as such
      ENDIF                                                                     
      END DO

      RETURN
      END                                                                       

        
C-------------------------------------------------------------------------------
C ROUTINE          RMEANOF        SUBROUTINE     FORTVAX         [C_RFLUX.FOR] 
C
C PURPOSE          Calculate the mean of an array of real values.
C
C DESCRIPTION      An array containing NOELS  real elements is received.
C                  Each element is checked and, if it has a Flag value
C                  (bits 16+17) of zero, is accumulated to a total, and
C                  the  count of good elements incremented.
C                  When all elements have been checked, the mean is derived
C                  such that:
C                  If no good elements were found, the mean is zero, flagged 3.
C                  Otherwise, the mean is the total/count, flagged 0.
C
C ARGUMENTS        INTEGER*4  NOELS IN   Number of elements in array passed
C                  REAL*4     RARR  IN   Array of reals - dimensioned to NOELS
C                  REAL*4     RMEAN OUT  Arithmetic mean of good samples, or 0.
C                  INTEGER*4  IFLAG OUT  Flag value of mean, 0:good 3:invalid.
C                    
C VERSION          1.00   19-03-90  A.D.HENNINGS
C
C SUBPROGRAMS      ITSTFLG  ISETFLG
C
C REFERENCES       None
C
C-----------------------------------------------------------------------------

      SUBROUTINE RMEANOF(NOELS,RARR,RMEAN,IFLAG)
CDEC$ IDENT 'V1.00'
C
      IMPLICIT NONE
      INTEGER*4 NOELS,IX,ITSTFLG,ICOUNT,IFLAG
      REAL*4    RARR(NOELS),RMEAN,SUMM

      SUMM = 0.
      ICOUNT   = 0
      DO IX= 1,NOELS
      IF (ITSTFLG(RARR(IX)) .EQ. 0) THEN
        SUMM = SUMM + RARR(IX)
        ICOUNT = ICOUNT+1
      ENDIF 
      END DO

      IF (ICOUNT .GT. 0 )THEN
        RMEAN = SUMM/FLOAT(ICOUNT)
        IFLAG = 0
      ELSE
        RMEAN  = 0.
        IFLAG  = 3
      ENDIF
      CALL ISETFLG(RMEAN,IFLAG)

      RETURN
      END
*--------------------------------------------------------------
C ROUTINE          CIRC_AVRG  FUNCTION   FORTVAX  
C
C PURPOSE          CALCULATE MEAN OF A SET (>2 <1000)  OF ANGLES, IN DEG.
C
C ARGUMENTS        REAL*4    ARR  IN         Array of Angles (in  Degrees)
C                  INTEGER*4 NUM  IN         Number of angle in array ARR.
C                  REAL*4    CIRC_AVANG OUT  Average angle of set (0-360 deg)
C
C DESCRIPTION      Given a set of angles (0-360 Deg) calculates their mean. 
C                  Handles values spanning 0 or 180.
C                  Returns mean    Flagged 0: If >2 and <= 1/2 of inputs valid
C                                          1: If < 1/2 of inputs valid.
C                                          3: If no valid inputs.
C                  N.B  ASSUMES ALL INPUT ANGLES ARE BETWEEN 0 & 360 DEG.
C
C VERSION          1.0   JAN 1992  A D HENNINGS
C                        MODIFIED FROM  "AVANG" V3.0 SEP 1984  D OFFILER
C                  1.01  DEC 1997  W D N JACKSON
C                        Stips flags before using data
C-------------------------------------------------------------------------------
      REAL  FUNCTION CIRC_AVRG( ARR , NUM)
CDEC$ IDENT 'V1.00'

      IMPLICIT NONE
      INTEGER NUM,NM1,I,ITSTFLG,ICOUNT,IFLAG
      REAL ARR(NUM)
      REAL TARR(1000),DIF
 

      DO I=1,NUM
      TARR (I) = ARR(I)                         !Move values to temporary array
      CALL ISETFLG(TARR(I),0)                   !Strip flag
      END DO                                    !as they may be altered later.

C Alter angles to same sign .

      IF ( NUM .GT. 2 ) THEN
         NM1 = NUM - 1
         DO I = 1 , NM1
            DIF = TARR(I) - TARR(I+1)
            IF ( ABS ( DIF ) .GT. 180.0 ) THEN
                     TARR(I+1) = TARR(I+1) + SIGN (360.0 , DIF )
            ENDIF
         ENDDO
      ENDIF

C  Sum the good points.

      CIRC_AVRG= 0.0
      ICOUNT= 0

      DO I = 1 , NUM
         IF (ITSTFLG (ARR(I)) .LE. 1) THEN         !Do check on original array
            CIRC_AVRG = CIRC_AVRG + TARR(I)        !..but use changed data
            ICOUNT =ICOUNT+1
         ENDIF
      ENDDO

C Calculate average.

      IF (ICOUNT .GT. 0 )THEN
          CIRC_AVRG = CIRC_AVRG / FLOAT (ICOUNT )
          IF (ICOUNT .GT. NUM/2 ) THEN         !More than half rejected, then
              IFLAG = 0                        !flag as reduced quality data.
          ELSE
              IFLAG = 1
          ENDIF
      ELSE
          CIRC_AVRG  = 0.
          IFLAG  = 3
      ENDIF

      IF ( CIRC_AVRG .LT.   0.0 ) CIRC_AVRG = CIRC_AVRG + 360.0
      IF ( CIRC_AVRG .GE. 360.0 ) CIRC_AVRG = CIRC_AVRG - 360.0

C Set the flag in the returned value

      CALL ISETFLG(CIRC_AVRG,IFLAG)

      END

c_gsun.for

C
C ROUTINE          C_SUN         SUBROUTINE FORTVAX  C_SUN.FOR
C
C PURPOSE          PUT SOLAR ZENITH AND AZIMUTH ANGLES IN MFD
C
C DESCRIPTION      Given date, time and location on the earth's
C                  surface this routine puts a solar zenith and
C                  azimuth angle in the array of derived parameters.
C                  It computes a value once every second. The 
C                  angles are only obtained if all the flags are
C                  set to less than 3 and the date, time and location
C                  are all within sensible limits. Any flags set on input
C                  are also set in the solar angles derived. If
C                  the input is in error or the flags are set to 3
C                  a value of -99. is returned for ZEN and AZIM.
C                  To test the routine:
C                  $ FOR C_SUN
C                  $ FOR TEST_C_SUN
C                  $ LINK TEST_C_SUN,C_SUN
C                  Ensure contents of files RCONST.DAT and TEST_C_SUN.DAT
C                  contain simulated data you require to test the routine
C                  with.
C
C VERSION          1.02  1st May 1992   J.A.Smith
C
C ARGUMENTS        RDER(1,515)  R*4 IN Time GMT (seconds from midnight)
C                  RDER(1,550)  R*4 IN Omega latitude degrees (north +ve)
C                  RDER(1,551)  R*4 IN Omega longitude degrees (east +ve)
C               or RDER(1,541)  R*4 IN INU latitude degrees (north +ve)
C               or RDER(1,542)  R*4 IN INU longitude degrees (east +ve)
C                  RCONST(1)    R*4 IN Day in month (1-31)
C                  RCONST(2)    R*4 IN Month in year (1-12)
C                  RCONST(3)    R*4 IN Year (eg 1984)
C                  RDER(1,642)  R*4 OUT Solar azimuth in degrees
C                  RDER(1,643)  R*4 OUT Solar zenith in degrees
C
C SUBPROGRAMS      S_SUN , ITSTFLG, ISETFLG
C
C CHANGES          01 Range checks for input data now done in S_SUN 
C                     RWS 30/10/90
C                1.02 Check added if time RSECS has reached midnight and
C                     if so to reduce RSECS to less than 86400 s and increase
C                     the date.  JAS 1/5/92
C                1.03 Following the demise of the Omega, now uses INU position
C                     for flights after 30/09/97.  Note that this routine is
C                     now always called by CALIBRATE, even if neither Omega or
C                     INU were available.  WDNJ 20/10/97
C                1.04 Now strips flags from data before use.  WDNJ 22/12/97
C                1.05 Can take GIN input 05/09/07
C                1.06 Changes made how lon/lat input is derived AxW 29/03/10
C#########################################################################
      SUBROUTINE C_GSUN ( IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.05'
C
      INTEGER*4 IRAW(64,512), IFRQ(512), IFLAG(6)
      INTEGER*4 DAYM(12)/31,29,31,30,31,30,31,31,30,31,30,31/
      INTEGER*4 IMIDNIGHTS           ! added for v1.02
      REAL*4    RCONST(64), RDER(64,1024)
      LOGICAL   BAD_INPUT
C
      RSECS = RDER(1,515)            ! Seconds elapsed since midnight GMT
      IDAY = INT(RCONST(1))          ! Date in month
      IMON = INT(RCONST(2))          ! Month in Year
      IYR = INT(RCONST(3))           ! Year
!      IF((IYR.EQ.1997.AND.IMON.GE.10).OR.IYR.GT.1997) THEN
!        IF(ITSTFLG(RDER(1,541)).EQ.0)RLAT = RDER(1,541)           ! INU latitude
!        IF(ITSTFLG(RDER(1,542)).EQ.0)RLON = RDER(1,542)           ! INU longitude
!	IF(ITSTFLG(RDER(1,610)).EQ.0)RLAT=RDER(1,610)
!	IF(ITSTFLG(RDER(1,611)).EQ.0)RLON=RDER(1,611)
!	print *,ITSTFLG(RDER(1,610)),ITSTFLG(RDER(1,541))
!      ELSE    
!        RLAT = RDER(1,550)           ! Omega latitude
!        RLON = RDER(1,551)           ! Omega longitude
!      END IF

!Changed on 31/03/2010 after suggestion from Dave Tiddeman
      IF((IYR.EQ.1997.AND.IMON.GE.10).OR.IYR.GT.1997) THEN
        RLAT = RDER(1,541)           ! INU latitude
        RLON = RDER(1,542)           ! INU longitude
          IF(ITSTFLG(RDER(1,610)).LT.3)RLAT=RDER(1,610) !GIN latitude
          IF(ITSTFLG(RDER(1,611)).LT.3)RLON=RDER(1,611) !GIN longitude
      ELSE   
        RLAT = RDER(1,550)           ! Omega latitude
        RLON = RDER(1,551)           ! Omega longitude
      END IF
C
      BAD_INPUT = .FALSE.
C
C   Check flags and only proceed if all less than 3
C
      DO I = 1 , 3
      IFLAG(I) = ITSTFLG(RCONST(I))
      ENDDO            
      IFLAG(4) = ITSTFLG(RSECS)
      IFLAG(5) = ITSTFLG(RLAT)
      IFLAG(6) = ITSTFLG(RLON)
      CALL ISETFLG(RSECS,0)
      CALL ISETFLG(RLAT,0)
      CALL ISETFLG(RLON,0)
C
      IMAXFL = 0
      DO I = 1 , 6
      IMAXFL = MAX ( IMAXFL , IFLAG(I) )       ! Get highest flag value
      IF (IFLAG(I) .GE. 3)THEN
        BAD_INPUT = .TRUE.
        CALL ISETFLG ( AZIM , 3 )             ! Set invalid data flags
        CALL ISETFLG ( ZEN  , 3 )
      ENDIF
      ENDDO
C
C If input parameters OK proceed
C
      IF ( .NOT. BAD_INPUT )THEN
C.........................................................................
C v1.02 If time has run over midnight reduce RSECS to less than 24 hours of
C	seconds, ( 86400 ). The day of the month IDAY is then increased by 
C	the number of midnights passed over.  
C	If this gives too many days for the month then IDAY is set to the 
C	first day and IMON to the next month. 
C	If the data has crossed into a New Year then IMON is set to January
C	and the year is incremented. 
C
      IF (RSECS.GE.86400.) THEN
          IMIDNIGHTS = (NINT(RSECS))/86400
          RSECS = RSECS - REAL(IMIDNIGHTS*86400)
          IDAY = IDAY + IMIDNIGHTS
          IF (MOD(IYR,4).NE.0) DAYM(2)=28  !reduce February if not a leap year
          IF (IDAY.GT.DAYM(IMON)) THEN
              IDAY = IDAY - DAYM(IMON)
              IMON = IMON + 1
              IF (IMON.EQ.13) THEN
                  IMON = 1
                  IYR = IYR + 1
              ENDIF
          ENDIF
      ENDIF
C.........................................................................
C
C  Now compute solar zenith and azimuth angle
C
      CALL S_SUN(IDAY,IMON,IYR,RSECS,RLAT,RLON,AZIM,ZEN) 

C
C  Flag values with highest input flag value
C
C  If azimuth or zenith angle not computed in S_SUN set flags to 3
C
      IF (AZIM.EQ.-99) THEN 
        CALL ISETFLG(AZIM,3) 
      ELSE
        CALL ISETFLG(AZIM,IMAXFL)
      ENDIF

      IF (ZEN.EQ.-99) THEN 
        CALL ISETFLG(ZEN,3) 
      ELSE
        CALL ISETFLG(ZEN,IMAXFL)
      ENDIF
C                                                        
      ELSE
      BAD_INPUT = .TRUE.
      AZIM = -99.0
      ZEN = -99.0
      CALL ISETFLG ( AZIM , 3 )             ! Set invalid data flags
      CALL ISETFLG ( ZEN  , 3 )
C
      ENDIF
C
C  Transfer to output array
C
      RDER(1,642) = AZIM
      RDER(1,643) = ZEN
C         
      RETURN
      END

c_gwinds.for

C
C ROUTINE          C_GWINDS SUBROUTINE FORTVAX
C
C PURPOSE          Computes raw winds from TAS, vanes, and INS data
C
C DESCRIPTION      Computes values of the three wind components, using true
C                  airspeed, angle of attack and sideslip, and INS velocity,
C                  attitude, and attitude rate information. Note that at this
C                  stage the INS data have not been corrected for drift, so
C                  these are 'raw' winds, which will normally be corrected
C                  later as part of the interactive renavigation processing. 
C                  Once errors have been evaluated for the three INS velocity
C                  components, they can be applied directly to the three wind
C                  components; the wind components do not need to be recomputed 
C                  from scratch.  To show that the winds are 'raw' all values
C                  of U, V and W are increased by 1000 m/s by this routine.  
C                  This makes it easy to see that normal (flagged 0 or 1) data
C                  are 'raw', but it may not be enough to say unabiguously 
C                  whether data that are already bad (flagged 2 or 3) are 'raw'
C                  or 'corrected'.
C
C                  The processing will handle the case that the INS is mounted
C                  off the boom axis, provided its position is specified in
C                  the flight constants file, using the INSPOSN keyword.  If
C                  the INS position is not specified then it is assumed to be
C                  in the nose bay, 7.06m behind the vanes, but on the axis of
C                  the boom.  All data is assumed to be at 32 Hz.
C                  
C                  This routine will not be called if there is no True
C                  Airspeed, or no INS information (with the exception of roll
C                  rate).  If there is no information from the angle of attack
C                  and sideslip vanes, winds will be computed using values of
C                  zero for these angles flagged with
C                  1's.  If there is no roll rate available (this wasn't
C                  recorded for the Ferranti 1012 INS), a value of 0 is used. 
C                  This doesn't matter if the INS is located on the boom axis,
C                  since in this case roll rate has no effect on winds.
C                  
C                  The output vertical wind takes the worst flag present on the
C                  AOA, VZ, TAS and pitch data.  The output horizontal wind
C                  components take the worst flag present on the AOSS, VN, VE,
C                  TAS, and heading data.  This is suitable when the
C                  aircraft is not banking and reflects the fact that good
C                  horizontal winds can be found even when the vertical
C                  velocity is bad.  However this flagging scheme fails to 
C                  reflect coupling between the vertical and horizontal
C                  measurement when the aircraft is banking.
C                  In addition horizontal wind components greater
C                  than 100 m/s and vertical components greater than 25 m/s
C                  are flagged with 2's, and if the change between adjacent
C                  samples (at 32 Hz) is greater than 1 m/s a flag of 2 is
C                  also applied.
C
C                  Input parameters (all at 32 Hz except 515):
C
C                  Para 515   Time, secs
C                  Para 779   Turb.probe dry true airspeed, m s-1
C                  Para 548   Angle of attack, deg
C                  Para 549   Angle of side slip, deg
C                  Para 558   INS velocity north, m s-1
C                  Para 559   INS velocity east, m s-1
C                  Para 557   INS vertical velocity, m s-1
C                  Para 560   INS roll, deg
C                  Para 561   INS pitch, deg
C                  Para 562   INS heading, deg
C                  Para 567   INS roll rate, deg s-1 (optional)
C                  Para 565   INS pitch rate, deg s-1
C                  Para 566   INS yaw rate, deg s-1
C
C                  Constants:
C
C                  RCONST(1)  Distance of vanes ahead of INS, m (optional)
C                  RCONST(2)  Distance of vanes to port of INS, m (optional)
C                  RCONST(3)  Distance of vanes above INS, m (optional)
C
C                  Output parameters (all at 32 Hz):
C
C                  Para 714   Northward wind component + 1000, m s-1
C                  Para 715   Eastward wind component + 1000, m s-1
C                  Para 716   Vertical wind component + 1000, m s-1
C            
C VERSION          1.00  10-5-93  W.D.N.JACKSON
C
C ARGUMENTS        IRAW(64,512) I*4 IN  Up to 64 samples for up to 512 DRS pars
C                  IFRQ(512)    I*4 IN  Sample rate of each DRS par (0-64)
C                  RCONST(64)   R*4 IN  Inputs constants
C                  RDER(64,1024)R*4 OUT Output array of up to 64 samples for
C                                       each of 1024 parameters
C
C CHANGES          1.01  20-04-98 W.D.N.JACKSON
C                  Error in computation of airspeed corrected. 
C                  1.02  14-06-2004 Phil Brown
C                  AoA and AoSS now compulsory input parameters to ensure
C                  this routine gets called after C_TURB
C                  1.03  09/07/04 Phil Brown
C                  Input TAS parameter is now 779 (Turb.probe dry TAS)
C                  1.04  25/08/04 Phil Brown
C                  Temporary. Suspend rate-of-change checking on winds.
C                  1.05  29/11/04 Phil Brown
C                  Temporary. Check flagging of RU,RV,RW when returned to try
C                  to suppress FLTINV errors.
C                  1.06  05/09/07 Dave Tiddeman
C                  Will use GIN inputs if available rather than INU
C
********************************************************************************
      SUBROUTINE C_GWINDS(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.04'
      INTEGER*4 IRAW(64,512)      !Raw data array
      INTEGER*4 IFRQ(512)         !Raw data frequency
      REAL*4    RCONST(64)        !Constants array
      REAL*4    RDER(64,1024)     !Derived data array
      INTEGER*4 VN,VE,VZ,ROL,PIT,HDG,ROLR,PITR,YAWR
C
C This routine uses the following parameters (note that the absence of AOA,
C AOSS or roll rate will not stop C_WINDS from being called).  All parameters,
C except time, are at 32 Hz:
C
      PARAMETER GMT=515                !Time, secs
      PARAMETER TAS=779                !True airspeed, m s-1
      PARAMETER AOA=548                !Angle of attack, deg
      PARAMETER AOS=549                !Angle of side slip, deg
C
C This routine takes three constants from the RCONST array.  They are
C all optional and if not specified will be defaulted to the position of the
C H423 INU on the 146 Core Console (16.002,-0.8128,-0.4390 m).
C
      PARAMETER PL=1                   !Const dist of vanes ahead of INS
      PARAMETER PM=2                   !Const dist of vanes to port of INS
      PARAMETER PN=3                   !Const dist of vanes above INS
C
C This routine computes the following parameters, all at 32 Hz:
C Note that TARDIS conventially labels parameter 714, Northerly component, as V
C and parameter 715, Easterly component, as U.
C
      PARAMETER U=714                  !Northward wind component, m s-1
      PARAMETER V=715                  !Eastward wind component, m s-1
      PARAMETER W=716                  !Vertical wind component, m s-1
C
C Set LFLAG to false if you want to treat all data as unflagged.
C
      DATA LFLAG   /.TRUE./           !Set false if want to ignore flagging

      DATA RLSTSEC /-2.0/              !Initial dummy value for last sec processed
      
      DATA VN/558/
      DATA VE/559/
      DATA VZ/557/
      DATA ROL/560/
      DATA PIT/561/
      DATA HDG/562/
      DATA ROLR/567/
      DATA PITR/565/
      DATA YAWR/566/
      

      SAVE
      IF(ITSTFLG(RDER(1,613)).EQ.0)THEN
        VN=613                 !GIN velocity north, m s-1
        VE=614                 !GIN velocity east, m s-1
        VZ=615                 !GIN vertical velocity, m s-1
        ROL=616                !GIN roll, deg
        PIT=617                !GIN pitch, deg
        HDG=618                !GIN heading, deg
        ROLR=622               !GIN roll rate, deg s-1 (optional)
        PITR=623               !GIN pitch rate, deg s-1
        YAWR=624               !GIN yaw rate, deg s-1
      ENDIF
        
      RDEFAOA=0.0                      !If not specified AOA is 0.0 flagged 1
      CALL ISETFLG(RDEFAOA,1)
      RDEFAOS=RDEFAOA                  !If not specified AOSS is 0.0 flagged 1

      IF(.NOT.LFLAG) THEN              !Ignore flagging
        DO I=1,32                      !For each sample in second
          CALL C_WINDS_UVW(RDER(I,TAS),RDER(I,AOA),RDER(I,AOS),
     -        RDER(I,VN),RDER(I,VE),RDER(I,VZ),
     -        RDER(I,HDG),RDER(I,PIT),RDER(I,ROL),
     -        RCONST(PL),RCONST(PM),RCONST(PN),
     -        RDER(I,YAWR),RDER(I,PITR),RDER(I,ROLR),
     -        RDER(I,U),RDER(I,V),RDER(I,W))
        END DO
      ELSE                             !Apply flags
        RL=RCONST(PL)                  !Get the INS position offsets
        RM=RCONST(PM)
        RN=RCONST(PN)
        IF(ITSTFLG(RL).GE.2) RL=16.002 !Use default values if not available
        IF(ITSTFLG(RM).GE.2) RM=-0.8128
        IF(ITSTFLG(RN).GE.2) RN=-0.4390
        LCONSEQ=.FALSE.                !Will set true if this is next second
        IF(RDER(1,GMT).EQ.RLSTSEC+1.0) LCONSEQ=.TRUE.
        RLSTSEC=RDER(1,GMT)            !Save current time
	  
        DO I=1,32                      !For each sample in second
          RTAS=RDER(I,TAS)             !Get the input values
          RAOA=RDER(I,AOA)
          RAOS=RDER(I,AOS)
          RVN=RDER(I,VN)
          RVE=RDER(I,VE)
          RVZ=RDER(I,VZ)
          RHDG=RDER(I,HDG)
          RPIT=RDER(I,PIT)
          RROL=RDER(I,ROL)
          RYAWR=RDER(I,YAWR)
          RPITR=RDER(I,PITR)
          RROLR=RDER(I,ROLR)
          IF(ITSTFLG(RAOA).GE.2) RAOA=RDEFAOA !Set AOA to 0 if missing
          IF(ITSTFLG(RAOS).GE.2) RAOS=RDEFAOS !Set AOSS to 0 if missing
          IF(ITSTFLG(RROLR).GE.2) RROLR=0.0   !Set roll rate to 0 if missing
          IHFLAG=MAX(ITSTFLG(RTAS),ITSTFLG(RAOS), !Compute worst horiz flag
     -        ITSTFLG(RVN),ITSTFLG(RVE),ITSTFLG(RHDG))
          IWFLAG=MAX(ITSTFLG(RTAS),ITSTFLG(RAOA), !Compute worst vert flag
     -        ITSTFLG(RVZ),ITSTFLG(RPIT))
          CALL ISETFLG(RTAS,0)         !Clear any flags before computation
          CALL ISETFLG(RAOA,0)
          CALL ISETFLG(RAOS,0)
          CALL ISETFLG(RVN,0)
          CALL ISETFLG(RVE,0)
          CALL ISETFLG(RVZ,0)
	  IF(VN.NE.558)RVZ=-RVZ
          CALL ISETFLG(RHDG,0)
          CALL ISETFLG(RPIT,0)
          CALL ISETFLG(RROL,0)
          CALL ISETFLG(RYAWR,0)
          CALL ISETFLG(RPITR,0)
          CALL ISETFLG(RROLR,0)
          CALL C_WINDS_UVW(RTAS,RAOA,RAOS,RVN,RVE,RVZ,RHDG,RPIT,RROL,
     -        RL,RM,RN,RYAWR,RPITR,RROLR,RU,RV,RW) !Compute wind components
          IUFLAG=IHFLAG                !Propagate worst case flag for each comp
          IVFLAG=IHFLAG
          IF(ABS(RU).GT.100.0) IUFLAG=MAX(IUFLAG,2) !Flag if out of range
          IF(ABS(RV).GT.100.0) IVFLAG=MAX(IVFLAG,2)
          IF(ABS(RW).GT.25.0) IWFLAG=MAX(IWFLAG,2)
          CALL ISETFLG(RU, 0)          ! ensure winds have zero flag
          CALL ISETFLG(RV, 0)
          CALL ISETFLG(RW, 0)
	  IF(VN.EQ.558)THEN
           RU=RU+1000.                  !Add offset to show winds are 'raw'
           RV=RV+1000.
           RW=RW+1000.
	  ENDIF

C suspend rate-of-change checks.
C          IF(ITSTFLG(RLSTU).EQ.0.AND.LCONSEQ.AND.ABS(RLSTU-RU).GT.1.0)
C     -        IUFLAG=MAX(IUFLAG,2)     !Flag if rate of change too high
C          IF(ITSTFLG(RLSTV).EQ.0.AND.LCONSEQ.AND.ABS(RLSTV-RV).GT.1.0)
C     -        IVFLAG=MAX(IVFLAG,2)
C          IF(ITSTFLG(RLSTW).EQ.0.AND.LCONSEQ.AND.ABS(RLSTW-RW).GT.1.0)
C     -        IWFLAG=MAX(IWFLAG,2)

          CALL ISETFLG(RU,IUFLAG)      !Apply flags to result
          CALL ISETFLG(RV,IVFLAG)
          CALL ISETFLG(RW,IWFLAG)
          RDER(I,U)=RU                 !Transfer results to output array
          RDER(I,V)=RV
          RDER(I,W)=RW
          RLSTU=RU                     !Save latest values
          RLSTV=RV
          RLSTW=RW
          LCONSEQ=.TRUE.               !Further samples in second are consequetve
        END DO
      END IF
      RETURN
      END

c_heiman.for

C-----------------------------------------------------------------------------
C 
C ROUTINE          C_HEIMAN   SUBROUTINE FORTVAX
C
C PURPOSE          To derive uncorrected Heimann temperatures
C
C DESCRIPTION      Converts rawdata input from the Heimann radiometer and
C                  black body source into uncorrected surface tempratures,
C                  parameter 537.
C                   
C                  The Heimmann is recorded by para 141, 
C                  the blackbody reference temperature by para 142,
C                  and bit 0 of the signal register (para 27) indicates whether
C                  the Heimann is set to calibrate.  
C
C ARGUMENTS        IRAW   input raw data
C                  IFRQ   raw data frequencies
C                  RCONST flight constants corresponding to PRTCCAL and HEIMCAL
C                  RDER   output data
C
C SUBPROGRAMS      
C
C REFERENCES
C
C VERSION          1.00 D.R.Lauchlan
C
C CHANGES          
C DESCRIPTION      Converts the two input parameters 141 (raw Heimann) and
C                  142 (black body reference temperature) into one, the
C                  uncorrected HEIMAN temp (para 537).
C
C                  The Heimann Radiometer data is converted using a quadratic
C                  fit :
C                  Surface temp =  RCONST(4) + RCONST(5)*x + RCONST(6)*x**2
C                  RCONST(4 to 6) correspond to the constants with the keyword
C                  HEIMCAL in the flight constants file.
C 
C                  The black body signal (para 142) is converted using
C                  a quadratic fit :
C              
C                   BB = a + b*x + c*x**2
C
C                  where constants a, b and c correspond to RCONST(1 to 3)
C                  from the keyword PRTCCAL in the flight constant file.
C
C                  Signal Register (para 27) bit 0 indicates the position of 
C                  the black body;  0 = b/b out of FoV, 1 = b/b in FoV. 
C
C                  If signal register bit 0 is set to 1 and black body
C                  reference temprature has been steady for the previous
C                  3 seconds (mean of each second differs by no more than
C                  0.1K), the b/b reference temperature is output.
C                  Otherwise the HEIMAN temprature is output. An offset
C                  is assigned accordingly:
C                                                para 27 
C                                                 bit 0
C                   233.26 to  313.06   Heimann-    0    (o/s = 0)
C                  1233.26 to 1313.06   Ref/BB -    0    (o/s = 1000)
C                  2233.26 to 2313.06   Heimann-    1    (o/s = 2000)
C                  3233.26 to 3313.06   Ref/BB -    1    (o/s = 2000 + 1000)
C
C                  (NOTE: an offset of 1000 is never assigned under 
C                         this scheme)
C
C
C                  Heimann data is output for the time that the
C                  reference temperature is output. This is done in
C                  4 second bursts imediately after the reference 
C                  sequence and overwrites the ramping sections.
C                  Non reference or dwelling calibration temeratures
C                  are flagged as 2.
C                  Dwell Heimann data is output for the corresponding
C                  calibration reference period after the instrument has 
C                  switched back to measure, ie para 27 bit 0 becomes 0. 
C
C                  Bits 16 and 17 of the output temperature RDER(x,537) are
C                  used to flag certain data conditions as follows :
C                    Bits 16 and 17 = 00  - Good data, MEASURE/HEIMANN
C                                   = 01  - Good data, but Heimann on CALIBRATE
C                                           and outputing DWELL temp
C                                           or looking at the Black Body temps
C                                           or BB moved out of field of view
C                                           and data are last Heimann dwell
C                                           data.
C                                   = 02  - Suspect or absent signal register 
C                                           data, non-reference calibration
C                                           temperatures and non-dwelling
C                                           calibration temperatures.
C                                   = 03  - Absent data, passed through from
C                                           IRAW(x,141)
C
C ARGUMENTS        IRAW(f,141)   Raw Heimann data
C                  IRAW(f,27)    Raw signal register data 
C                  IRAW(f,142)   Raw black body data
C                  IFRQ(141)     Recorded frequency of Heimann Radiometer    
C                  IFRQ(27)      Recorded frequency of signal register  
C                  IFRQ(142)     Recorded frequency of black body
C                  RCONST(1-6)   Constants for quadratic fit
C                  RDER(f,537)   Uncorrected Heimann temps (deg K) 
C
C SUBPROGRAMS      ITSTFLG  -  Returns the value of bits 16 & 17    - SCILIB
C                  ISETFLG  -  Sets the value of bits 16 & 17       - SCILIB
C                  IBITS    -  Extracts selected bits from input    - FORTRAN
C                  BTEST    -  Tests value of selected single bit   - FORTRAN
C         C_HEIMAN_LTST_BB  -  Checks array elemenets are within
C                              +/- 86                                - LOCAL
C
C REFERENCES       
C
C VERSION          1.00   09-11-94 D.R.Lauchlan
C                  Based on C_BARNES V2.00 by D.P. Briggs
C
C CHANGES          V1.01  10/02/99  W.D.N.JACKSON
C                  Bug in flag checking of raw data fixed.
C                  
C                  V1.02  27/09/02  W.D.N.JACKSON
C                  Changed to include handling of 16 bit data from the new 
C                  DRS.  Also now expects calibrator temp cal to be in deg C.
C
C                  V1.03 11/11/04 J.P. TAYLOR
C                  Changed to account for 16bit representation of DRS
C                  parameters.  Allowable range of BB ref means changed from
C                  +/- 6 to +/- 86 this is equivalent to 0.1K with the new
C                  DRS 16bit data stream.
C----------------------------------------------------------------------------
      SUBROUTINE C_HEIMAN(IRAW,IFRQ,RCONST,RDER)


CDEC$ IDENT 'V1.03'
C
      INTEGER*4 IRAW(64,512),IFRQ(512)
      REAL*4    RCONST(64),RDER(64,1024)
 
      REAL*4    R_DWELL(5,64)    !buffer for dwelling Heimann

      INTEGER   L_LASTREG,       !last signal register
     +          L_PRESREG,       !present signal register
     +          I_COUNT,         !loop counter
     +          I_COUNT_1,       !loop counter
     +          I_COUNT_2,       !loop counter
     +          I_COUNT_3,       !loop counter
     +          I_DWELL_COUNT    !Heimann dwell count
      INTEGER*4 I_BBREF_MEAN(3), !last three seconds of BB mean temps
     +          I_BB_F,          !black body frequency
     +          I_SIGREG_F,      !signal register frequency 
     +          IFLAG,           !output data flag
     +          ISIGFLAG         !signal register flag
C functions:
      INTEGER   C_HEIMAN_LTST_BB,ITSTFLG 
      DATA L_LASTREG/.FALSE./
      
      SAVE
c      REAL      C_HEIMAN_RBB_CONV
C
      I_BB_F      = IFRQ(142)
      I_SIGREG_F  = IFRQ(27)

      DO I_COUNT_1 = 1,I_BB_F
        IFLAG = 0
        I_COUNT_2 = (1 + I_COUNT_1) / I_SIGREG_F
C
C if signal register set
        L_PRESREG = BTEST(IRAW(I_COUNT_2,27),0)
        IF (L_PRESREG) THEN

C  if last signal register not set
          IF (.NOT.L_LASTREG)  THEN
C    init BB ref means
            DO I_COUNT = 1,3
              I_BBREF_MEAN(I_COUNT) = I_COUNT * 100
            ENDDO
C    init dwell counter & buffer
            DO I_DWELL_COUNT = 1,5
              DO I_COUNT = 1,I_BB_F
                 R_DWELL(I_DWELL_COUNT,I_COUNT) = 2000.0
              ENDDO    
            ENDDO    
            I_DWELL_COUNT = 0
          ENDIF

C  if last 3 BB ref means are within +/-86 (equivalent to approx 0.1K)
          IF (C_HEIMAN_LTST_BB(I_BBREF_MEAN)) THEN !output BB ref temp
            RDER(I_COUNT_1,537) = 3000 + 
     -           273.16 +
     -           RCONST(1) + 
     -           RCONST(2) * FLOAT(IRAW(I_COUNT_1,142)) + 
     -           RCONST(3) * FLOAT(IRAW(I_COUNT_1,142)) ** 2
C       set flag to 2 if data is out of expected range (-20 to +40 degC)
            IF (RDER(I_COUNT_1,537) .GT. 3313.16 .OR.
     +          RDER(I_COUNT_1,537) .LT. 3253.16)  IFLAG = 2

C       store Heimann for corresponding seconds (max 5)
            IF (I_COUNT_1 .EQ. 1) THEN
              I_DWELL_COUNT = I_DWELL_COUNT + 1
              IF (I_DWELL_COUNT .GT. 5) THEN
                DO I_COUNT = 5,2,-1
                  DO I_COUNT_3 = 1,I_BB_F
                    R_DWELL(I_COUNT-1,I_COUNT_3) = 
     +                           R_DWELL(I_COUNT,I_COUNT_3)
                  ENDDO
                ENDDO
                I_DWELL_COUNT = 5
              ENDIF
            ENDIF
             
            R_DWELL(I_DWELL_COUNT,I_COUNT_1) = 2000 +
     -           273.16 +
     -           RCONST(4) + 
     -           RCONST(5) * FLOAT(IRAW(I_COUNT_1,141)) + 
     -           RCONST(6) * FLOAT(IRAW(I_COUNT_1,141)) ** 2
C          write(*,*)-999.999

          ELSE     !output HEIMANN temp
C        write dwell Heimann data if any
            IF (I_DWELL_COUNT.NE.0) THEN 
              IF (I_DWELL_COUNT.EQ.5) 
     +            I_DWELL_COUNT = 4
              RDER(I_COUNT_1,537) =  
     +           R_DWELL(I_DWELL_COUNT,I_COUNT_1)
              IF(I_COUNT_1 .EQ. I_BB_F)
     +           I_DWELL_COUNT = I_DWELL_COUNT - 1
            ELSE
              RDER(I_COUNT_1,537) =  2000 + 
     -           273.16 +
     -           RCONST(4) + 
     -           RCONST(5) * FLOAT(IRAW(I_COUNT_1,141)) + 
     -           RCONST(6) * FLOAT(IRAW(I_COUNT_1,141)) ** 2
              IF (IFLAG .LT. 2)
     +            IFLAG = 2
            ENDIF
          ENDIF

C    roll on BB means
          IF (I_COUNT_1 .EQ. 4) THEN
            DO I_COUNT = 2,1,-1
              I_BBREF_MEAN(I_COUNT+1) = I_BBREF_MEAN(I_COUNT)
            ENDDO

            I_BBREF_MEAN(1) = 0 
            DO I_COUNT = 1,IFRQ(142)
              I_BBREF_MEAN(1) = I_BBREF_MEAN(1) + 
     +            IRAW(I_COUNT,142)
            ENDDO
            I_BBREF_MEAN(1) = I_BBREF_MEAN(1) / I_BB_F
          ENDIF

        ELSE       !output Heimann temp
C        write dwell HEIMAN data if any
          IF (I_DWELL_COUNT.NE.0) THEN 
            IF (I_DWELL_COUNT.EQ.5) 
     +          I_DWELL_COUNT = 4
            RDER(I_COUNT_1,537) =  
     +         R_DWELL(I_DWELL_COUNT,I_COUNT_1)
            IF(I_COUNT_1 .EQ. I_BB_F)
     +         I_DWELL_COUNT = I_DWELL_COUNT - 1
          ELSE
            RDER(I_COUNT_1,537) = 
     -           273.16 +
     -           RCONST(4) + 
     -           RCONST(5) * FLOAT(IRAW(I_COUNT_1,141)) + 
     -           RCONST(6) * FLOAT(IRAW(I_COUNT_1,141)) ** 2

          ENDIF

        ENDIF

C     Get flag value
        ISIGFLAG =0
        IF(IRAW(I_COUNT_2,27).EQ.'FFFF'X) ISIGFLAG=3
        IF ((RDER(I_COUNT_1,537) .GE. 1000.0 .AND.
     +       IFLAG .EQ. 0) .OR.
     +       ISIGFLAG .EQ. 1) THEN
          IFLAG = 1 
        ELSE IF (ISIGFLAG .GT. IFLAG) THEN
          IFLAG = 2
        ENDIF
C     Set flag
        CALL ISETFLG(RDER(I_COUNT_1,537),IFLAG)
C
C    roll on sig reg
        L_LASTREG = L_PRESREG

      ENDDO
C
      RETURN
      END 
C-----------------------------------------------------------------------------
C
C ROUTINE          C_HEIMAN_LTST_BB    
C
C PURPOSE          Checks array elemenets are within +/- 86
C
C DESCRIPTION      Returns TRUE if the deviation from the mean value of the
C                  passed array is no greater than +/- 86 otherwise FALSE.
C
C VERSION          1.00   17-02-94  D.P.Briggs
C                  1.01   11-11-04  J.P.Taylor
C                  Array now allowed to be within +/- 86  (was +/- 6)
C                  Change due to new 16bit representation on  DRS
C                  86 is equivalent to 0.1K.
C                  
      INTEGER FUNCTION C_HEIMAN_LTST_BB(I_MEANS)  
CDEC$ IDENT 'V1.00'

      INTEGER    I_COUNT
      INTEGER*4  I_MEANS(3), I_MEAN
 
      C_HEIMAN_LTST_BB = .TRUE.

      I_MEAN = (I_MEANS(1) + I_MEANS(2) + I_MEANS(3)) / 3

      DO I_COUNT = 1 , 3 
        IF ( ABS(I_MEAN - I_MEANS(I_COUNT)) .GT. 86) 
     +     C_HEIMAN_LTST_BB = .FALSE.
      ENDDO

      RETURN
      END 

c_ins1.for

C
C ROUTINE         C_INS1 SUBROUTINE FORTVAX
C
C PURPOSE         Calibrates H-423 velocities, attitudes, and attitude rates
C
C DESCRIPTION     Handles the demultiplexing, calibration, interpolation and
C                 quality control of data from the Honeywell H-423 SNU 84 
C                 Inertial Navigation Unit, to produce the three aircraft
C                 velocity components (VN, VE and VZ), the three aircraft
C                 attitudes (Roll, Pitch and True Heading), and the three
C                 aircraft attitude rates (Roll rate, Pitch rate, and Yaw
C                 rate).  All INU parameters are 32 Hz, but for ease of
C                 computation there is a 1/32 s lag in the data - ie the
C                 second sample in each second in fact describes the 
C                 aircraft state at the start of the second.
C
C                 The three aircraft accelerations, in the aircraft body frame,
C                 together with INU latitude, longitude and altitude are
C                 produced at 1 Hz.
C
C                 The INU interface sends 7 16-bit parameters at 32 Hz to the 
C                 DRS.  The INU interface unit requests the I01 message from the
C                 INU 32 times a second.  The whole of the first I01 message 
C                 received in a second is recorded in parameter 163.  The
C                 time tags from the 2nd to 32nd messages are recorded in
C                 parameter 164, samples 2 to 32.  The least 8 bits of the
C                 velocities, attitudes, and attitude rates are packed into
C                 the remaining DRS parameters.  Because the information that
C                 would go into the first sample of parameters 164 to 169 is
C                 already available in parameter 163, the first sample in the
C                 second of each of these parameters is used to record status
C                 information as follows:
C
C                 1st sample of para 164 - IIU status word (see below)
C                 1st sample of para 165 - INU message I14, word 01
C                 1st sample of para 166 - INU message I14, word 04
C                 1st sample of para 167 - All 0's
C                 1st sample of para 168 - All 1's
C                 1st sample of para 169 - Unused (all 0's)
C
C                 The information in the above 6 words is sampled at the
C                 beginning of each second; therefore if an error is indicated
C                 some of the data in the previous second may also be bad, and
C                 not necessarily all the data in the current second may be bad.
C
C                 IIU status word:
C
C                 Bit 15  1 if ASMA link broken, IIU or SIMON off, else 0
C                     14  1 if IIU can get no response from INU, else 0
C                     13  1 if IIU has no valid baro information, else 0
C                     12  1 if any bit set in the IIU 1553 chip sts word, else 0
C                     11-3 Unused, set to 0
C                     2-0 IIU software version
C
C                 Input parameters are:
C
C                 Para 163 I01   32 Hz  This contains the full 32 word I01 
C                                       message, sampled once a second
C                      164 TTAG  32 Hz  Time tags taken from I01 messages
C                      165 VXVY  32 Hz  Bits 14-21 of VX (0-7) and VY (8-15)
C                      166 VZTH  32 Hz  Bits 14-21 of VZ (0-7) and bits 0-7 of
C                                       THDG (8-15)
C                      167 RORR  32 Hz  Bits 0-7 of ROLL (0-7) and ROLR (8-15)
C                      168 PIPR  32 Hz  Bits 0-7 of PITC (0-7) and PITR (8-15)
C                      169 PAYR  32 Hz  Bits 0-7 of PAZI (0-7) and YAWR (8-15)
C
C                 The least significant bits of the information recorded by the
C                 DRS are (H-423 manual, Table 3-1A, p3-10 onwards):
C
C                   Time tags      2**6   micro-sec
C                   Altitude       2**2   foot
C                   CNEXZ          2**-30 dimensionless
C                   Longitude      2**-31 pirads (1 pirad = 180 deg)
C                   Velocities     2**-18 foot/sec
C                   Accelerations  2**-5  foot/sec/sec
C                   Attitudes      2**-15 pirads 
C                   Attitude rates 2**-13 pirads/sec
C
C                 The INU I01 message contains the following 32 16-bit words 
C                 (not all used by this module):
C
C                   01                    INU mode word
C                   02                    INU time tag
C                   03/04, 05/06, 07/08   VX, VY, VZ
C                   09, 10, 11            Platform Azimuth, Roll, Pitch
C                   12, 13                True Heading, Magnetic Heading
C                   14, 15, 16            X, Y, Z accelerations
C                   17/18, 19/20, 21/22   CNEXX, CNEXY, CNEXZ direction cosines
C                   23/24, 25             Longitude, Inertial Altitude
C                   26, 27, 28            GC steering err, X & Y residual tilts
C                   29                    INU mode word 2 - current mode
C                   30, 31, 32            Roll, Pitch and Yaw rates
C
C                 Constants:
C
C                 The following constants are used by the module to compensate
C                 for the INU not being accurately aligned with the aircraft
C                 axes, they are the values that need to be added to the INU
C                 attitudes to obtain the aircraft attitude:
C
C                   RCONST(1) Roll offset (deg)  +ve Aircraft right bank wrt INU
C                   RCONST(2) Pitch offset (deg) +ve Aircraft pitched up wrt INU
C                   RCONST(3) Yaw offset (deg)   +ve Aircraft yawed CW wrt INU
C
C                 These are defined in the flight constants file using the
C                 INSLEVL keyword.
C
C                 Output parameters are:
C
C                 Para 538 IACF   1 Hz  m/s/s +ve Forwards
C                      539 IACS   1 Hz  m/s/s +ve Starboard
C                      540 IACU   1 Hz  m/s/s +ve Upwards
C                      541 ILAT   1 Hz  deg   -90 to +90
C                      542 ILNG   1 Hz  deg   -180 to +180
C                      543 IALT   1 Hz  m     +ve Upwards
C                      558 VN    32 Hz  m/s   +ve Northwards
C                      559 VE    32 Hz  m/s   +ve Eastwards
C                      557 VZ    32 Hz  m/s   +ve Upwards
C                      560 ROLL  32 Hz  deg   +ve Right bank
C                      561 PITC  32 Hz  deg   +ve Nose up
C                      562 THDG  32 Hz  deg   +ve CW wrt True North (0-360 deg)
C                      567 ROLR  32 Hz  deg/s +ve Banking right
C                      565 PITR  32 Hz  deg/s +ve Pitching up
C                      566 YAWR  32 Hz  deg/s +ve Yawing CW wrt North
C                      563 IGS   32 Hz  m/s   +ve Always
C                      564 IDA   32 Hz  deg   +ve Track to right of heading
C
C                 Velocities are computed in the Earth-centred, Earth-fixed 
C                 frame and expressed in local geodetic coordinates.  
C                 Accelerations are computed in the aircraft frame.  Positions 
C                 are uncorrected and based on whatever initial positions were 
C                 loaded when the INU was aligned.
C
C                 The attitude angles are the Euler angles used to transform
C                 between local geodetic and aircraft body co-ordinates.
C                 The local geodetic axes are rotated in the counterclockwise
C                 direction about the downward axis by the true heading, with
C                 the yaw rate directed along this axis.  These new axes are
C                 then rotated counterclockwise about the rotated eastward 
C                 axis by the pitch angle, with the pitch rate directed along
C                 this intermediate axis.  Finally, these new axes are rotated 
C                 counterclockwise about the rotated northward axis (which 
C                 becomes the forward axis in the aircraft body frame) by the 
C                 roll angle, with the roll rate directed along this axis.
C
C                 Since only the least eight significant bits of velocity,
C                 attitude, and attitude rate are recorded at 32 Hz, the true
C                 values have to be reconstituted.  This is done by computing
C                 the expected value and assuming that the actual value will
C                 always be within +-127 bits of the expected value.  The first
C                 expected velocity in a second is computed using the 
C                 accelerations available in the I01 word.  Subsequent values
C                 are based on the changes between the previous samples.
C                 Expected attitudes are computed in the same way, using the
C                 attitude rates available in the I01 word.  Expected attitude
C                 rates are computed using the current attitude rates.
C
C                 Note that the attitude data is corrected for any INU
C                 misalignment with the aircraft, provided that the INSLEVL
C                 constants are entered in the Flight Constants file for the
C                 flight.  Because there is a variable delay between the INU
C                 sampling the aircraft attitude and velocity and having the
C                 result ready to be read by the DRS, together with a further
C                 variable delay between the data being ready and it actually
C                 being read by the DRS, this routine linearly interpolates the
C                 INU measurements, which are made available with their actual
C                 measurement times, onto the equispaced 32 Hz sampling 
C                 intervals of the DRS.
C                 
C                 Most of the computation is quite straight forward, but the
C                 VN and VE velocities have to be derived from the VX and VY 
C                 velocities since the INU does not maintain its 'platform'
C                 aligned with True North, but lets it wander at a normally 
C                 fairly slow rate.  The wander angle, a, is the difference 
C                 between the INU platform azimuth and True North.  VN and VE
C                 are then derived using:
C
C                   VN =   cos(a).VX - sin(a).VY
C                   VE = - sin(a).VX - cos(a).VY
C
C                 Accelerations are converted from platform to aircraft frame
C                 by applying a suitable transformation matrix.
C
C                 INU Groundspeed, IGS, and Drift Angle, IDA, are derived from
C                 VN, VE, and THDG using:
C
C                   IGS = sqrt(VE**2 + VN**2)
C                   IDA = artan(VE/VN) - THDG
C
C                 Flagging:
C
C                 Output data are flagged with 2 if they exceed the following
C                 max, min, rate of change limits:
C
C                   VN, VE      +-250  m/s,   +-20   m/s/s
C                   VZ          +-30.5 m/s,   +-20   m/s/s
C                   ROLL, PITC  +-60   deg,   +-20   deg/s
C                   THDG        0-360  deg,   +-15   deg/s
C                   ROLR, PITR  +-20   deg/s, +-20   deg/s/s
C                   YAWR        +-15   deg/s, +-20   deg/s/s
C                   IGS         0-250  m/s,   +-20   m/s/s
C                   IDA         +-45   deg,   +-10   deg/s
C                   IACF        +-5    m/s/s, +-4    m/s/s/s
C                   IACS        +-20   m/s/s, +-4    m/s/s/s
C                   IACU      2.5-18   m/s/s, +-7    m/s/s/s
C                   ILAT        +-90   deg,   +-.015 deg/s
C                   ILNG        +-180  deg,   +-.015 deg/s
C                   IALT    -200-12000 m,     +-30.5 m/s
C
C                 Data are also flagged under any of the following
C                 circumstances:
C
C                 IIU sts bit 15 set (no ASMA link) - All data in sec flagged 3
C                 IIU sts bit 14 set (no INU link)  - All data in sec flagged 3
C                 IIU sts bit 13 set (no baro info) - All vert in sec flagged 2
C                 IIU sts bit 12 set (1553 chip err)- All data in sec flagged 2
C                 I14/01 not zero                   - All data in sec flagged 2
C                 All zeros word not zero           - All data in sec flagged 2
C                 All ones word not FFFF            - All data in sec flagged 2
C                 I01/1 bit 1 set (Sensor fail)     - All data in sec flagged 2
C                 I01/1 bit 2 set (Nav data fail)   - All data in sec flagged 2
C                 I01/1 bit 3 set (Degraded nav)    - All data in sec flagged 2
C                 I01/1 bit 4 set (Nav data unav.)  - All data in sec flagged 2
C                 I01/1 bit 5 set (Att data fail)   - All data in sec flagged 2
C                 I01/1 bit 9 set (Baro invalid)    - All vert in sec flagged 2
C                 I01/1 bit 10 set (BIT)            - All data in sec flagged 2
C                 I01/29 any bits except 9 (NAV) set- All data in sec flagged 2
C                 I01/29 more than one bit set      - All data in sec flagged 2
C                 Time tag has a value of FFFE   - All data in sample flagged 3
C
C                 In all cases the data take the worst of all possible flags, 
C                 and if the flag is three the data are set to zero.
C 
C VERSION         1.00  10-01-94  W.D.N.JACKSON
C
C ARGUMENTS       IRAW(2,64,512) I*2  IN  Up to 64 samples for up to 512 DRS 
C                                         parameters
C                 IFRQ(512)      I*4  IN  Sample rate of each DRS par (0-64)
C                 RCONST(64)     R*4  IN  Inputs constants
C                 RDER(64,1024)  R*4  OUT Output array of up to 64 samples for
C                                         each of 1024 parameters
C
C REFERENCES      SNU 84-1 Rev D INU specification
C                 Honeywell H-423 system description
C                 MRF Technical Note 15
C
C CHANGES         V1.01  03-02-94  W.D.N.JACKSON
C                 No longer checks I14-04 when setting flags
C
C                 V1.02  11-05-94  W.D.N.JACKSON
C                 Now produces valid data, but without interpolation, if the
C                 IIU synching of the INU time tag clock has failed.
C
C                 V1.03  25-06-94  W.D.N.JACKSON
C                 Problems with retrieving platform azimuth and true heading
C                 when crossing +-180 degrees fixed.
C
C                 V1.04  24-07-95  W.D.N.JACKSON
C                 Now retrieves accelerations and positions at 1 Hz.
C
C                 V1.05  22-01-97  W.D.N.JACKSON
C                 Bug fixed which sometimes stopped interpolation.
C
C                 V1.06  09-07-98  W.D.N.JACKSON
C                 Bug fixed which caused incorrect attitude rate calculations.
C
C                 V1.07  06-08-98  G.W. Inverarity
C                 Convert feet to m assuming they're US standard feet (WGS-84).
C
C                 V1.08  13-12-02  G.W. Inverarity
C                 1. Convert feet to m as international feet (Honeywell).
C                 2. Added RPMIN array of minimum value limits and changed
C                    RPROC(15) to 0.015, consistent with the values under 
C                    "Flagging" above.
C                 3. Replaced 4. and RTTOMS*2*16 by RTMAX (= RTTOMS*2**16) 
C                    when computing time differences.
C                 4. Added extra time tag checks when deciding whether
C                    or not to interpolate 32 Hz data.
C                 5. Extrapolate 1 Hz positions by integrating the equations
C                    for the rates of change of latitude, longitude and 
C                    altitude using Euler's method, working in double 
C                    precision to minimise rounding error, which can be of
C                    the order of 1 metre.
C                 6. Drift angle error when northward velocity zero corrected.
C                 7. Simplified the true heading and drift angle calculations
C                    using the MOD function.
C                 8. C_INS1_TRANS_BRATE rewritten.
C*******************************************************************************
      SUBROUTINE C_INS1(IRAW,IFRQ,RCONST,RDER)

CDEC$ IDENT     'V1.08'

      INTEGER*2 IRAW(2,64,512)         !Raw data array
      INTEGER*4 IFRQ(512)              !Raw data frequency (not used)
      REAL*4    RCONST(64)             !Constants array
      REAL*4    RDER(64,1024)          !Derived data array

      INTEGER*2 IVX,IVY,IVZ,IPA,IRO,IPI,ITH,IRR,IPR,IYR
      INTEGER*2 IXVX,IXVY,IXVZ,IXPA,IXRO,IXPI,IXTH,IXRR,IXPR,IXYR
      INTEGER*2 ITEMP
      INTEGER*4 ITEMP4,ITEMP4B
      REAL*4    RVX(32),RVY(32),RPA(32),RTDIF(32)
      REAL*4    RTT(0:32),RVN(0:32),RVE(0:32),RVZ(0:32),RROLL(0:32),
     -          RPITC(0:32),RTHDG(0:32),RROLR(0:32),RPITR(0:32),
     -          RYAWR(0:32)
      INTEGER*4 IPARA(17),IFLG(17)
      REAL*4    RPMIN(17),RPMAX(17),RPROC(17),RLSTVAL(17)

      REAL*8    DT        ! Time interval by which to extrapolate 1 Hz 
                          ! positions. 
      REAL*8    DL        ! Rate of change of latitude with time (rad/s)
      REAL*8    DLAMBDA   ! Rate of change of longitude with time (rad/s)
      REAL*8    RL        ! Meridional radius of curvature (m)
      REAL*8    RLAMBDA   ! Azimuthal radius of curvature (m) / COS(LAT)

      PARAMETER I01=163,TTAG=164,VXVY=165,VZTH=166 !Raw parameters
      PARAMETER RORR=167,PIPR=168,PAYR=169
      PARAMETER GMT=515,VN=558,VE=559,VZ=557       !Derived parameters
      PARAMETER ROLL=560,PITC=561,THDG=562
      PARAMETER ROLR=567,PITR=565,YAWR=566
      PARAMETER IGS=563,IDA=564
      PARAMETER IACF=538,IACS=539,IACU=540,ILAT=541,ILNG=542,IALT=543

      REAL*4    RFT2MTR ! International foot to metre conversion factor
      PARAMETER(RFT2MTR=0.3048)
      REAL*8    PI      ! Pi
      PARAMETER(PI=3.1415926535897932D0)
      REAL*8    RAD2DEG ! Radians to degrees
      PARAMETER(RAD2DEG=180.0D0/PI)
      
      DATA LFLAG /.TRUE./              !Set to false if don't want data flagging
      DATA LINTER /.TRUE./             !Set to false if don't want interpolation
      DATA RLSTSEC /-2.0/              !Initial value for last sec processed
      DATA IPARA /VN,VE,VZ,ROLL,PITC,THDG,ROLR,PITR,YAWR,IGS,IDA,
     -    IACF,IACS,IACU,ILAT,ILNG,IALT/ !Derived paras
      DATA RPMIN /2*-250.,-30.5,2*-60.,0.,2*-20.,-15.,0.,-45.,
     -    -5.,-20.,2.5,-90.,-180.,-200./ ! Min values
      DATA RPMAX /2*250.,30.5,2*60.,360.,2*20.,15.,250.,45.,
     -    5.,20.,18.,90.,180.,12000./ !Max values
      DATA RPROC /3*20.,2*20.,15.,3*20.,20.,10.,
     -    4.,4.,7.,0.015,0.015,30.5/ !Max rates of change/s

      SAVE
C
      RTTOMS=2.**6/1.0E6               !Converts time tags to seconds
      RTMAX=RTTOMS*2.**16              !Maximum time tag
      RVTMPS=RFT2MTR/2.**4             !Converts velocities to m/s
      RRATOD=180./2.**13               !Converts attitude rates to deg/s
      RATTOD=RRATOD/4.0                !Converts attitudes to degrees
      RATMSS=RVTMPS/2.0                !Converts accelerations to m/s/s
      RTSHFT=1.0/32.0                  !Data time shift in secs  
      RSINT=RTSHFT                     !DRS data sample interval
C
C Set flag false if this second is not immediately after previous one.
C
      LNXTSEC=.TRUE.
      IF(RDER(1,GMT).NE.RLSTSEC+1.0) LNXTSEC=.FALSE.
C
C Retrieve time tags - if INU is getting synched by IIU then time tags will
C always be in range 0 to 1s.  If INU 1553 clock not being reset by IIU then
C time tags will be in range 0 to RTMAX = 4.194304 s (2**22 microsec).  Set 
C interpolation flag to false if the first tag of the second is not in the 
C known range, thus indicating that the IIU is not synching the INU.
C
      ITT=JZEXT(IRAW(1,2,I01))
      RTT(1)=FLOAT(ITT)*RTTOMS
      DO I=2,32
        ITT=JZEXT(IRAW(1,I,TTAG))
        RTT(I)=FLOAT(ITT)*RTTOMS
      END DO
      DO I=2,32
        RTDIF(I)=RTT(I)-RTT(I-1)
        IF(RTDIF(I).LE.-RTMAX) RTDIF(I)=RTDIF(I)+RTMAX
        IF(RTDIF(I).LE.0.) RTDIF(I)=RTDIF(I)+1.0
      END DO
      LINTERP=LINTER
      IF(RTT(1).LT.0.970.OR.RTT(1).GT.0.991) LINTERP=.FALSE.
C
C Compute platform accelerations for use in retrieving VX, VY and VZ.
C
      RAX=FLOAT(IRAW(1,14,I01))*RATMSS
      RAY=FLOAT(IRAW(1,15,I01))*RATMSS
      RAZ=FLOAT(IRAW(1,16,I01))*RATMSS-9.75 !Remove gravitational acceleration
C
C Retrieve VX
C
      CALL MVBITS(IRAW(1,3,I01),0,14,IVX,2)
      CALL MVBITS(IRAW(1,4,I01),14,2,IVX,0)
      RVX(1)=FLOAT(IVX)*RVTMPS
      DO I=2,32
        IF(I.EQ.2) RXVX=RVX(1)+RAX*RTDIF(2)
        IF(I.GT.2) RXVX=RVX(I-1)+(RVX(I-1)-RVX(I-2))/RTDIF(I-1)*RTDIF(I)
        RXVX=RXVX/RVTMPS
        RXVX=MIN(RXVX,32767.)
        RXVX=MAX(RXVX,-32768.)
        IXVX=NINT(RXVX)
        CALL C_INS1_MERGE(IXVX,IRAW(1,I,VXVY),0,IVX)
        RVX(I)=FLOAT(IVX)*RVTMPS
      END DO
C
C Retrieve VY
C
      CALL MVBITS(IRAW(1,5,I01),0,14,IVY,2)
      CALL MVBITS(IRAW(1,6,I01),14,2,IVY,0)
      RVY(1)=FLOAT(IVY)*RVTMPS
      DO I=2,32
        IF(I.EQ.2) RXVY=RVY(1)+RAY*RTDIF(2)
        IF(I.GT.2) RXVY=RVY(I-1)+(RVY(I-1)-RVY(I-2))/RTDIF(I-1)*RTDIF(I)
        RXVY=RXVY/RVTMPS
        RXVY=MIN(RXVY,32767.)
        RXVY=MAX(RXVY,-32768.)
        IXVY=NINT(RXVY)
        CALL C_INS1_MERGE(IXVY,IRAW(1,I,VXVY),8,IVY)
        RVY(I)=FLOAT(IVY)*RVTMPS
      END DO
C
C Retrieve VZ
C
      CALL MVBITS(IRAW(1,7,I01),0,14,IVZ,2)
      CALL MVBITS(IRAW(1,8,I01),14,2,IVZ,0)
      RVZ(1)=FLOAT(IVZ)*RVTMPS
      DO I=2,32
        IF(I.EQ.2) RXVZ=RVZ(1)+RAZ*RTDIF(2)
        IF(I.GT.2) RXVZ=RVZ(I-1)+(RVZ(I-1)-RVZ(I-2))/RTDIF(I-1)*RTDIF(I)
        RXVZ=RXVZ/RVTMPS
        RXVZ=MIN(RXVZ,32767.)
        RXVZ=MAX(RXVZ,-32768.)
        IXVZ=NINT(RXVZ)
        CALL C_INS1_MERGE(IXVZ,IRAW(1,I,VZTH),0,IVZ)
        RVZ(I)=FLOAT(IVZ)*RVTMPS
      END DO
C
C Retrieve lat, long and altitude
C
      ITEMP4=IRAW(1,21,i01)
      CALL MVBITS(ITEMP4,0,16,ITEMP4B,16) !Latitude
      ITEMP4=IRAW(1,22,I01)
      CALL MVBITS(ITEMP4,0,16,ITEMP4B,0)
      RCNEXZ=FLOAT(ITEMP4B)/2.**30
      IF(RCNEXZ.GE.-1.AND.RCNEXZ.LE.1) RLAT=ASIND(RCNEXZ)
      IF (RLAT.GT.89.9) 
     &  print *,'Latitude close to 90 could cause problems'
      IF (RLAT.LT.-89.9) 
     &  print *,'Latitude close to -90 could cause problems'
      ITEMP4=IRAW(1,23,I01)
      CALL MVBITS(ITEMP4,0,16,ITEMP4B,16) !Longitude
      ITEMP4=IRAW(1,24,I01)
      CALL MVBITS(ITEMP4,0,16,ITEMP4B,0)
      RLNG=FLOAT(ITEMP4B)*180./2.**31
      RALT=FLOAT(IRAW(1,25,I01))*4.*RFT2MTR !Height in metres
C
C Compute basic attitude and attitude rates at start of second, and transform
C attitude rates from aircraft body co-ordinates to rates of change of
C Euler angles.
C
      RPA(1)=FLOAT(IRAW(1,9,I01))*RATTOD
      RROLL(1)=FLOAT(IRAW(1,10,I01))*RATTOD
      RPITC(1)=FLOAT(IRAW(1,11,I01))*RATTOD
      RTHDG(1)=FLOAT(IRAW(1,12,I01))*RATTOD
      RROLR(1)=FLOAT(IRAW(1,30,I01))*RRATOD
      RPITR(1)=FLOAT(IRAW(1,31,I01))*RRATOD
      RYAWR(1)=FLOAT(IRAW(1,32,I01))*RRATOD
C Compute wander angle and transform VX and VY to VN and VE
      RWA=RPA(1)-RTHDG(1)
      RVN(1)=COSD(RWA)*RVX(1)-SIND(RWA)*RVY(1)
      RVE(1)=-SIND(RWA)*RVX(1)-COSD(RWA)*RVY(1)
      CALL C_INS1_TRANS_BRATE(RLAT,RALT,RVN(1),RVE(1),RROLR(1),RPITR(1),
     &     RYAWR(1),RROLL(1),RPITC(1),RTHDG(1),RRR1,RPR1,RYR1)
      RROLR(1)=RRR1
      RPITR(1)=RPR1
      RYAWR(1)=RYR1
C
C Retrieve Roll
C
      DO I=2,32
        IF(I.EQ.2) RXRO=RROLL(1)+RRR1*RTDIF(2)
        IF(I.GT.2) RXRO=RROLL(I-1)+(RROLL(I-1)-RROLL(I-2))/RTDIF(I-1)
     -      *RTDIF(I)
        RXRO=RXRO/RATTOD
        RXRO=MIN(RXRO,32767.)
        RXRO=MAX(RXRO,-32768.)
        IXRO=NINT(RXRO)
        CALL C_INS1_MERGE(IXRO,IRAW(1,I,RORR),0,IRO)
        RROLL(I)=FLOAT(IRO)*RATTOD
      END DO
C
C Retrieve Pitch
C
      DO I=2,32
        IF(I.EQ.2) RXPI=RPITC(1)+RPR1*RTDIF(2)
        IF(I.GT.2) RXPI=RPITC(I-1)+(RPITC(I-1)-RPITC(I-2))/RTDIF(I-1)
     -      *RTDIF(I)
        RXPI=RXPI/RATTOD
        RXPI=MIN(RXPI,32767.)
        RXPI=MAX(RXPI,-32768.)
        IXPI=NINT(RXPI)
        CALL C_INS1_MERGE(IXPI,IRAW(1,I,PIPR),0,IPI)
        RPITC(I)=FLOAT(IPI)*RATTOD
      END DO
C
C Retrieve Platform azimuth
C
      DO I=2,32
        IF(I.EQ.2) RXPA=RPA(1)+RYR1*RTDIF(2)
        IF(I.GT.2) THEN
          RDIFF=MOD(MOD(RPA(I-1)-RPA(I-2),360.)+360.,360.)
          IF(RDIFF.GT.180.) RDIFF=RDIFF-360.
          RXPA=RPA(I-1)+RDIFF/RTDIF(I-1)*RTDIF(I)
        END IF
        RXPA=RXPA/RATTOD
        IF(RXPA.GT.32767.) RXPA=RXPA-65536.
        IF(RXPA.LT.-32768.) RXPA=RXPA+65536.
        RXPA=MIN(RXPA,32767.)
        RXPA=MAX(RXPA,-32768.)
        IXPA=NINT(RXPA)
        CALL C_INS1_MERGE(IXPA,IRAW(1,I,PAYR),0,IPA)
        RPA(I)=FLOAT(IPA)*RATTOD
      END DO
C
C Retrieve Heading
C
      DO I=2,32
        IF(I.EQ.2) RXTH=RTHDG(1)+RYR1*RTDIF(2)
        IF(I.GT.2) THEN
          RDIFF=MOD(MOD(RTHDG(I-1)-RTHDG(I-2),360.)+360.,360.)
          IF(RDIFF.GT.180.) RDIFF=RDIFF-360.
          RXTH=RTHDG(I-1)+RDIFF/RTDIF(I-1)*RTDIF(I)
        END IF
        RXTH=RXTH/RATTOD
        IF(RXTH.GT.32767.) RXTH=RXTH-65536.
        IF(RXTH.LT.-32768.) RXTH=RXTH+65536.
        RXTH=MIN(RXTH,32767.)
        RXTH=MAX(RXTH,-32768.)
        IXTH=NINT(RXTH)
        CALL C_INS1_MERGE(IXTH,IRAW(1,I,VZTH),8,ITH)
        RTHDG(I)=FLOAT(ITH)*RATTOD
      END DO
C 
C Retrieve Roll rate
C
      IRR=IRAW(1,30,I01)
      DO I=2,32
        IXRR=IRR
        CALL C_INS1_MERGE(IXRR,IRAW(1,I,RORR),8,IRR)
        RROLR(I)=FLOAT(IRR)*RRATOD
      END DO
C
C Retrieve Pitch rate
C
      IPR=IRAW(1,31,I01)
      DO I=2,32
        IXPR=IPR
        CALL C_INS1_MERGE(IXPR,IRAW(1,I,PIPR),8,IPR)
        RPITR(I)=FLOAT(IPR)*RRATOD
      END DO
C
C Retrieve Yaw rate
C
      IYR=IRAW(1,32,I01)
      DO I=2,32
        IXYR=IYR
        CALL C_INS1_MERGE(IXYR,IRAW(1,I,PAYR),8,IYR)
        RYAWR(I)=FLOAT(IYR)*RRATOD
      END DO
C
C Compute wander angle and transform VX and VY to VN and VE
C
      DO I=2,32
        RWA=RPA(I)-RTHDG(I)
        RVN(I)=COSD(RWA)*RVX(I)-SIND(RWA)*RVY(I)
        RVE(I)=-SIND(RWA)*RVX(I)-COSD(RWA)*RVY(I)
      END DO
C
C Transform the roll, pitch and yaw rates just recovered from aircraft body
C co-ordinates to rates of change of Euler angles.
C
      DO I=2,32
        CALL C_INS1_TRANS_BRATE(RLAT,RALT,RVN(I),RVE(I),RROLR(I),
     &        RPITR(I),RYAWR(I),RROLL(I),RPITC(I),RTHDG(I),RRR1,
     &        RPR1,RYR1)
        RROLR(I)=RRR1
        RPITR(I)=RPR1
        RYAWR(I)=RYR1
      END DO
C
C Retrieve accelerations and transform from platform to aircraft co-ordinates.
C Units are m/s/s and the normal up value is about 9.85.
C
      RAX=FLOAT(IRAW(1,14,I01))*RATMSS
      RAY=FLOAT(IRAW(1,15,I01))*RATMSS
      RAZ=FLOAT(IRAW(1,16,I01))*RATMSS
      CALL C_INS1_TRANS_ACCL(RAX,RAY,RAZ,RROLL(1),RPITC(1),RPA(1),
     -    RACF,RACS,RACU)
C
C Interpolate data onto equispaced 32 Hz intervals, using data time tags
C Because (assuming) the first data sample of each DRS second contains data
C with a time tag that puts the data validity point near the end of the 
C previous second, the data is shifted by one sample interval so that it can
C be accurately interpolated.  As a result there is a 1/32 s shift on all INU
C parameters output by this subroutine and, for example, the 2nd sample in
C each output second has a validity time which is exactly the start of the 
C second, whereas the 1st sample should really be the 32 sample of the previous
C second's data.
C
C It is necessary to interpolate the data because of computation delays and
C differences between the DRS and the INU sampling frequencies.  However since
C all data have an accurate (to 64 us) validity time attached this (linear)
C interpolation is relatively easy to do.
C
      DO I=0,32                        !Time shift the time tags
        RTT(I)=RTT(I)+RTSHFT
      END DO
      DO I=31,0,-1                     !Make sure times increase
        IF(RTT(I).GT.RTT(I+1)) RTT(I)=RTT(I)-1.0
      END DO
C
C If haven't got the last sample from the previous second then extrapolate
C back from the first and second samples of the current second.
C
      IF(.NOT.LNXTSEC) THEN
        RTT(0)=2*RTT(1)-RTT(2)
        RVN(0)=2*RVN(1)-RVN(2)
        RVE(0)=2*RVE(1)-RVE(2)
        RVZ(0)=2*RVZ(1)-RVZ(2)
        RROLL(0)=2*RROLL(1)-RROLL(2)
        RPITC(0)=2*RPITC(1)-RPITC(2)
        RTHDG(0)=2*RTHDG(1)-RTHDG(2)
        RROLR(0)=2*RROLR(1)-RROLR(2)
        RPITR(0)=2*RPITR(1)-RPITR(2)
        RYAWR(0)=2*RYAWR(1)-RYAWR(2)
      END IF
C
C Interpolate the data
C
      DO I=1,32
        IF(.NOT.LINTERP.OR.RTT(I-1).GE.RTT(I).OR.RTT(I-1).LT.-RTSHFT
     &    .OR.RTT(I-1).GT.1.0.OR.RTT(I).LT.-RTSHFT.OR.RTT(I).GT.1.0) 
     &    THEN            !Can't interpolate
          RPROP=1.
        ELSE
          RPROP=(RSINT*(I-1)-RTT(I-1))/(RTT(I)-RTT(I-1)) !Interpolation proporti
        END IF
        RDER(I,VN)=RVN(I-1)+(RVN(I)-RVN(I-1))*RPROP
        RDER(I,VE)=RVE(I-1)+(RVE(I)-RVE(I-1))*RPROP
        RDER(I,VZ)=RVZ(I-1)+(RVZ(I)-RVZ(I-1))*RPROP
        RDER(I,ROLL)=RROLL(I-1)+(RROLL(I)-RROLL(I-1))*RPROP
        RDER(I,PITC)=RPITC(I-1)+(RPITC(I)-RPITC(I-1))*RPROP
        RDER(I,ROLR)=RROLR(I-1)+(RROLR(I)-RROLR(I-1))*RPROP
        RDER(I,PITR)=RPITR(I-1)+(RPITR(I)-RPITR(I-1))*RPROP
        RDER(I,YAWR)=RYAWR(I-1)+(RYAWR(I)-RYAWR(I-1))*RPROP
        RDIFF=MOD(MOD(RTHDG(I)-RTHDG(I-1),360.)+360.,360.) !Heading needs special treatment
        IF(RDIFF.GT.180.) RDIFF=RDIFF-360.
        RDER(I,THDG)=MOD(MOD(RTHDG(I-1)+RDIFF*RPROP,360.)+360.,360.)
      END DO
C
C Save last samples of second for use in next second.
C
      RTT(0)=RTT(32)-RTSHFT            !Restore original time tag
      RVN(0)=RVN(32)
      RVE(0)=RVE(32)
      RVZ(0)=RVZ(32)
      RROLL(0)=RROLL(32)
      RPITC(0)=RPITC(32)
      RTHDG(0)=RTHDG(32)
      RROLR(0)=RROLR(32)
      RPITR(0)=RPITR(32)
      RYAWR(0)=RYAWR(32)
      RLSTSEC=RDER(1,GMT)
C
C Correct attitudes for INU levelling errors.
C
      DO I=1,32
        RDER(I,ROLL)=RDER(I,ROLL)+RCONST(1)
        RDER(I,PITC)=RDER(I,PITC)+RCONST(2)
        RDER(I,THDG)=MOD(MOD(RDER(I,THDG)+RCONST(3),360.)+360.,360.)
      END DO
C
C Compute ground speed and drift angle
C
      DO I=1,32
        RDER(I,IGS)=SQRT(RVN(I)**2+RVE(I)**2)
        IF(RDER(I,VE).EQ.0..AND.RDER(I,VN).EQ.0.) THEN
          RTRK=0.
        ELSE
          RTRK=ATAN2D(RDER(I,VE),RDER(I,VN))
        END IF
        RIDA=MOD(MOD(RTRK-RDER(I,THDG),360.)+360.,360.)
        IF(RIDA.GT.180.) RIDA=RIDA-360.
        RDER(I,IDA)=RIDA
      END DO
C
C Transfer 1Hz data to output buffer.
C
      RDER(1,IACF)=RACF
      RDER(1,IACS)=RACS
      RDER(1,IACU)=RACU
C
C Extrapolate the positions forward to the true start of the second by
C using Euler's method to integrate the equations for the rates of
C change of latitude, longitude and altitude.  Use double precision to
C inhibit further amplification of rounding error, which corresponds to
C position errors on the order of a metre.
C
      IF(LINTERP) THEN
         CALL RLATLONG(DBLE(RLAT),RALT,RVN(1),RVE(1),RL,RLAMBDA,DL,
     &        DLAMBDA)
         DT=DBLE(RTSHFT)-DBLE(RTT(1))
         IF(DT.LT.0.0D0) DT=DT+1.0D0
         RDER(1,ILAT)=REAL(DBLE(RLAT)+DT*DL*RAD2DEG)
         RDER(1,ILNG)=REAL(DBLE(RLNG)+DT*DLAMBDA*RAD2DEG)
         RDER(1,IALT)=REAL(DBLE(RALT)+DT*DBLE(RVZ(1)))
      ELSE !Can't interpolate
         RDER(1,ILAT)=RLAT
         RDER(1,ILNG)=RLNG
         RDER(1,IALT)=RALT
      END IF
C
C Flag the data if required:
C
C   IIU sts bit 15 set (no ASMA link) - All data in sec flagged 3
C   IIU sts bit 14 set (no INU link)  - All data in sec flagged 3
C   IIU sts bit 13 set (no baro info) - All vert in sec flagged 2
C   IIU sts bit 12 set (1553 chip err)- All data in sec flagged 2
C   I14/01 not zero                   - All data in sec flagged 2
C   All zeros word not zero           - All data in sec flagged 2
C   All ones word not FFFF            - All data in sec flagged 2
C   I01/1 bit 1 set (Sensor fail)     - All data in sec flagged 2
C   I01/1 bit 2 set (Nav data fail)   - All data in sec flagged 2
C   I01/1 bit 3 set (Degraded nav)    - All data in sec flagged 2
C   I01/1 bit 4 set (Nav data unav.)  - All data in sec flagged 2
C   I01/1 bit 5 set (Att data fail)   - All data in sec flagged 2
C   I01/1 bit 9 set (Baro invalid)    - All vert in sec flagged 2
C   I01/1 bit 10 set (BIT)            - All data in sec flagged 2
C   I01/29 any bits except 9 (NAV) set- All data in sec flagged 2
C   I01/29 more than one bit set      - All data in sec flagged 2
C   Time tag has a value of FFFE      - All data in sample flagged 3
C
C   Apply max/min/rate of change checks to output parameters.
C
      IF(LFLAG) THEN
        IALLFLG=0
        IVFLG=0
        IF(BTEST(IRAW(1,1,TTAG),15)) IALLFLG=3         !No link to IIU
        IF(BTEST(IRAW(1,1,TTAG),14)) IALLFLG=3         !No link to INU
        IF(BTEST(IRAW(1,1,TTAG),13)) IVFLG=2           !IIU has no baro data
        IF(BTEST(IRAW(1,1,TTAG),12)) IALLFLG=MAX(IALLFLG,2) !IIU 1553 chip error
        IF(IRAW(1,1,VXVY).NE.0) IALLFLG=MAX(IALLFLG,2) !I14/01 has a bit set
        IF(IRAW(1,1,RORR).NE.0) IALLFLG=MAX(IALLFLG,2) !Some 0s missing
        IF(IRAW(1,1,PIPR).NE.'FFFF'X) IALLFLG=MAX(IALLFLG,2) !Some 1s missing
        IF(BTEST(IRAW(1,1,I01),16-1)) IALLFLG=MAX(IALLFLG,2) !Sensor fail
        IF(BTEST(IRAW(1,1,I01),16-2)) IALLFLG=MAX(IALLFLG,2) !Nav data fail
        IF(BTEST(IRAW(1,1,I01),16-3)) IALLFLG=MAX(IALLFLG,2) !Degraded nav
        IF(BTEST(IRAW(1,1,I01),16-4)) IALLFLG=MAX(IALLFLG,2) !Nav data unavail
        IF(BTEST(IRAW(1,1,I01),16-5)) IALLFLG=MAX(IALLFLG,2) !Attitude data fail
        IF(BTEST(IRAW(1,1,I01),16-9)) IVFLG=2                !Baro invalid
        IF(BTEST(IRAW(1,1,I01),16-10)) IALLFLG=MAX(IALLFLG,2) !Doing BIT
        IF(.NOT.BTEST(IRAW(1,29,I01),16-9)) IALLFLG=MAX(IALLFLG,2) !Not NAVIGATE
        ISET=0
        DO I=0,15
          IF(BTEST(IRAW(1,29,I01),I)) ISET=ISET+1
        END DO
        IF(ISET.GT.1) IALLFLG=MAX(IALLFLG,2)
        DO J=1,17
          IFLG(J)=IALLFLG
          IF(J.EQ.3.OR.J.EQ.14.OR.J.EQ.17)
     -        IFLG(J)=MAX(IALLFLG,IVFLG) !Flag vertical measurements separately
          IF(J.EQ.10) IFLG(J)=MAX(IALLFLG,IFLG(1),IFLG(2)) !G/S
          IF(J.EQ.11) IFLG(J)=MAX(IALLFLG,IFLG(1),IFLG(2)) !D/A
        END DO
        DO I=1,32                      !Flag 32Hz parameters
          IFL=0
          IF(IRAW(1,I,TTAG).EQ.'FFFE'X) IFL=3
          DO J=1,11
            IFLAG=MAX(IFL,IFLG(J))
            IP=IPARA(J)
            IF(RDER(I,IP).LT.RPMIN(J).OR.RDER(I,IP).GT.RPMAX(J))
     &           IFLAG=MAX(2,IFLAG) ! Max/min checks
            IF((LNXTSEC.OR.I.GT.1).AND.ITSTFLG(RLSTVAL(J)).LT.2) THEN !ROC chks
              RDIFF=RDER(I,IP)-RLSTVAL(J)
              IF (J.EQ.6) THEN
                 RDIFF=MOD(MOD(RDIFF,360.)+360.,360.)
                 IF(RDIFF.GT.180.) RDIFF=RDIFF-360.
              END IF
              IF(ABS(RDIFF)*32.GT.RPROC(J)) IFLAG=MAX(2,IFLAG)
            END IF
            IF(IFLAG.EQ.3) RDER(I,IP)=0.
            CALL ISETFLG(RDER(I,IP),IFLAG)
            RLSTVAL(J)=RDER(I,IP)      !Save last value
          END DO
        END DO
        DO J=12,17                     !Flag 1Hz parameters
          IFLAG=MAX(IFL,IFLG(J))
          IP=IPARA(J)
          IF(RDER(1,IP).LT.RPMIN(J).OR.RDER(1,IP).GT.RPMAX(J))
     &         IFLAG=MAX(2,IFLAG) ! Max/min checks
          IF(LNXTSEC.AND.ITSTFLG(RLSTVAL(J)).LT.2) THEN !ROC chks
            RDIFF=RDER(1,IP)-RLSTVAL(J)
            IF(ABS(RDIFF).GT.RPROC(J)) IFLAG=MAX(2,IFLAG)
          END IF
          IF(IFLAG.EQ.3) RDER(1,IP)=0.
          CALL ISETFLG(RDER(1,IP),IFLAG)
          RLSTVAL(J)=RDER(1,IP)        !Save last value of second
        END DO
      END IF
C
      RETURN
      END
C*******************************************************************************
      SUBROUTINE C_INS1_MERGE(IEXPVAL,IPART,ISTART,INEWVAL)
CDEC$ IDENT 'V1.00'
C
C Reconstitutes a full sixteen bit word, using the expected 16 bit value, and
C the lowest 8 bits of the new 16 bit value.  Can only work when the expected
C value is correct to within +- 127 bits.
C
C Arguments:  IEXPVAL I*2 In  Expected new value (-32768 to 32767)
C             IPART   I*2 In  Contains new lowest 8 bits, in top or bottom byte
C             ISTART  I*4 In  0 if 8 bits in low bytes, else 8 bits in top byte
C             INEWVAL I*2 Out New value (-32768 to 32767)
C
      INTEGER*2 IEXPVAL,IPART,INEWVAL,ITEMP1,ITEMP2
      INTEGER*4 ISTART
      BYTE      BTEMP1(2),BTEMP2(2)
      EQUIVALENCE (ITEMP1,BTEMP1),(ITEMP2,BTEMP2)

      ITEMP1=IEXPVAL
      ITEMP2=IPART
      IF(ISTART.EQ.0) BTEMP1(1)=BTEMP2(1)
      IF(ISTART.NE.0) BTEMP1(1)=BTEMP2(2)
      IF(ITEMP1-IEXPVAL.GE.128) THEN
        IF(ITEMP1.GE.-32512) THEN
          ITEMP1=ITEMP1-256
        ELSE
          BTEMP1(2)='7F'X              !Heading/azimuth -180 to +180 change
        END IF
      ELSE IF(ITEMP1-IEXPVAL.LE.-128) THEN
        IF(ITEMP1.LE.32511) THEN
          ITEMP1=ITEMP1+256
        ELSE
          BTEMP1(2)='80'X              !Heading/azimuth +180 to -180 change
        END IF
      END IF
      INEWVAL=ITEMP1
      RETURN
      END
C*******************************************************************************
!+    Convert the attitude rate vector into Euler angle rates of change.
!
!     *********************** COPYRIGHT ********************
!     Crown Copyright 2002, Met Office. All rights reserved.
!     *********************** COPYRIGHT ********************
!
!     Subroutine Interface:

      SUBROUTINE C_INS1_TRANS_BRATE(LAT,ALT,VN,VE,RP,RQ,RR,RROL,RPIT,
     &     RHDG,RRR,RPR,RYR)

CDEC$ IDENT 'V2.00'

      IMPLICIT NONE

!     Description: 
!     Transforms attitude rate vector (p,q,r) of the aircraft with respect
!     to the inertial frame expressed in aircraft body co-ordinates to
!     the true yaw, pitch and roll rates (psi', theta' and phi',
!     respectively) about the local geodetic frame's downward axis, an
!     intermediate rotated horizontal axis and the aircraft body frame's
!     forward axis, respectively.
!
!     Method: 
!     The angular frequency vector of the aircraft with respect to the
!     inertial frame has components p, q and r with respect to the
!     aircraft's forward, starboard and downward axes, respectively.  To
!     obtain the angular frequency of the aircraft with respect to the
!     local geodetic frame it is necessary to subtract the sum of the
!     angular frequency of the local geodetic frame with respect to the
!     Earth frame and of the Earth frame with respect to the inertial
!     frame: Omega + rho = (Omega + d lambda / dt) Xhat + d L / dt Yhat,
!     where Xhat and Yhat are, respectively, the unit vectors directed
!     from the Earth's centre towards the north pole and the point in
!     the equatorial plane at 90 degrees west.  The rates of change of
!     latitude L and longitude lambda with respect to time are given by
!     routine RLATLONG in this file.  This vector is now transformed
!     into aircraft body co-ordinates by first transforming it into
!     local geodetic co-ordinates by pre-multiplying by the
!     transformation matrix
!
!     ( cos(L)  0  -sin(L) )
!     (    0    1    0     )
!     ( sin(L)  0   cos(L) )
!
!     to obtain Omega + rho = (Omega + d lambda / d t) cos(L) nhat + d L
!     / d t what + (Omega + d lambda / d t) sin(L) zhat, where nhat,
!     what and zhat are the unit vectors in the northward, westward and
!     upward directions.  Next, this is transformed into aircraft body
!     co-ordinates by pre-multiplying by the direction cosine matrix
!     (DCM) of C_INS1_TRANS_ACCL using the true heading rather than the
!     platform azimuth.  This is itself obtained from a sequence of
!     three Euler angle rotations.  The DCM for a counterclockwise
!     rotation of the true heading psi about the downward geodetic axis
!     is
!
!                      ( cos(psi)  sin(psi)  0 )
!      A3(psi) =       (-sin(psi)  cos(psi)  0 ).
!                      (   0          0      1 )
!
!     Next, the angle about which the pitch angle is defined is obtained
!     by rotating the east axis in the local geodetic frame
!     counterclockwise about the downward geodetic axis by the heading
!     angle psi.  The DCM for a counterclockwise rotation of the pitch
!     angle theta about this intermediate horizontal axis is
!
!                      ( cos(theta)  0  -sin(theta) )
!      A2(theta) =     (    0        1      0       ).
!                      ( sin(theta)  0   cos(theta) )
!
!     The DCM for a counterclockwise rotation of the roll angle phi
!     about the aircraft forward axis is
!
!                      ( 1      0          0    )
!      A1(phi) =       ( 0   cos(phi)  sin(phi) ).
!                      ( 0  -sin(phi)  cos(phi) )
!
!     Finally, the transformation matrix required to flip a
!     north/west/up co-ordinate system into a north/east/down system is
!
!                      ( 1  0  0 )
!     Oflip =          ( 0 -1  0 ).
!                      ( 0  0 -1 )
!
!     Putting these together, the DCM for transforming from the 
!     local geodetic frame to the aircraft body frame is
!     CGB =  A1(phi) A2(theta) A3(psi) Oflip.
!
!     Having subtracted CGB (Omega + rho) from (p, q, r) to obtain the
!     attitude rate vector of the aircraft with respect to the local
!     geodetic frame in aircraft body co-ordinates (p', q', r'), this
!     can be written in terms of the roll rate phi', pitch rate theta'
!     and yaw rate psi' as
!
!     ( p' )   ( phi')           (   0   )                    (  0  )
!     ( q' ) = (  0  ) + A1(phi) ( theta') + A1(phi) A2(theta)(  0  ),
!     ( r' )   (  0  )           (   0   )                    ( psi')
!
!     giving
!
!     p' =  phi' - psi' sin(theta)
!     q' =  theta' cos(phi) + psi' cos(theta) sin(phi)
!     r' = -theta' sin(phi) + psi' cos(theta) cos(phi)
!
!     which inverts to give (when theta != +/- 90 degrees)
!
!     phi' = p' + (q' sin(phi) + r' cos(phi)) tan(theta)
!     theta' = q' cos(phi) - r' sin(phi)
!     psi' = (q' sin(phi) + r' cos(phi)) / cos(theta).
!
!     When theta = +/- 90 degrees, so that the aircraft is pointing
!     straight up or down, the heading and roll angles are no longer
!     unique so the transformation fails.  This condition is trapped to
!     prevent the code crashing in this unlikely eventuality, with roll
!     and yaw rates of 0.0 deg/s returned instead.  There is no need to
!     return a warning flag, however, as pitch angles this steep already
!     trip the max/min checks in the main body of code, leading to
!     computed values having flags of 2.
!
!     Current Code Owner: W.D.N. Jackson
!
!     History:
!     Version  Date      Comment
!
!       1.00   10/01/94  Original code. (W.D.N. Jackson)
!       1.01   09/07/98  Volatile statement added to fix bug which caused 
!                        wrong values to be returned when the input and output 
!                        arguments were the same (W.D.N. Jackson)
!       2.00   08/10/02  Transformations corrected to yield the true yaw, 
!                        pitch and roll rates of the aircraft with respect to 
!                        the local geodetic frame. (G.W. Inverarity)
!
!     Code Description:
!     FORTRAN 77 with extensions recommended in the Met Office F77
!     Standard.
!
!     Scalar arguments with INTENT(IN):
!
      REAL*4 LAT        ! Latitude (deg)
      REAL*4 ALT        ! Altitude (m)
      REAL*4 VN         ! Northward velocity component (m/s)
      REAL*4 VE         ! Eastward velocity component (m/s)
      REAL*4 RP         ! Attitude rate component forward axis (deg/s)
      REAL*4 RQ         ! Attitude rate component starboard axis (deg/s)
      REAL*4 RR         ! Attitude rate component downward axis (deg/s)
      REAL*4 RROL       ! Roll angle phi (deg)
      REAL*4 RPIT       ! Pitch angle theta (deg)
      REAL*4 RHDG       ! Heading angle psi (deg)

!     Scalar arguments with INTENT(OUT):

      REAL*4 RRR        ! Roll rate (deg/s)
      REAL*4 RPR        ! Pitch rate (deg/s)
      REAL*4 RYR        ! Yaw rate (deg/s)

!     Local Parameters:

      REAL*8    OMEGA       ! WGS-84 Earth angular frequency (rad/s)
      PARAMETER (OMEGA=7.292115D-5)

!     Local Scalars:

      REAL*4 CR         ! cos(phi)
      REAL*4 SR         ! sin(phi)
      REAL*4 OMEGAF     ! Angular frequency component forward axis
      REAL*4 OMEGAN     ! Angular frequency component northward axis
      REAL*4 OMEGAS     ! Angular frequency component starboard axis
      REAL*4 OMEGAW     ! Angular frequency component westward axis
      REAL*4 OMEGAU     ! Angular frequency component body upward axis
      REAL*4 OMEGAZ     ! Angular frequency component geodetic upward axis
      REAL*4 RP1        ! Corrected angular frequency component forward axis
      REAL*4 RQ1        ! Corrected angular frequency component starboard axis
      REAL*4 RR1        ! Corrected angular frequency component downward axis
      REAL*4 TERM       ! q' sin(phi) + r' cos(phi)
      REAL*8 DL         ! Rate of change of latitude (rad/s)
      REAL*8 DLAMBDA    ! Rate of change of longitude (rad/s)
      REAL*8 DTERM      ! Omega + d lambda / d t
      REAL*8 RL         ! Meridional radius of curvature (m)
      REAL*8 RLAMBDA    ! Azimuthal radius of curvature (m) / COS(LAT)

!     Functions and subroutines used:

      EXTERNAL C_INS1_TRANS_ACCL ! In this file
      EXTERNAL RLATLONG ! In this file

!-    End of header

! Sum of Earth rate and platform rate angular frequency vectors in
! local geodetic co-ordinates.

      CALL RLATLONG(DBLE(LAT), ALT, VN, VE, RL, RLAMBDA, DL, DLAMBDA)
      DTERM = OMEGA + DLAMBDA
      OMEGAN = REAL(DTERM * COSD(DBLE(LAT)))
      OMEGAW = REAL(DL)
      OMEGAZ = REAL(DTERM * SIND(DBLE(LAT)))

! Transform into forward/starboard/upward aircraft body co-ordinates.

      CALL C_INS1_TRANS_ACCL(OMEGAN, OMEGAW, OMEGAZ, RROL, RPIT, RHDG,
     &     OMEGAF, OMEGAS, OMEGAU)

! Subtract this angular frequency vector from that reported by the INU
! in forward/starboard/downward aircraft body co-ordinates.

      RP1 = RP - OMEGAF
      RQ1 = RQ - OMEGAS
      RR1 = RR + OMEGAU

! Error in the roll rate and yaw rate if the pitch angle is within 2^(-22) 
! of +/- 90 degrees.

      IF (ABS(ABS(RPIT) - 90.0) .LT. 2.3841858E-7) THEN
         RRR = 0.0
         RYR = 0.0
      ELSE
         CR = COSD(RROL)
         SR = SIND(RROL)
         TERM = RQ1 * SR + RR1 * CR

         RRR = RP1 + TERM * TAND(RPIT)
         RYR = TERM / COSD(RPIT)
      END IF
      RPR = RQ1 * CR - RR1 * SR
      RETURN
      END
C*******************************************************************************
      SUBROUTINE C_INS1_TRANS_ACCL(RAX,RAY,RAZ,RROL,RPIT,RHDG,RAF,RAS,
     -    RAU)
C
C Transforms accelerations from the platform (navigation) frame to the 
C aircraft frame.  Uses the transpose of the Direction Cosine Matrix defined
C in SNU 84-1 Rev D, section 6.5.2.
C
C CHANGES         V1.01  24-07-98  G.W. Inverarity
C                 Entries RT(2,1), RT(3,1) corrected.
C
CDEC$ IDENT 'V1.01'
      REAL*4 RT(3,3)                   !Full transformation matrix

      SA=SIND(RHDG)                    !Compute sines and cosines
      CA=COSD(RHDG)
      SP=SIND(RPIT)
      CP=COSD(RPIT)
      SR=SIND(RROL)
      CR=COSD(RROL)
      RT(1,1)=CA*CP                    !Load matrix
      RT(2,1)=CA*SP*SR-SA*CR
      RT(3,1)=CA*SP*CR+SA*SR
      RT(1,2)=-SA*CP
      RT(2,2)=-SA*SP*SR-CA*CR
      RT(3,2)=CA*SR-SA*SP*CR
      RT(1,3)=SP
      RT(2,3)=-CP*SR
      RT(3,3)=-CP*CR
      RAF=RT(1,1)*RAX+RT(1,2)*RAY+RT(1,3)*RAZ !Transform accelerations
      RAS=RT(2,1)*RAX+RT(2,2)*RAY+RT(2,3)*RAZ
      RAD=RT(3,1)*RAX+RT(3,2)*RAY+RT(3,3)*RAZ
      RAU=-RAD                         !Convert down to up
      RETURN
      END

!+    Rates of change of latitude and longitude with time.
!
!     *********************** COPYRIGHT *************************
!     Crown Copyright 2002, Met Office. All rights reserved.
!     *********************** COPYRIGHT *************************
!
!     Subroutine interface:

      SUBROUTINE RLATLONG(LAT, ALT, VN, VE, RL, RLAMBDA, RLAT, RLONG)

CDEC$ IDENT 'V1.00'

      IMPLICIT NONE

!     Description: 
!     Computes the rates of change of latitude and longitude with time.
!
!     Method: 
!     The rate of change of latitude L and longitude lambda with time are, 
!     respectively,
!
!     d L / d t = vn / (rL + h), 
!     d lambda / d t = ve / (rlambda + h) / cos(L),
!
!     where
!
!     rL = R0 (1 - e^2) / (1 - e^2 sin(L)^2)^(3/2), 
!     rlambda = R0 / sqrt(1 - e^2 sin(L)^2), 
!
!     and vn and ve are the components of the aircraft's velocity in the
!     Earth frame in the northward and eastward directions,
!     respectively, h is the aircraft's altitude above the WGS-84
!     ellipsoid, whose radius of curvature and eccentricity are,
!     respectively, R0 and e.
!
!     Note that LAT is REAL*8 and the radii of curvature are returned
!     to allow this routine to be used by INTTEXT:KF_EXTR.FOR as well.
!
!     Current Code Owner: W.D.N. Jackson
!
!     History:
!     Version    Date     Comment
!   
!        1.00    23/09/02 Original code. (G.W. Inverarity)
!
!     Code Description:
!     FORTRAN 77 with extensions recommended in the Met Office F77
!     Standard.
!
!     Scalar arguments with INTENT(IN):

      REAL*8     LAT               ! Latitude (deg)
      REAL*4     ALT               ! Altitude (m)
      REAL*4     VN                ! Northward velocity component (m/s)
      REAL*4     VE                ! Eastward velocity component (m/s)

!     Scalar arguments with INTENT(OUT):

      REAL*8     RL                ! Meridional radius of curvature (m)
      REAL*8     RLAMBDA           ! Azimuthal radius of curvature (m)
                                   ! / COS(LAT)
      REAL*8     RLAT              ! Latitude rate of change (rad/s)
      REAL*8     RLONG             ! Longitude rate of change (rad/s)

!     Local Parameters:

      REAL*8    F                  ! WGS-84 flattening
      PARAMETER(F=1.0D0/298.257223563D0)
      REAL*8    EPSQ               ! WGS-84 eccentricity squared
      PARAMETER(EPSQ=F*(2.0D0-F))
      REAL*8    R0                 ! WGS-84 equatorial radius (m)
      PARAMETER(R0=6.378137D6)

!     Local Scalars:

      REAL*8     TERM              ! 1 - EPSQ SIN(LAT)^2.

!-    End of header

      TERM = 1.0D0 - EPSQ * SIND(LAT) ** 2
      RL = R0 * (1.0D0 - EPSQ) / TERM ** 1.5D0
      RLAMBDA = R0 / SQRT(TERM)
      RLAT = DBLE(VN) / (RL + DBLE(ALT))
      RLONG = DBLE(VE) / (RLAMBDA + DBLE(ALT)) / COSD(LAT)
      RETURN
      END

c_lwc.for

C
C ROUTINE	    C_LWC   SUBROUTINE FORT VAX   [C_LWC.FOR]
C
C PURPOSE	    To calibrate DRS parm 42 to tardis parm 535 (LWC)
C	
C DESCRIPTION 	    The Liquid Water Content (LWC) is a four hertz 
C		    parameter. It requires the True Air Speed (Parm 517), 
C		    True De_iced Temperature (parm 520) and Static 
C		    Pressure (parm 576). All these derived parameters 
C		    (517, 520, 576) are at 32 Hertz. So for each quarter 
C		    point of the LWC requires a sample of eight of 
C		    the derived paramters to be averaged. This is done using
C		    only good data points. If there are not eight samples but
C		    more than one then the flag for the derived LWC is set to 1.
C		    If the frequency of the DRS parm (42) is not equal to 4
C		    then no values are calculated and all four points of the
C		    LWC are set to -9999.0, with a flag of 3. If a point cannot
C		    be calculated then the value of it is set to -9999.0 with
C		    a flag value of 3. If the instrument is saturated then the
C		    flag value is 1. If the derived value for the LWC falls out
C		    of the bounds of -10 to 10 then the flag is set to 2.
C
C VERSION 	    1.02 17-01-96 D Lauchlan
C
C ARGUMENTS         IRAW(64,512) I*4  IN   Raw data for the parameters
C		    IFRQ(512)    I*4  IN   Frequencies of the data
C		    RCONST(64)   R*4  IN   Constants required by routine,(1-28)
C		    RDER(64,1024)R*4  OUT  Tardis parameters
C	
C COMMON	    None.
C                 
C SUBPROGRAMS	    ISETFLG (linked automatically)
C
C FILES		    None.
C	
C REFERENCES	    MRF2 Specification for Total Water Hygrometer 4 Dec 1989
C		    Ouldridge Feb 1982
C                   Johnson 1979
C
C CHANGES           110190 Documentational changes only         M.Glover  
C                   v 1.02 17-01-96 D Lauchlan
C                   Unused parameters removed
C
C                   V1.03  27/09/02  W.D.N.JACKSON
C                   Changed to include handling of 16 bit data from the new 
C                   DRS.
C###############################################################################

        SUBROUTINE C_LWC(IRAW, IFRQ, RCONST, RDER)
CDEC$ IDENT 'V1.03'
        INTEGER*4 IRAW(64,512), IFRQ(512)

	REAL*4 RCONST(64), RDER(64, 1024)
	
C	The frequencies of the derived parameters passed into this module
C	may change. That is why IFRQ_*** has been set up. Here is a table of
C	what values of it corresponds to what frequency;
C
C			Frq	IFRQ_***
C			 4	   0
C			16         1
C			32         7
C			64        15
C
	DATA IFRQ_TAS/7/, IFRQ_TDT/7/, IFRQ_PRESSURE/7/

C	Calibrate the Johnson_Williams Liquid Water Content Probe - DRS 
C	parameter 42, sample rate 4 Hz. This is to be put into g kg-1.
C	This uses the elements of RCONST from 1 to 2.

	IF (IFRQ(42).EQ.4) THEN  ! check the frequency.

		N_TAS=1
		N_TDT=1
		N_PRE=1

		DO IS=1, IFRQ(42)  ! for each sample
                        IRAW_FLAG=0
                        IF(IRAW(IS,42).EQ.0.OR.IRAW(IS,42)
     &                       .EQ.'FFFF'X) IRAW_FLAG=3
		       	ICHECK=1
		       	ICHECK_2=1
			TAS=0.0
			P=0.0
			TDT=0.0

C			See if all the const are there,if not set the flag to 3
		       	DO I=1,2,1
				IF (ITSTFLG(RCONST(I)).GT.2) THEN
					ICHECK=ICHECK+1
				END IF
                        END DO

                        SUM=0  ! Reset the sum.
			ICOUNT=0

C			Find the average of the TAS.
 			DO INC=N_TAS, N_TAS+IFRQ_TAS 
				IFLAG=ITSTFLG(RDER(INC, 517))
				IF (IFLAG.LT.1) THEN
		   			SUM=SUM+RDER(INC, 517)
					ICOUNT=ICOUNT+1
				END IF
   	 		END DO
			
C			Reset the starter for the do loop to be the old start 
C			point plus the incremental for the TAS frequency plus 
C			one.
			N_TAS=N_TAS+IFRQ_TAS+1

			IF (ICOUNT.EQ.0) THEN
C				No good points.
				ICHECK=-9999
			ELSE
	                        IF (ICOUNT.NE.IFRQ_TAS+1) THEN
					ICHECK_2=99
				END IF
	       			TAS=SUM/FLOAT(ICOUNT)
			END IF
 
                        SUM=0.0  ! Reset the sum.
			ICOUNT=0
                        
C			Find the average of the true de_iced temp.
                        DO INC=N_TDT, N_TDT+IFRQ_TDT
				IFLAG=ITSTFLG(RDER(INC, 520))
				IF (IFLAG.LT.1) THEN
			       		SUM=SUM+RDER(INC, 520)
					ICOUNT=ICOUNT+1
				END IF
			END DO

			N_TDT=N_TDT+IFRQ_TDT+1
                        IF (ICOUNT.EQ.0) THEN
				ICHECK=-9999
			ELSE
	                        IF (ICOUNT.NE.IFRQ_TDT+1) THEN
					ICHECK_2=99
				END IF
	       			TDT=SUM/FLOAT(ICOUNT)
			END IF

                        SUM=0  ! Reset the sum.
			ICOUNT=0

C			Find the static pressure average.
			DO INC=N_PRE, N_PRE+IFRQ_PRESSURE
				IFLAG=ITSTFLG(RDER(INC, 576))

C				Only use good data, namley of flag zero.
				IF (IFLAG.LT.1) THEN       
					SUM=SUM+RDER(INC, 576)     
					ICOUNT=ICOUNT+1    
				END IF                     
			END DO
		

			N_PRE=N_PRE+IFRQ_PRESSURE+1

			IF (ICOUNT.EQ.0) THEN
				ICHECK=-9999
			ELSE
	                        IF (ICOUNT.NE.IFRQ_PRESSURE+1) THEN
					ICHECK_2=99
				END IF
				P=SUM/ICOUNT
			END IF
                        
			IF (TDT.LT.10.0) THEN
				ICHECK=-9999
			ELSE
				RHO=(0.3484*P)/TDT
			END IF
		
C			Make sure that division by one does not happen.	
			IF ((TAS.LT.1).OR.(RHO.LT.1E-08)) THEN
				ICHECK=-9999
			END IF
			
C			ICHECK will be more than one if any of the constants 
C			are missing, or the true air speed is zero, or rho
C			is zero. 
			IF (ICHECK.EQ.1.and.icheck_2.eq.1) THEN
				IF(IRAW(IS,42).EQ.0.OR.IRAW(IS,42)
     &                              .EQ.'FFFF'X) IFLAG=3
C			ICHECK_2 will be diffrent than 1 if there are not eight
C			samples for the true de-iced temp or pressure.
			ELSE IF (ICHECK_2.EQ.99.and.icheck.eq.1) THEN
				IFLAG=1
			ELSE
				IFLAG=3
                        END IF
     				
C			If the flag of the raw data is less than three, then 
C			convert the raw data into derived data. This is done 
C			using ;
C
C				LWC=  (A+Bx)*77.2
C				      ------------
C					 TAS*RHO
C
C
C				RHO=0.3484*STATIC_PRESSURE
C				    ----------------------
C					TRUE_DE_ICED_TEMP
C
C

	       	       	IF (IFLAG.LT.3) THEN
		                RAW=FLOAT(IRAW(IS,42))
				RDER(IS, 535)=((RCONST(1)+RCONST(2)*RAW)
     1					       *77.2)/(TAS*RHO)
	     		ELSE

C				If the flag is three or above, set the 
C				derived data to -9999.0.
				RDER(IS, 535)=-9999.0
    			END IF

C			If the derived data is outside the bounds but not 
C			-9999.0, then set the flag to two.
			IF (((RDER(IS, 535).LT.-8.0).OR.
     1					(RDER(IS, 535).GT.8.0)).AND.
     2			    		(RDER(IS, 535).GT.-9000.0)) THEN
				CALL ISETFLG(RDER(IS, 535), 2)

C			If J/W > 300/TAS  set J/W FLAG=1
C			300/tas = instrument saturation value.
C			Ref Ouldridge Feb 1982, Johnson 1979

			ELSE IF	((RDER(IS, 535).GE.-8.0).AND.
     1					(RDER(IS, 535).LE.8.0).AND.
     3			    	     	(RDER(IS, 535).GT.(300/TAS))) THEN
			    	CALL ISETFLG(RDER(IS, 535), 1)

			ELSE

C				The derived data is within the limits then 
C				set the flag to that of the raw data. If the 
C				data is -9999.0 the flag will be three.
			 	CALL ISETFLG(RDER(IS, 535), IFLAG) 
	    		ENDIF

			IF(IRAW_FLAG.GT.ITSTFLG(RDER(IS, 535))) THEN
				CALL ISETFLG(RDER(IS, 535), IRAW_FLAG)
			END IF 

 		END DO    ! For the frequency of the LWC.
        ELSE

C		The data has not got the right frequency.
		DO IS=1,4
			RDER(IS, 535)=-9999.0
			CALL ISETFLG(RDER(IS,535),3)
		END DO
	ENDIF


	RETURN

	END

c_nephl1.for

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!         ROUTINE      C_NEPHL1
!
!         PURPOSE      Calibrates the parameters from the TSI 3 wavelength
!                      Nephelometer.
!
!         DESCRIPTION  The nephelometer output are subject to calibrations
!                      internal to the instrument plus the normal MILLIE/DRS
!                      calibrations.
!
!                      All raw parameters are digital conversions of the input
!                      voltage. The digital values are converted using a
!                      linear fit then the nephelometer internal cals are
!                      applied to obtain the output derived values.
!                      Parameters 175, 176 & 183 are linear thus
!
!                           output = a + b * v /vfs
!
!                      where a and b are nephelometer internal constants,
!                      v the derived voltage and vfs the full scale voltage.
!                      Scattering parameters 177 through 182 are logarithmic
!                      so
!
!                          output = 10**((v/b) - a) - c
!
!                      a, b and c are nephelometer internal constants, v
!                      the derived voltage.
!
!                      Parameter 184, nephelometer status, is the analog output
!                      of a 4 bit D to A converter. The LSB corresponds to 
!                      0.625V.
!
!         VERSION      1.00  D.P.Briggs
!
!         SUBROUTINES  ISETFLG
!
!         FILES        NONE
!
!         REFERENCES   Nephelometer Instruction Manual
!                      Nephelometer internal technical note
!  
!         PARAMETERS   RAW      DERIVED    FREQ   RANGE   UNITS
!  NEPH PRESSURE       175        760      1Hz    0-10V    mb
!  NEPH TEMPERTURE     176        761      1Hz    0-10V    K
!  NEPH BLUE SP        177        762      1Hz    0-10V    /m
!  NEPH GREEN SP       178        763      1HZ    0-10V    /m
!  NEPH RED SP         179        764      1Hz    0-10V    /m
!  NEPH BLUE BSP       180        765      1Hz    0-10V    /m
!  NEPH GREEN BSP      182        766      1Hz    0-10V    /m
!  NEPH RED BSP        181        767      1Hz    0-10V    /m
!  NEPH HUMIDITY       183        768      1Hz    0-5V     %
!  NEPH STATUS         184        769      1Hz    0-10V    bits
! 
!         NEPHELOMETER CONSTANT KEYWORDS
!   CALNPRS  I J A B      
!   CALNTMP  I J A B
!   CALNBTS  I J A B C    NOTE : I & J are multiplexer calibrations.
!   CALNGTS  I J A B C           A, B & C are instrument internal cals.
!   CALNRTS  I J A B C
!   CALNBBS  I J A B C
!   CALNGBS  I J A B C
!   CALNRBS  I J A B C
!   CALNHUM  I J A B
!   CALNSTS  I J
!
!         CHANGES 
!         V1.01  12/05/97  W.D.N.JACKSON
!                Miscellaneous bug fixes, the most serious being the incorrect
!                calculation of the red backscattering coefficient, and a
!                tendency to crash with floating overflows.
!         V1.02  29/05/97  W.D.N.JACKSON
!                Changed to reflect fact that Red BS comes in on 181 and green
!                on para 182.
!         V1.03  19/06/98  W.D.N.JACKSON
!                Changed to reflect fact that bit 3 of the status word is 0
!                (not 1) when on calibrate.
!         V1.04  01/09/02  W.D.N.JACKSON
!                Small changes to handle new 16 bit DRS.  Also status parameter
!                is now calibrated.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE C_NEPHL1(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.04'
      IMPLICIT NONE
      INTEGER   IFLAG,IPARM,ISTAT
      REAL      RVOLT
      INTEGER*4 IRAW(64,512),IFRQ(512)
      REAL*4    RCONST(64),RDER(64,1024)
!
! initialise output values to 0.0 flagged 3
!
      IFLAG = 3
      DO IPARM = 760,769
        RDER(1,IPARM)=0.0
        CALL ISETFLG(RDER(1,IPARM),IFLAG)
      ENDDO  
!
! Check all data valid.  Return if not.
!
      DO IPARM = 175,184
        IF(IRAW(1,IPARM).EQ.0) RETURN
        IF(IRAW(1,IPARM).EQ.'FFFF'X) RETURN
      ENDDO
!
!   184/769 1Hz   NEPH STATUS
! input is voltage proportional to a 4 bit counter at 0.625V (256 bits) per unit
! Status word bits have the following meanings (it is not clear if the status
! word is valid when the lamp is not working):
!   Bit 0 set - Backscatter on
!   Bit 1 set - Chopper on
!   Bit 2 set - Lamp off
!   Bit 3 set - Not on calibrate
!
      IFLAG=0
      RVOLT=FLOAT(IRAW(1,184))*RCONST(44)+RCONST(43)
      ISTAT=NINT(RVOLT/0.625)
      IF(ISTAT.LT.0.OR.ISTAT.GT.15) RETURN
      RDER(1,769) = FLOAT(ISTAT)
      CALL ISETFLG(RDER(1,769),IFLAG)
!
!   175/760 1Hz   NEPH PRESSURE
      RVOLT = RCONST(1) + RCONST(2) * FLOAT(IRAW(1,175))
      RDER(1,760) = RCONST(4) * RVOLT/10.0 + RCONST(3)
      CALL ISETFLG(RDER(1,760),IFLAG)
!      
!   176/761 1Hz   NEPH TEMPERATURE
      RVOLT = RCONST(5) + RCONST(6) * FLOAT(IRAW(1,176))
      RDER(1,761) = RCONST(8) * RVOLT/10.0 + RCONST(7)
      CALL ISETFLG(RDER(1,761),IFLAG)
!
!   183/768 1Hz   NEPH HUMIDITY 
      RVOLT = RCONST(39) + RCONST(40) * FLOAT(IRAW(1,183))
      RDER(1,768) = RCONST(42) * RVOLT/10.0 + RCONST(41)
      CALL ISETFLG(RDER(1,768),IFLAG)
!
! set flags for scattering coeffs:
!  lamp or reference chopper off, flag 3.
!  valve position in calibrate mode flag 2.
!  if not backscatter shutter on flag backscatter coeffs with 3
      IF (BTEST(ISTAT,1) .AND. .NOT.BTEST(ISTAT,2)) THEN
        IF (.NOT.BTEST(ISTAT,3)) IFLAG = 2
!
!   177/762 1Hz   NEPH BLUE SP 
        RVOLT = RCONST(9) + RCONST(10) * FLOAT(IRAW(1,177))
        RDER(1,762) = 10 ** ((RVOLT/RCONST(12)) - RCONST(11)) -
     &                RCONST(13)
        CALL ISETFLG(RDER(1,762),IFLAG)
!
!   178/763 1HZ   NEPH GREEN SP
        RVOLT = RCONST(14) + RCONST(15) * FLOAT(IRAW(1,178))
        RDER(1,763) = 10 ** ((RVOLT/RCONST(17)) - RCONST(16)) -
     &                RCONST(18)
        CALL ISETFLG(RDER(1,763),IFLAG)
!
!   179/764 1Hz   NEPH RED SP
        RVOLT = RCONST(19) + RCONST(20) * FLOAT(IRAW(1,179))
        RDER(1,764) = 10 ** ((RVOLT/RCONST(22)) - RCONST(21)) -
     &                RCONST(23)
        CALL ISETFLG(RDER(1,764),IFLAG)
!
        IF (BTEST(ISTAT,0)) THEN  !backscatter shutter on
!   180/765 1Hz   NEPH BLUE BSP  
          RVOLT = RCONST(24) + RCONST(25) * FLOAT(IRAW(1,180)) 
          RDER(1,765) = 10 ** ((RVOLT/RCONST(27)) - RCONST(26)) -
     &                  RCONST(28)
          CALL ISETFLG(RDER(1,765),IFLAG)
!
!   182/766 1Hz   NEPH GREEN BSP
          RVOLT = RCONST(29) + RCONST(30) * FLOAT(IRAW(1,182))
          RDER(1,766) = 10 ** ((RVOLT/RCONST(32)) - RCONST(31)) -
     &                  RCONST(33)
          CALL ISETFLG(RDER(1,766),IFLAG)
!
!   181/767 1Hz   NEPH RED BSP  
          RVOLT = RCONST(34) + RCONST(35) * FLOAT(IRAW(1,181))
          RDER(1,767) = 10 ** ((RVOLT/RCONST(37)) - RCONST(36)) -
     &                  RCONST(38)
          CALL ISETFLG(RDER(1,767),IFLAG)
        ENDIF
      ENDIF
!
      RETURN
      END

c_nevz.for

C
C ROUTINE          C_NEVZ SUBROUTINE FORTVAX
C     
C PURPOSE          Produces calibrated Nevzorov parameters
C
C DESCRIPTION      Calculates liquid and total water values for the Nevzorov
C                  together with reference and collector voltages, using the
C                  equations supplied with the unit, namely:
C
C                  Water content = V**2/U/L/SR
C
C                  where V is the output voltage (V)
C                        U is the True air speed (m/s)
C                        L is the energy expended in heating and evaporating
C                             the water, for which a value of 2589 J/g is used
C                        SR is the product of the sensor area and the resistanc
C                           of the collector sensor at the chosen temperature.
C
C                  Flagging:
C
C                  If on Calibrate, as indicated by bit 1 or 2 in the signal
C                  register being set then the data is flagged with a 2.
C                  Otherwise the data carries the flag of the True Airspeed
C                  parameter.
C
C VERSION          1.00  18/01/99  W.D.N.JACKSON
C
C ARGUMENTS     
C                  Constants:
C                  RCONST(1)   CALNVLW X0
C                  RCONST(2)   CALNVLW X1
C                  RCONST(3)   CALNVLR X0
C                  RCONST(4)   CALNVLR X1
C                  RCONST(5)   CALNVLC X0
C                  RCONST(6)   CALNVLC X1
C                  RCONST(7)   CALNVTW X0
C                  RCONST(8)   CALNVTW X1
C                  RCONST(9)   CALNVTR X0
C                  RCONST(10)  CALNVTR X1
C                  RCONST(11)  CALNVTC X0
C                  RCONST(12)  CALNVTC X1
C                  RCONST(13)  CALRSL X0     RS Value at T0
C                  RCONST(14)  CALRSL T0
C                  RCONST(15)  CALRST X0     RS value at T0
C                  RCONST(16)  CALRST T0
C
C                  Inputs: 
C                  NVLW Nevzorov Liquid Water                   Para 208  8 Hz
C                  NVLR Nevzorov Liquid Reference               Para 209  8 Hz
C                  NVLC Nevzorov Liquid Collector               Para 210  8 Hz
C                  NVTW Nevzorov Total Water                    Para 211  8 Hz
C                  NVTR Nevzorov Total Reference                Para 212  8 Hz
C                  NVTC Nevzorov Total Collector                Para 213  8 Hz
C                  SREG Signal register [bits 1-2]              Para  27  2 Hz
C                  TAS  True airspeed                           Para 517 32 Hz
C
C                  Outputs: 
C                  NVLW Nevzorov Liquid Water     [gm-3]         Para 602 8 Hz
C                  NVLR Nevzorov Liquid Reference [V]            Para 603 8 Hz
C                  NVLC Nevzorov Liquid Collector [V]            Para 604 8 Hz
C                  NVTW Nevzorov Total Water      [gm-3]         Para 605 8 Hz
C                  NVTR Nevzorov Total Reference  [V]            Para 606 8 Hz
C                  NVTC Nevzorov Total Collector  [V]            Para 607 8 Hz
C                
C SUBPROGRAMS      ITSTFLG          Examines bits 16,17 for flags
C                  ISETFLG          Sets flag bits 16,17 = 0 --> 3
C
C REFERENCES       
C
C CHANGES           V1.01  27/09/02  W.D.N.JACKSON
C                   Changed to include handling of 16 bit data from the new 
C                   DRS.
C                   V1.02  13/11/06
C                   Signal register bits 1 and 2 swapped to be the correct way
C                   round 1=TW, 2=LW
C                   V1.03  12/12/06
C                   Voltage flags explicitly set to zero
C
C*******************************************************************************
      SUBROUTINE C_NEVZ(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.03'
      INTEGER*4 IRAW(64,512),IFRQ(512)
      REAL*4    RCONST(64),RDER(64,1024)

      RERR=0.                          !Default error return
      CALL ISETFLG(RERR,3)             ! is 0 flagged 3
      DO I=1,8                         !For each sample
        RTAS=RDER((I-1)*4+1,517)
        ITASFLG=ITSTFLG(RTAS)          !Note TAS flag
        CALL ISETFLG(RTAS,0)           !Clear TAS flag
        IF(RTAS.LE.0) ITASFLG=3        !Invalid TAS
        RDER(I,602)=RERR               !Default return
        RV=RCONST(1)+RCONST(2)*IRAW(I,208) !Compute voltage
        IF(ITASFLG.LT.3) THEN          !If TAS valid
          RDER(I,602)=RV*RV/RTAS/2589/RCONST(13) !Compute liquid water
          CALL ISETFLG(RDER(I,602),0)
          IF(.NOT.BTEST(IRAW(1,27),2)) CALL ISETFLG(RDER(I,602),2) !Flag 2 if on cal
        END IF
        RDER(I,603)=RCONST(3)+RCONST(4)*IRAW(I,209) !Calibrate voltages
        RDER(I,604)=RCONST(5)+RCONST(6)*IRAW(I,210)
	CALL ISETFLG(RDER(I,603),0)
	CALL ISETFLG(RDER(I,604),0)
        RDER(I,605)=RERR               !Repeat the processing for total water
        RV=RCONST(7)+RCONST(8)*IRAW(I,211)
        IF(ITASFLG.LT.3) THEN
          RDER(I,605)=RV*RV/RTAS/2589/RCONST(15)
          CALL ISETFLG(RDER(I,605),0)
          IF(.NOT.BTEST(IRAW(1,27),1)) CALL ISETFLG(RDER(I,605),2)
        END IF
        RDER(I,606)=RCONST(9)+RCONST(10)*IRAW(I,212)
        RDER(I,607)=RCONST(11)+RCONST(12)*IRAW(I,213)
	CALL ISETFLG(RDER(I,606),0)
	CALL ISETFLG(RDER(I,607),0)
      END DO
C
      RETURN
      END

c_nox.for

C
C ROUTINE	C_NOX SUBROUTINE FORTVAX
C
C PURPOSE	A subroutine to calculate Nitrogen monoxide, Nitrogen dioxide
C		and NOx measured by the TECO 42 NOx analyser.
C
C DESCRIPTION	The NOx analyser outputs three measurements, NO, NO2 and NOx.
C		These are input to the program as DRS bits, and converted
C		into PPB by multiplying the DRS bits by a calibration factor.
C
C
C TO COMPILE	$FORT C_NOX
C
C VERSION	1.00  28 Sept. 1998  	I. Hawke
C               1.01  23 June. 1999     I. Hawke     5ppb Offset included
C               1.02  07 Mar   2000     I. Hawke     Offset removed
C               1.03  07 Mar   2000     I. Hawke     5ppb offset included
C               1.04  29 Mar   2000     I. Hawke     New Conversion Algorithm
C               1.05  30 Mar   2000     I. Hawke     Flow Testing Added
C               1.06  02 Oct   2002     N. Jackson   Modified for 16 bit DRS
C               1.07  27 Oct   2005     D.Tiddeman   New constants for flagging
C                                                    low airspeeds or out of
C                                                    range values.
C               1.08  05 Dec  2005      D.Tiddeman   No flag 2 for negative
C                                                                               
C ARGUMENTS	IRAW(1,203) - on entry contains the raw NO signal
C		IRAW(1,204) - on entry contains the raw NO2 signal
C		IRAW(1,205) - on entry contains the raw NOx signal
C               IRAW(1,114) - on entry contains ozone flow signal
C               RCONST(1,2,3,4) XO and X1 voltage cal for NO, v to ppb, ppb offs
C               RCONST(5,6,7,8) same for NO2
C               RCONST(9,10,11,12) same for NOx
C               RCONST(13,14) X0 and X1 voltage cal for Ozone flow
C		RDER(1,770) - on exit contains the derived NO signal
C		RDER(1,771) - on exit contains the derived NO2 signal
C		RDER(1,772) - on exit contains the derived NOx signal
C
C*******************************************************************************
      SUBROUTINE C_NOX(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.08'
      IMPLICIT NONE
      INTEGER*4 IRAW(64,1024),IFRQ(512)                 
      INTEGER   IFLG,IFLG1,ITSTFLG,IS
      REAL*4 NO,NO2,NOX,OZF,RERR
      REAL*4 RCONST(64),RDER(64,1024)
C
C
C Set default values for output
C
      RERR=0.
      CALL ISETFLG(RERR,3)
      RDER(1,770)=RERR
      RDER(1,771)=RERR
      RDER(1,772)=RERR

C     Copy across raw signals
C
      NO=FLOAT(IRAW(1,203))
      NO2=FLOAT(IRAW(1,204))
      NOX=FLOAT(IRAW(1,205))
      OZF=FLOAT(IRAW(1,114))
C
C     Convert TECO NOX DRS signals first to voltage, than apply voltage to 
C     ppb conversion, then subtract instrument offset which ensures signal
C     voltage doesn't go negative.
C
      NO=(RCONST(1)+NO*RCONST(2))*RCONST(3)-RCONST(4)
      NO2=(RCONST(5)+NO2*RCONST(6))*RCONST(7)-RCONST(8)
      NOX=(RCONST(9)+NOX*RCONST(10))*RCONST(11)-RCONST(12)
C
C Convert ozone flow to voltage
C
      OZF=RCONST(13)+OZF*RCONST(14)
C
C Do flagging
C
      IF(IRAW(1,114).EQ.0) RETURN
      IF(IRAW(1,114).EQ.'FFFF'X) RETURN
      IF(OZF.LE.0.) RETURN             !Reject data if pump off or not recorded
C
      IFLG1=0
      IF(ITSTFLG(RCONST(17)).EQ.0)THEN
        DO IS=1,32
          IF(IRAW(IS,223).LT.62*RCONST(17)) IFLG1=1
        ENDDO
      ENDIF
      IFLG=IFLG1
      IF(IRAW(1,203).EQ.0) IFLG=3
      IF(IRAW(1,203).EQ.'FFFF'X) IFLG=3
      IF(ITSTFLG(RCONST(15)).EQ.0.AND.ITSTFLG(RCONST(16)).EQ.0)THEN
        IF(NO.LT.RCONST(15).OR.NO.GT.RCONST(16))IFLG=3
      ENDIF
      CALL ISETFLG(NO,IFLG)
      RDER(1,770)=NO
C
      IFLG=IFLG1
      IF(IRAW(1,204).EQ.0) IFLG=3
      IF(IRAW(1,204).EQ.'FFFF'X) IFLG=3
      IF(ITSTFLG(RCONST(15)).EQ.0.AND.ITSTFLG(RCONST(16)).EQ.0)THEN
        IF(NO2.LT.RCONST(15).OR.NO2.GT.RCONST(16))IFLG=3
      ENDIF
      CALL ISETFLG(NO2,IFLG)
      RDER(1,771)=NO2
C
      IFLG=IFLG1
      IF(IRAW(1,205).EQ.0) IFLG=3
      IF(IRAW(1,205).EQ.'FFFF'X) IFLG=3
      IF(ITSTFLG(RCONST(15)).EQ.0.AND.ITSTFLG(RCONST(16)).EQ.0)THEN
        IF(NOX.LT.RCONST(15).OR.NOX.GT.RCONST(16))IFLG=3
      ENDIF
      CALL ISETFLG(NOX,IFLG)
      RDER(1,772)=NOX
C

      RETURN 
      END

c_ozone1.for

C
C ROUTINE	C_OZONE1 SUBROUTINE FORTVAX
C
C PURPOSE	A subroutine to calculate the ozone mixing ratio.
C
C DESCRIPTION   Calibration routine for TECO OZONE
C               Fourth order fit for temperature transducer
C               Linear fit for pressure transducer
C               Signal 10V =1000 ppb ozone corrected by pressure and temperature                              
C
C TO COMPILE	$FORT C_OZONE1
C
C VERSION	    1.00  30th Aug 1996  D.Tiddeman   Module Written
C               1.01  12th Sep 1999  I. Hawke     O3 Smoothing Algorithm
C               1.02  2 Oct 2002     N. Jackson   Convert to work on new DRS
C               1.03  11 Feb 2005   D.Tiddeman   No longer does P+T correction
C		1.04  Unknown       D.Tiddeman   RVSM, min and max flags addeds
C               1.05  31 Jan 2007   R Purvis     Rewritten to take out P, T
C                                                corrections
C					         Flow commented out
C                                                                             
C ARGUMENTS	IRAW(1,100) - on entry contains the raw ozone signal
C		IRAW(1,114) - on entry contains the raw ozone flow
C		IRAW(1,223) - on entry contains the raw rvsm airspeed
C		RCONST(X)  
C		RDER(1,574) - on exit contains the derived ozone mixing ratio
C
C
C*******************************************************************************
      SUBROUTINE C_OZONE1(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.05'
      IMPLICIT NONE
      INTEGER*4 IRAW(64,512),IFRQ(512)   
      INTEGER   IFLG,ITSTFLG,POINT,IS
      REAL*4 OZSIG
      REAL*4 RCONST(64),RDER(64,1024),FLOW
C
C	INITIALISE OZONE CHANNEL TO ZERO
C
      RDER(1,574)=0.0
C
C     SET UNUSED CHANNELS TO -9999 AND FLAG AS 3
C
C	RDER(1,691) = -9999
C      CALL ISETFLG(RDER(1,691),3)
C	RDER(1,692) = -9999
C      CALL ISETFLG(RDER(1,692),3)
C      RDER(1,693) = -9999
C      CALL ISETFLG(RDER(1,693),3)

C     SKIP PROCESSING IF ANY RAW DATA INVALID
C
      IFLG=0
      IF((IRAW(1,100).EQ.0).OR.(IRAW(1,100).EQ.'FFFF'X)) IFLG=3
C     IF(IRAW(1,114).EQ.0) IFLG=3
C     IF(IRAW(1,114).EQ.'FFFF'X) IFLG=3
C     FLOW=RCONST(16)+IRAW(1,114)*RCONST(17) !Flow in volts
C     IF(FLOW.LE.0.) IFLG=3
      IF(IFLG.EQ.3) GOTO 100 
C
C     CALCULATE OZONE MIXING RATIO
C
      ozsig=FLOAT(IRAW(1,100))	    ! ozsig becomes ozone signal
      ozsig=rconst(1)+ozsig*rconst(2)   ! convert drs bits to volts
      OZSIG=OZSIG*RCONST(4)+RCONST(3)   ! IN PPB
      RDER(1,574) = OZSIG
C
C 	INSERT FLAGS FOR ON GROUND USING RVSM(223)VALUE AND MIN AIR SPEED(21)
c 	MIN VALUE (18), OUTSIDE CALIBRATION RANGE(19, 300PPBv) AND MAX VALUE (20, 500PPBv)
C   
      IF(IFLG.EQ.0)THEN
      IF(ITSTFLG(RCONST(21)).EQ.0)THEN
        DO IS=1,32
          IF(IRAW(IS,223).LT.62*RCONST(21)) IFLG=1
        ENDDO
      ENDIF
      IF((ITSTFLG(RCONST(18)).EQ.0.AND.ITSTFLG(RCONST(19))).EQ.0
     &   .AND.ITSTFLG(RCONST(20)).EQ.0)THEN
        IF(OZSIG.GT.RCONST(19))IFLG=2
        IF(OZSIG.LT.RCONST(18).OR.OZSIG.GT.RCONST(20))IFLG=3
      ENDIF
      ENDIF
C
C     FLAG OZONE SIGNAL
C
  100 CALL ISETFLG(RDER(1,574),IFLG) 
      RETURN
      END

c_press1.for

!
! ROUTINE          C_PRESS1 SUBROUTINE FORTVAX
!     
! PURPOSE          Calibrates the cabin pressure sensor and the S9 static port.
!
! DESCRIPTION      Apply calibration the combined transducer and DRS 
!                  coefficients to DRS parameters 14 and 221 to obtain derived
!                  parameters 579 and 778.  Invalid data is flagged with 3, data
!                  outside limits is flagged with 2.
!
! METHOD           For each DRS parameter to be calibrated:
!                  1. If data is FFFF or FFFE then flag 3
!                  2. Apply the calibration constants
!                  3. Check the results for being within acceptable values.
!                  4. Set data flag bits (16+17) 0: Good data
!                                                1: Data of lower quality
!                                                2: Probably faulty, exceed lims
!                                                3: Data absent or invalid.
!
!                  Flagging - If a value can't be computed, due to missing data
!                  missing constants, divide be zeroes, etc, a value of 0 is
!                  used, flagged with a three.  If a value is outside its 
!                  limits for range or rate of change, it is flagged with a two.
!                  If there are no problems with the data it is flagged with 0.
!
! VERSION          1.00  23/07/03  W.D.N.JACKSON
!
! ARGUMENTS        Inputs:
!                    DRS para  14 CABP  1 Hz Cabin pressure              
!                        para 221 S9SP 32 Hz S9 static pressure
!
!                  Constants:
!                        RCONST(1 to 3) Para 14 cal constants X0 to X2
!                        RCONST(4 to 6) Para 221 cal constants X0 to X2
!
!                  Outputs:
!                    Derived para 579 CABP mb  1 Hz Cabin pressure 
!                            para 778 S9SP mb 32 Hz S9 static pressure
!
!                  Flags:
!                    Missing/corrupt data output as 0 flagged 3.
!                    Out of range data flagged 2.
!
! SUBPROGRAMS      ISETFLG 
!
! REFERENCES       
!
! CHANGES          V1.00 23/07/03  WDNJ Original version
!                  Note that V1.00 has no application of S9 position errors.
!

c_press.for

C
C ROUTINE          C_PRESS SUBROUTINE FORTVAX
C     
C PURPOSE          Calibrates static, Pitot-static and cabin pressures.  Derives
C                  pressure height.
C
C DESCRIPTION      Apply calibration coefficients to DRS parameters 8, 9 and 14
C                  to obtain Static Pressure (Para 576), Pitot-static pressure
C                  (Para 577) and Cabin Pressure (Para 579) in mb; also derive
C                  Pressure height (Para 578) in metres.  Parameter 14 does not
C                  have to be present and if absent Para 579 is filled with 0's
C                  flagged with threes.
C
C METHOD           For each DRS parameter to be calibrated:
C                  1. Check all its required constants are present (FLAG <3)
C                  2. Mask the 12 data bits and float the result.
C                  3. Calibrate the value using the constants within a linear
C                     or quadratic equation.
C                  4. Check the result for being within acceptable values.
C                  5. Set data flag bits (16+17) 0: Good data
C                                                1: Data of lower quality
C                                                2: Probably faulty, exceed lims
C                                                3: Data absent or invalid.
C                  Note that parameter 14 (cabin pressure) is optional; this
C                  module will be called by CALIBRATE whether the DRS was
C                  recording cabin pressure or not.
C
C                  Flagging - If a value can't be computed, due to missing data
C                  missing constants, divide be zeroes, etc, a value of 0 is
C                  used, flagged with a three.  If a value is outside its 
C                  limits for range or rate of change, it is flagged with a two.
C                  If there are no problems with the data it is flagged with 0.
C                  Any flags on input data are propagated through subsequent 
C                  calculations.
C
C VERSION          1.01  280892   A.D.HENNINGS
C
C ARGUMENTS        For Static pressure:
C                    RCONST(1) - REAL*4 IN   Constant in quadratic calib eqn.
C                    RCONST(2) - REAL*4 IN   Coeff X  in quadratic calib eqn.
C                    RCONST(3) - REAL*4 IN   Coeff X2 in quadratic calib eqn.
C                    IFRQ(8)   - INT*4  IN   Input frequency of sampling
C                    IRAW(IN,8)- INT*4  IN   Raw DRS static pressure sensor o/p
C                                            (samples IF = 1,IFRQ(8))
C                    RDER(OP,576) REAL*4 OUT Derived static pressure in mb.
C                                            (samples OP = 1,32)
C                  For Pitot-static pressure:
C                    RCONST(4) -  REAL*4 IN  Constant in linear calib eqn.
C                    RCONST(5) -  REAL*4 IN  Coeff X  in linear calib eqn.
C                    IFRQ(9)   -  INT*4  IN  Input frequency of sampling
C                    IRAW(IN,9)-  INT*4  IN  Raw DRS Pitot-static press sens o/p
C                                            (samples IF = 1,IFRQ(9))
C                    RDER(OP,577) REAL*4 OUT Derived Pitot-static pressure in mb
C                                            (samples OP = 1,32)
C                  For Pressure height:      
C                    RDER(IN,576) REAL*4 IN  Derived static pressure in mb.
C                                            (samples IN = 1,32)
C                    RDER(OP,578) REAL*4 OUT Derived Pressure height in metres
C                                            (samples OP = 1,32)
C                    n.b. computed by S_PHGT, valid limits -206.0m to 11.0km
C
C                  For Cabin pressure:
C                    RCONST(6) -  REAL*4 IN  Constant in quadratic calib eqn.
C                    RCONST(7) -  REAL*4 IN  Coeff X  in quadratic calib eqn.
C                    RCONST(8) -  REAL*4 IN  Coeff X2 in quadratic calib eqn.
C                    IFRQ(14) -   INT*4  IN  Input frequency of sampling
C                    IRAW(IN,14)  INT*4  IN  Raw DRS Cabin pressure sensor o/p
C                                            (samples IF = 1,IFRQ(14)) 1HZ
C                    RDER(OP,579) REAL*4 OUT Derived Cabin pressure in mb
C                                            (samples OP = 1)
C
C SUBPROGRAMS      S_PHGT, S_QCPT, ITSTFLG, ISETFLG 
C
C REFERENCES        Range limits taken from MRF1/MRF2 and match the sensor range
C                  Rates of change estimated using a max rate of descent
C                  of approx 1000m /minute give Static pressure r.o.c. of 
C                  0.05 mb between 32Hz samples, which is less than the
C                  resolution of 0.25 mb per DRS unit. Therefore the r.o.c.
C                  limit for static pressure is set to 1mb between samples,
C                  as the typical noise at low level is less than 3 units
C                  (=0.75 mb).
C                   The Pitot-static system is much noisier at low level
C                  and samples may be up to 50 DRS units different. Therefore 
C                  the r.o.c. limit is set to 1.5 mb (37 DRSU) to capture 
C                  only the extreme noise and spikes.
C                   The Cabin pressure sensor is of the same type as is used
C                  in the Static pressure system. Limits on normal range are
C                  the same maximum pressure as Static, a minimum set of 650mb
C                  which is marginally lower than the altitude power cut-out
C                  switch's activating level at 10,000ft.  Rates of change can
C                  vary in excess of environmental rates due to manual control
C                  of cabin pressurisation.
C                  
C CHANGES          V1.00 23/01/90  ADH Original version
C                  V1.01 28/08/92  Includes calibration of CABIN pressure (ADH)
C                  V1.02 02/06/93  Pitot-static r.o.c. limit now set to 4.4mb 
C                  (was 1.5mb) between samples.  This is based on analysis of 
C                  the high turbulence A257 flight when there were meaningful 
C                  changes of up to 4.0 mb between samples.  The limit on rate 
C                  of change of cabin pressure has been adjusted to 2.5mb/s in
C                  the light of experience.  Data flagged 2 is now processed, 
C                  and data flags propagate consistently.  (WDNJ)
C
C*******************************************************************************
      SUBROUTINE C_PRESS(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.02'
C
      IMPLICIT  INTEGER*4 (I)
      IMPLICIT  REAL*4    (R)
      INTEGER*4 IRAW(64,512),IFRQ(512)
      REAL*4    RCONST(64),RDER(64,1024)
      INTEGER*4 ICFLAG(8)
      DATA      R576ERCNT, R577ERCNT,R577ERCNT /3*1.0/ !S_QCPT error counts
      DATA      RLV576,RLV577,RLV579 /3*0./            !S_QCPT last good values
      DATA      RLT576,RLT577,RLT579 /3*0./            !S_QCPT last times
C
      PARAMETER R576MX=1050.           !Max static pressure (mb)
      PARAMETER R576MN=100.            !Min static pressure (mb)
      PARAMETER R576RG=1.              !Max static pressure change (32mb/s)
      PARAMETER R577MX=125.            !Max Pitot-static pressure (mb)
      PARAMETER R577MN=0.              !Min Pitot-static pressure (mb)
      PARAMETER R577RG=4.4             !Max Pitot-static pressure chnge (32mb/s)
      PARAMETER R579MX=1050.           !Max cabin pressure (mb)
      PARAMETER R579MN=650.            !Min cabin pressure (mb)
      PARAMETER R579RG=2.5             !Max cabin pressure change mb/s
C
C Note that if this routine does not compute a value for any reason then
C CALIBRATE will automatically use values of zero flagged with threes.
C
      SAVE
C      SAVE RLV576,RLV577,RLV579
C      SAVE RLT576,RLT577,RLT579
C      SAVE R576ERCNT,R577ERCNT,R579ERCNT

      DO IT=1,8
        ICFLAG(IT)=ITSTFLG(RCONST(IT)) !Note Constants flags
      END DO
      RSEC=RDER(1,515)                 !Time - seconds past midnight
C
C Derive static pressure and pressure height
C
      ICONFLG=MAX(ICFLAG(1),ICFLAG(2),ICFLAG(3)) !Check constants flags
      IF(ICONFLG.LT.3.AND.IFRQ(8).GT.0) THEN
        DO IS=1,IFRQ(8)                !For each data sample
          RVAL=FLOAT(IRAW(IS,8).AND.'FFF'X) !Just keep 12 DRS bits
          ISTPFLG= 0 !ITSTFLG(IRAW(IS,8))  !Check for GOULD flags
          IF(ISTPFLG.LT.3) THEN 
            RDER(IS,576)=(RVAL*RCONST(3)+RCONST(2))*RVAL+RCONST(1) !Cal static
            CALL S_QCPT(RSEC,RLT576,RDER(IS,576),RLV576, !Quality control point
     -          R576MX,R576MN,R576RG,3.,R576ERCNT,IQFLAG)
            ISTPFLG=MAX(ISTPFLG,IQFLAG)
            CALL ISETFLG(RDER(IS,576),ISTPFLG) !Apply flag
            IF(ISTPFLG.LT.3) CALL S_PHGT(RDER(IS,576),RDER(IS,578)) !Press hght
          END IF
        END DO                         !Next sample
      END IF
C
C Derive Pitot-static pressure
C 
      ICONFLG=MAX(ICFLAG(4),ICFLAG(5)) !Check constants flags
      IF(ICONFLG.LT.3.AND.IFRQ(9).GT.0) THEN
        DO IS=1,IFRQ(9)                !For each data sample
          RVAL=FLOAT(IRAW(IS,9).AND.'FFF'X) !Just keep 12 DRS bits
          IPSPFLG=0 !ITSTFLG(IRAW(IS,9))  !Check for GOULD flags
          IF(IPSPFLG.LT.3) THEN
            RDER(IS,577)=RVAL*RCONST(5)+RCONST(4) !Calibrate Pitot-static
            CALL S_QCPT(RSEC,RLT577,RDER(IS,577),RLV577, !Quality control point
     -          R577MX,R577MN,R577RG,3.,R577ERCNT,IQFLAG)
            IPSPFLG=MAX(IPSPFLG,IQFLAG)
            CALL ISETFLG(RDER(IS,577),IPSPFLG) !Apply flag
          END IF
        END DO                         !Next sample
      ENDIF
C
C Derive Cabin Pressure - note that this parameter was never processed on the
C GOULD computer so there is no need to check the raw data for flags.
C 
      ICONFLG=MAX(ICFLAG(6),ICFLAG(7),ICFLAG(8)) !Check constants flags
      IF(ICONFLG.LT.3.AND.IFRQ(14).GT.0) THEN
        DO IS=1,IFRQ(14)               !For each data sample
          RVAL=FLOAT(IRAW(IS,14).AND.'FFF'X) !Just keep 12 DRS bits
          RDER(IS,579)=(RVAL*RCONST(8)+RCONST(7))*RVAL+RCONST(6) !Cal cabin pres
           CALL S_QCPT(RSEC,RLT579,RDER(IS,579),RLV579, !Quality control point
     -        R579MX,R579MN,R579RG,3.,R579ERCNT,IQFLAG)
         CALL ISETFLG(RDER(IS,579),IQFLAG) !Apply flag
        END DO                         !Next sample
      END IF
C 
      RETURN
      END

c_psap.for

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!         ROUTINE      C_PSAP
!
!         PURPOSE      Calibrates the parameters from the Particle Soot
!                      Absorbtion Photometer (PSAP).
!
!         DESCRIPTION  All raw parameters are digital conversions of the input
!                      voltage. The digital values are converted using a
!                      linear fit then the instrument cals are
!                      applied to obtain the output derived values.
!                      Parameter 175 is linear thus
!
!                           output = v * 0.5E-5
!
!                      v the derived voltage and vfs the full scale voltage.
!                      Parameter 177 is logrithmic so
!
!                          ouput = 10**((v/2.0) - 7.0)
!
!
!         VERSION      1.00  D.P.Briggs
!
!         SUBROUTINES  ISETFLG
!
!         FILES        NONE
!
!         PARAMETERS   RAW      DERIVED    FREQ   RANGE   UNITS
!  PSAP LIN ABS COEFF  185        648      1Hz    0-10V    /m
!  PSAP LOG ABS COEFF  186        649      1Hz    0-10V    /m
!  PSAP TRANSMITTANCE  187                 1Hz    0-10V
!  PSAP FLOW RATE      188                 1Hz    0-10V
!
!         PSAP CONSTANT KEYWORDS
!  CALPLIN   i j    NOTE : i & j are multiplexer calibrations.
!  CALPLOG   i j
! 
!         CHANGES 
!
!         V1.01  01/10/02  W.D.N.JACKSON
!         Adjusted for 16 bit data from the new DRS
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE C_PSAP(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.01'
      IMPLICIT NONE
      INTEGER*4 IRAW(64,512),IFRQ(512)
      REAL*4    RCONST(64),RDER(64,1024)
      REAL      RVOLT
      INTEGER*4 IFLAG,IPARM,IFREQ,IT,IF
!
! initialise output values to 0.0 flagged 3
      IFLAG = 3
      DO IPARM = 648,649
        DO IFREQ = 1,IFRQ(IPARM-463)
          RDER(IFREQ,IPARM)=0.0
          CALL ISETFLG(RDER(IFREQ,IPARM),IFLAG)
        ENDDO
      ENDDO  
!
! Check for possible error in DRS data by checking for all 0s or 1s.
! Do not process futher if any parameter is found faulty.
!
      IFLAG = .FALSE.
      DO IPARM = 185,188
        DO IFREQ = 1,IFRQ(IPARM)
          IF(IRAW(IFREQ,IPARM).EQ.0) IFLAG=.TRUE.
          IF(IRAW(IFREQ,IPARM).EQ.'FFFF'X) IFLAG=.TRUE.
        ENDDO
      ENDDO
      IF (IFLAG) RETURN
!
! FLAGGING SCHEME
!   filter transmittance < 0.5 flag 1
!   filter transmittance > 1.0 flag 3
!   flow rate < 1.0 lpm flag 1
!   flow rate = 0.0 lpm flag 3
!  Bit values are taken from old DRS version and scaled between .1 and .9 *2**16
!
      IT=IRAW(1,187)
      IF=IRAW(1,188)
      IF (IT .LT. 27546) THEN
        IFLAG = 1
      ELSE IF (IT .GT. 48538) THEN
        IFLAG = 3
      ELSE IF (IF .LT. 17050 .AND. IF .GE. 7194) THEN
        IFLAG = 1
      ELSE IF (IF .LT. 7194 ) THEN
        IFLAG = 3
      ELSE
        IFLAG = 0
      ENDIF 
!
      IF (IFLAG .LT. 3) THEN
!   185/648 1Hz   PSAP LIN ABS COEFF
        RVOLT = RCONST(1) + RCONST(2) * FLOAT(IRAW(1,185))
        RDER(1,648) = RVOLT * 0.5E-5
!      
!   186/649 1Hz   PSAP LOG ABS COEFF
        RVOLT = RCONST(3) + RCONST(4) * FLOAT(IRAW(1,186))
        RDER(1,649) = 10**((RVOLT/2.0) - 7.0)
      ENDIF
      CALL ISETFLG(RDER(1,648),IFLAG)
      CALL ISETFLG(RDER(1,649),IFLAG)
!
      RETURN
      END

c_radal1.for

C
C ROUTINE	C_RADAL1 SUBROUTINE FORTVAX
C
C PURPOSE	To subroutine to calculate the aircraft altitude from the radar
C		altimeter.
C
C DESCRIPTION	The raw radar altimeter data is provided as a 16 bit signed
C               number from the ARINC 429 data bus, with a least bit resolution
C               of 0.25 ft.
C
C		The derived data is quality controlled to ensure that:
C		(a) data outside the range 0 to 8191.75 ft are flagged 3
C		(b) more than two values the same are flagged 3
C		(c) more than 1000' change between values is flagged 3
C
C TO COMPILE	$FORT C_RADAL1
C
C VERSION	1.00  02/10/02  W.D.N.JACKSON
C
C ARGUMENTS	IRAW(X,37)  - where x=1 or 2, on entry this contains the raw 
C			      radar height. 
C		IFRQ(37)    - on entry contains 2, the frequency of the raw 
C			      radar height.
C		RDER(X,575) - where x= 1 or 2, on exit contains the derived 
C			      radar height in meters.
C
C CHANGES	V1.01  WDNJ  05/11/04
C		Flagging criteria improved
C
!*******************************************************************************
      SUBROUTINE C_RADAL1(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.01'
      IMPLICIT  NONE
      INTEGER*4 IRAW(64,512),IFRQ(512),IFLG,IS,IV,ILSTVAL,IMATCH,
     &          ILSTFLG,IMATCHVAL
      REAL*4    RCONST(64),RDER(64,1024)
      DATA      ILSTVAL /-1/, IMATCH /0/, ILSTFLG /0/
!
! Convert raw data
! to metres and store in appropriate element of array RDER.
! Repeat this for all samples passed to the routine. Note that IRAW contains
! the 16 bit number zero extended.
!
      DO IS=1,IFRQ(37)
        RDER(IS,575)=0.0
        IFLG=0
        IV=IRAW(IS,37)
        IF(IV.EQ.'FFFF'X) IFLG=3       !No DLU
        IF(IV.EQ.'FFFE'X) IFLG=3       !No ARINC data
        IF(IV.LT.0.OR.IV.GE.'7FFF'X) IFLG=3 !Glitch or maxed out
        IF(IV.EQ.ILSTVAL) IMATCH=IMATCH+1 !Count data replications
        IF(IV.NE.ILSTVAL) IMATCH=0
        IMATCHVAL=1                    !More than two the same is prob error
        IF(ILSTFLG.NE.0) IMATCHVAL=0          
        IF(IV.EQ.ILSTVAL.AND.IV.NE.0.AND.IMATCH.GT.IMATCHVAL) 
     &    IFLG=-1                      !Keep data value rather than set to 0
        IF(ABS(IV-ILSTVAL).GT.4000) IFLG=3 !More than 1000ft in 0.5s is error
        ILSTVAL=IV
        IF(IFLG.LT.3) RDER(IS,575)=IV*0.25*0.3048
        IF(IFLG.EQ.-1) IFLG=3
        ILSTFLG=IFLG
        CALL ISETFLG(RDER(IS,575),IFLG)
      END DO
      RETURN
      END

c_rflux.for

C------------------------------------------------------------------------------
C ROUTINE  	   C_RFLUX        SUBROUTINE FORTVAX       [C_RFLUX.FOR]
C     
C PURPOSE 	   CORRECT RAW FLUXES FOR PYRANOMETERS AND PYRGEOMETERS
C                  
C DESCRIPTION      Flux corrections are performed for the six instruments
C                  which are normally configured:
C                  Upward-facing :-  Clear dome and Red dome pyranometers.
C                                    Silver dome pyrgeometer.
C                  Downward-facing:- Clear dome and Red dome pyranometers.
C                                    Silver dome pyrgeometer.
C                  
C                  The actual configuration is specified by the preset array
C                  ICONF, which has six elements whose meaning interpreted as:
C                    1,4 : Clear dome pyranometer  (upper/lower)
C                    2,5 : red    "       "           "     "
C                    3,6 : Silver "   pyrgeometer     "     "
C                  (normally: ICONF(1-3) Upper instruments.
C                             ICONF(4-6) Lower instruments.)
C                  
C                 Check that the normal configuration of instruments is to
C                 be used. Any changes are indicated by the presence of a large
C                 offset to the last calibration constant for any instrument
C                 (i.e. the obscurer indicator constant).
C                 If this is present the offset is interpreted as a revised
C                 ICONF indicator for that instrument. See note below.]
C
C                  n.b. Lower instruments were fitted w.e.f. Flight H797
C                       Upper instruments were fitted w.e.f. Flight H842
C
C                  This value solely determines the control path through the
C                  routine for the processing of each instruments inputs.
C                  Should the configuration aboard the aircraft be changed
C                  the array ICONF should be adjusted accordingly.
C                  e.g. If ICONF(1) was modified := 2; it would imply that the
C                  'channel' contained raw flux, zero-offset and thermistor
C                  values for a red dome - rather than clear - pyranometer.
C                  The value of ICONF(1) i.e. 2 would determine the processing
C                  path, the selection of the appropriate set of constants
C                  to apply for correction and the range checking.
C
C NOTE             CHANGES FROM STANDARD CONFIGURATION.                    
C                  Should the configuration of BBR instruments aboard the 
C                  aircraft be changed e.g. swapping a red dome for clear dome,
C                  the array ICONF is  adjusted accordingly. The mechanism used
C                  is to add an offset to the sixth constant in the calibration 
C                  constants file (i.e. the obscurer) for that instrument.
C                  Example: If the second 'channel' (inputs 674,677,680) which
C                  in the standard configuration is a red dome pyranometer,
C                  was replaced with a second clear dome instrument, the sixth
C                  constant for the second line of the constants for C_RFLUX 
C                  would be changed from 1.0000E+0 to 21.0000E+0, the offset 
C                  decodes to "2" when detected by this program. 
C                  This is assigned to ICONF(2) and would imply that the 
C                  'channel' inputs contain raw flux, zero-offset and thermistor 
C                  values for a red dome - rather than clear dome - pyranometer,
C                  and should be range-checked for that type of output only.
C                 
C                  Corrections applied:
C                  --------------------
C                  Pyranometers (Clear and Red dome) are corrected for:
C                  - Subtraction of a zero offset (mean over past 10 seconds)
C                  - Attitude (pitch and roll) -Upper instruments only.
C                    test if flux is above a critical limit indicating a direct
C                    solar beam component.
C                      If not direct, assume diffuse and apply no attitude corr.
C                      If DIRECT, a geometric correction is used to "level"
C                      the instrument to produce the equivalent hemispheric
C                      downward flux through a horizontal surface (without
C                      inclusion of diffuse component).
C                      The ratio of the Direct:Direct+Diffuse components is
C                      assumed to be 0.95 at present. This value could be
C                      optimised for a particular atmosphere depending on the 
C                      turbidity as a function of height.
C                      
C                      Correct for COSINE effect. (MRF Technical note No.7).
C                      [Pitch and roll offsets of the instrument thermopiles
C                      relative to the aircraft INS platform are derived in
C                      flight by flying a box pattern in cloud-free skies -
C                      These offsets are then used in addition to the INS pitch
C                      and roll (meaned over two seconds). (See MRF Technical
C                      note No 4.) and these values are supplied as arguments 
C                      four and five in each set of CONSTANTS below.
C                  - Time constant of thermopile relative to INS. The mean of
C                    last two seconds of INS pitch/roll angles are used in the
C                    attitude correction, giving an effective difference of
C                    0.5 seconds.
C                  - Correct flux output for proportion of hemispheric dome 
C                    obscured by indicated obscurer pillar. (Rawlins 1986).
C
C                  Pyrgeometers (IR) are corrected for:
C                  - Zero offset (mean over past 10 seconds)
C                  - Temperature sensitivity  (Coefficients in CONSTANTS below)
C                  - Linear dependence 0.2% per degree with sensitivity defined 
C                    as unity at zero C. applied to signal. (MRF Int note No 50)
C                  - Calculation of flux (sigma T^4 correction)
C                    Flux = signal +(sigma* Tsink^4) 
C                    where sigma = Stefan-Boltzmann constant.
C                  _ Upper instrument is corrected for dome transmission
C                    effects (MRF Tech note 3)
C
C VERSION	   1.14 17-01-96   D Lauchlan  
C
C METHOD           1. First time routine is called, assign constants to named
C                     program variables/arrays.
C                     Decide on basis of input constants whether upper instr.
C                     data is available to be processed. 
C                  2. Derive/convert any intermediate results used multiply
C                     within several code sections following.
C                  3. Derive running mean zero-offsets over the past 10 seconds
C                     for each instrument 
C                     
C                  4. Calculate mean pitch and roll values for the current 
C                     second and use them to derive running means for the past 
C                     two seconds.
C                  5. Correct thermistor temperatures for non-linearity.
C                  6. Cycle through each of six instrument input channels.
C                     Use the control variable in ICONF() to select execution
C                     of appropriate code sections.
C                     In all cases; derive a signal zero-offset and reduce the
C                     signal flux by this amount.
C                     Apply temperature-dependance corrections to pyranometers.
C                     For upward-facing pyranometers the 'critical' value to
C                     discriminate between diffuse and direct-sun conditions is
C                           FCRIT  = 920.*(COS(ZENRAD))**1.28 
C                     where ZENRAD : solar zenith angle (in radians)
C                     [N.B. This approximates to the 'German' equation but is
C                      simpler, and does not produce negative values at low
C                      Sun elevations]. 
C                     Correct flux output for proportion of hemispheric dome 
C                     obscured by indicated obscurer pillar. (Rawlins 1986).
C                                                          
C                  7. Range check flux output and set a flag accordingly.
C                     Apply flag values to resulting flux output dependent on
C                     relevant flag settings.
C                  
C ARGUMENTS        RCONST(1),( 7)..(31)  - REAL*4 IN Temperature Sens. coeff a
C                  RCONST(2),( 8)..(32)  - REAL*4 IN Temperature Sens. coeff b
C                  RCONST(3),( 9)..(33)  - REAL*4 IN Temperature Sens. coeff c
C                  RCONST(4),(10)..(34)  - REAL*4 IN Pitch offset of Instrument
C                  RCONST(5),(11)..(35)  - REAL*4 IN Roll  offset of Instrument
C                  RCONST(6),(12)..(36)  - REAL*4 IN Obscurer pillar type.
C                  
C                  RDER(1,par)             REAL*4  IN Six raw flux signals W/M-2
C                             (par=673-675,682-684)
C                  RDER(1,par)             REAL*4  IN six zero-offsets   (W/M-2)
C                             (par=676-678,685-687)
C                  RDER(1,par)             REAL*4  IN six instr. temperatures K
C                             (par=679-681,688-690)
C                  RDER(32,560)            REAL*4  IN INS Roll      (degrees)
C                  RDER(32,561)            REAL*4  IN INS Pitch     (degrees)
C                  RDER(32,562)            REAL*4  IN INS heading   (degrees)
C                  RDER(1,642)             REAL*4  IN Solar azimuth (degrees)
C                  RDER(1,643)             REAL*4  IN Solar zenith  (degrees)
C
C                                                              Pos. Dome  Units
C                  RDER(1,1019)            REAL*4 OUT Corrected Upp Clear W/m-2 
C                  RDER(1,1020)            REAL*4 OUT flux.      "  Red dome " 
C                  RDER(1,1021)            REAL*4 OUT            "  I/R      "
C                  RDER(1,1022)            REAL*4 OUT           Low Clear    "
C                  RDER(1,1023)            REAL*4 OUT            "  Red dome " 
C                  RDER(1,1024)            REAL*4 OUT            "  I/R      " 
C
C SUBPROGRAMS  	   ITSTFLG, ISETFLG, S_RUNM, CORR_THM, RMEANOF, CIRC_AVRG
C
C REFERENCES 	   MRF Internal note  4.
C                   "     "      "   12.
C                   "     "      "   31.
C                   "     "      "   50.
C                   "     "      "   56.
C                  MRF Technical note 3. Pyrgeometer Corrections due to Dome
C                                        Transmission.  February 1991 Kilsby
C                  MRF Technical note 7. Report of Broad-band radiative fluxes
C                                        working group. 17/12/91      Saunders
C                  MRF Technical note 8. Pyramometer calibrationsin Ascension
C                                        of Feb.1992.   4/6/92        Seymour
C                  RAWLINS  R        D/Met.O.(MRF)/13/1      1986.
C                  SAUNDERS R         "        "   "         21/3/90
C                  SAUNDERS R        M/MRF/13/5              22/7/92
C                  
C CHANGES          10/01/91 A.D.Hennings.
C                    Ability to change ICONF to when reconfiguring instrument
C                    fit on A/C using the constants file.
C                  10/01/91 Pitch & Roll averaging changed from 3 to 2 seconds.
C                  25/01/91 Flags assessment changed; use of new flag IFLAG_SUN 
C                  29/01/91 Roll limit checking:replace ROLBAR with ABS(ROLBAR).
C                           Flags assessment changed; IFLAG_OUTPUT being max of
C                           (signal,Pitch,Roll,Zenith) flags.               
C                  30/07/91 FCRIT for Red dome now only used if no clear dome 
C                  16/10/91 Corrected pyrgeometer temp sensitivity correction
C                  20/01/92 Use INS heading instead of obsolete Omega heading.
C                  03/02/92 New subroutine CIRC_AVRG to calc INS mean heading
C                  21/07/92 Levelling of upper pyranometers changed to use 
C                           direct beam component, and cosine effect included.
C                           Recommendations of MRF Tech note 7.   (V1.13)
C                           references to Tech note 8. and M/MRF/13/5
C                  24/07/92 Pyrgeometer corrections for Dome transmission. 
C                           (Downwelling) MRF Tech note 3.             
C                  17/01/96 D Lauchlan
C                           Unused variables removed
C                  22/12/97 W D N Jackson, Flags cleared from all data before
C                           use.
C                  11/08/98 W D N Jackson, Upper pyranometer obscurer
C                           corrections changed to correct values.  The
C                           values have been incorrect in all previous versions
C                           of C_RFLUX. The error is only small. (Source 
C                           P Hignett)
C------------------------------------------------------------------------------
      SUBROUTINE C_RFLUX     (IRAW,IFRQ,RCONST,RDER)          
CDEC$ IDENT 'V1.16'
C
      IMPLICIT NONE
      INTEGER*4 IRAW(64,512), IFRQ(512)
      REAL*4    RCONST(64), RDER(64,1024)

      INTEGER   ITSTFLG 
      REAL      CIRC_AVRG              !Function returning average of angles
C
C working input data and processed output arrays
C
      REAL*4 ZIN(6),                   !Zero offset samples
     &       RTHM(6),                  !Uncorrected thermistor samples
     &       RFLX(6),                  !Uncorrected flux samples
     &       THM(6),                   !Corrected thermistor samples
     &       FLX(6),                   !Corrected flux samples
     &       PITINS,ROLINS,            !Input pitch & roll (mean of 32hz) degs
     &       PITCH ,ROLL,              !Corrected pitch and roll (Rads)
     &       HDGINS,                   !Input INS heading (degrees)
     &       SOLAZM,SOLZEN,            !Input Solar Azimuth & zenith angle. Rads
     &       HDGRAD,                   !Convert Omega heading to radians
     &       ZENRAD,                   !Convert Solar Zenith ang to radians
     &       AZMRAD,                   !Convert Solar Zenith ang to radians
     &       SUNHDG                    !Sun Heading (Sol Azm-A/c Omega hdg.)Rads
C
C C0NSTANT information
C
      REAL*8    TSA(6)                       !Temperature senstvty alph,beta gm
     -         ,TSB(6)                       !
     -         ,TSG(6)                       !
     -         ,PITOFF(6)                    !Angular offset   " Pitch.
     -         ,ROLOFF(6)                    !Angular offset   " Roll.
      INTEGER*4 IOBTYP(6)                    !Obscurer type (0: none 1:short
                                             !               2: tall)
C
C flags signifying validity of input arguments and derived values.
C
      INTEGER*4 IFLAG_ANG              !Test of sun angle too low
     -         ,IFLAG_ROLL             !INS Roll
     -         ,IFLAG_PIT              !INS Pitch
     -         ,IFLAG_AZM              !Solar azimuth angle
     -         ,IFLAG_ZEN              ! "    zenith   "
     -         ,IFLAG_INHDG            !INS Heading
     -         ,IFLAG_SHDG             !Sun hdg.  Max(IFLAG_AZM and IFLAG_INHDG)
     -         ,IFLAG_SUN              !Sun attitude Max(Pitch/Roll/Zen/Ang)
     -         ,IFLAG_FLX              !Raw flux input
     -         ,IFLAG_THM              !Corrected thermistor 
     -         ,IFLAG_ZER              !Meaned zero-offset
     -         ,IFLAG_SIGNAL           !Max of (IFLAG_FLX and IFLAG_ZER)
     -         ,IFLAG_CORRN            !Max of (all correction flags relevant)
     -         ,IFLAG_OUTPUT           !Max of (IFLAG_SIGNAL and IFLAG_CORRN)
                                       ! and result of range tests on output.
     -         ,IDUM                   !Argument, return value of no interest.

C  arrays , counters and pointer arguments for Zero-offset mean derivation

      REAL*4    ZBAR(6)                  !Output means over past 10 seconds
      REAL*4    ZBUF(10,6), ZSUM(6)      !Buffer and total holder
      INTEGER*4 IZP(6),     IZCNT(6)     !Buffer pointer and counter of samples.
      DATA      IZP/6*1/,   IZCNT/6*0/   !Initialise ptrs, count of good samples
C
C  arrays , counters and pointer arguments for Pitch and Roll mean derivation
C
      REAL*4    PITBAR,ROLBAR            !Output means over past 2 seconds. degs
      REAL*4    PBUF(3),RBUF(3),PSUM,RSUM!Buffers and total holders
      INTEGER*4 IPPT,IRPT,IPCNT,IRCNT    !Buffer pointer and counter of samples.
      DATA      IPPT,IRPT/1,1/           !Initialise buffer pointers
      DATA      IPCNT,IRCNT/2*0/         !Initialise count of good samples


      LOGICAL   OFIRST/.TRUE./           !Indicator as to first time through rtn

      INTEGER*4 ICONF(6)                !6 input channels (instruments). 
      DATA      ICONF/                  !Control variables- Currently set as:
     -                 1,               !Upper clear dome pyranometer in chan 1
     -                 2,               !      red   dome pyranometer in chan 2
     -                 3,               !      silverdome pyrgeometer in chan 3
     -                 4,               !Lower clear dome pyranometer in chan 4
     -                 5,               !      red   dome pyranometer in chan 5
     -                 6/               !      silverdome pyrgeometer in chan 6

      REAL*4   RMAXFLX(6),RMINFLX(6)    !Range limits on corrected flux.
      DATA     RMAXFLX/                 !Max. admissible corrected flux output
     -             1380.,               !Upward-facing  clear  dome pyranometer
     -              700.,               !               red    dome pyranometer
     -              550.,               !               silver dome pyrgeometer
     -             1380.,               !Downward-facing clear dome pyranometer
     -              700.,               !                red   dome pyranometer
     -              750 /               !                silverdome pyrgeometer
      DATA     RMINFLX/                 !Min. admissible corrected flux output
     -              -20.,               !Upward-facing  clear  dome pyranometer
     -              -20.,               !               red    dome pyranometer
     -              -20.,               !               silver dome pyrgeometer
     -              -20.,               !Downward-facing clear dome pyranometer
     -              -20.,               !                red   dome pyranometer
     -               50./               !                silverdome pyrgeometer

      REAL*4    THETA,RCOSTH              !Angle between Sun and Normal to Instr
      REAL*4    ROLLIM,THTMAX             !Roll max limit: Sun-angle max limit
      PARAMETER (ROLLIM=7.0, THTMAX=80.0) !in degrees.
C
C local variables.
C
      LOGICAL   UPPERS                   !Upper instruments fitted?
      INTEGER*4 IS,IE                    !First and last instrument 'channel'
C      SAVE IS,IE
      INTEGER*4 IN,I                     !Instrument (channel); loop index
      REAL*4    FCRIT,FCRITVAL           !Critical flux value (direct/diffuse)
      REAL*8    SIGMA,                   !Stefan-Boltzmann constant.        
     -          FOBSC,                   !Obscurer value for any instrument
     -          TH,                      !Place holder for corrected thermistor
     -          FL                       !Place holder for corrected flux
      REAL*4    DEG2RD                   !Degrees to radians conversion factor
      REAL*4    RTEMP,                   !Temp vrb: used with ICONF changes.
     -          ROBTYP                   ! "    " : specify Obscurer type used.
      INTEGER*4 ITYPE,ISIG,ICOR          !Indices to data tables
C
C  levelling corrections
C                                       !Select INDX of solar zenith angle
      INTEGER*4 INDX                    !where  INDX = NINT(SOLZEN/10) + 1
                                        !INDX
                                        !1-3: (0 -29.9 deg)
                                        !4-6: (30-59.9 deg)
                                        !7-9: (60-89.9 deg)
                                        !10:  (  >89.9 deg)

      REAL*4    CEFF(10)/1.010, 1.005, 1.005, !Correction to pyranometers for  
     &                   1.005, 1.000, 0.995, !COSINE effect dependant on solar
     &                   0.985, 0.970, 0.930, !zenith angle. Determined by expt
     &                   0.930/               !Ref: Tech note 8. Table 4       
                                               
      REAL*4    FDIR(10)/.95,.95,.95,   !(Proportion of flux from direct source
     &                   .95,.95,.95,   !for varying solar zenith angles.)     
     &                   .95,.95,.95,   !Addressed by INDX as above.            
     &                   .95/           !Ref: M/MRF/13/5                       
                                                                               
                                        
C     table of proportion of hemispheric dome obscured by each pillar-type

      REAL*4    ROBSC(3,6)               !Obscurer corrections (Type,Up|Loc)
      DATA ((ROBSC(ITYPE,IN),IN=1,6),ITYPE=1,3)/    !Ref:RAWLINS 1986       
      !    Upper Instruments  |   Lower instruments      
      !Port    Starbd  Centre  Port    Starbd  Centre
     & 00.000, 00.000, 00.000, 00.000, 00.000, 00.000,  ! No pillar (Ind=1)
     & 00.010, 00.010, 00.000, 00.000, 00.000, 00.000,  ! Short "   ( "  2)
     & 00.040, 00.040, 00.000, 00.000, 00.000, 00.000/  ! Tall  "   ( "  3)
! The following lines contain the incorrect upper pyranometer corrections which
! have been used in all previous versions of C_RFLUX (WDNJ 11/8/98).
!     & 00.016, 00.016, 00.000, 00.000, 00.000, 00.000,  ! Short "   ( "  2)
!     & 00.046, 00.046, 00.000, 00.000, 00.000, 00.000/  ! Tall  "   ( "  3)

C     logic table combining two group input flag conditions resulting in an 
C     output flag.

      INTEGER*4 IFLAG_TABLE(0:3,0:3)
      DATA ((IFLAG_TABLE(ISIG,ICOR),ICOR=0,3),ISIG=0,3)/
      !        CORRECTION
      !     0   1   2   3 
      !   -------------------                 See Saunders LM 1990 for
     -      0,  1,  3,  3,  ! 0               details of this table.
     -      1,  2,  3,  3,  ! 1  SIGNAL
     -      2,  2,  3,  3,  ! 2
     -      3,  3,  3,  3  /! 3
      
      PARAMETER (SIGMA  = 5.669E-08)      
      PARAMETER (DEG2RD = 57.295776)     
      SAVE
!-----------------------------------------------------------------------------
!+
!  1. First time routine is called, assign constants to named
!     program variables/arrays.


      IF (OFIRST) THEN   
        OFIRST= .FALSE.
!
!       Prior to Flight H842 no upper radiometers were recorded in this form;
!       hence no data constants are passed to this routine. Check for condition.
!
        UPPERS = .FALSE.
        DO IN = 1 ,18                             !Any non-zero value indicates
        IF (RCONST(IN) .NE. 0.)  UPPERS = .TRUE.  !constants are being passed 
        END DO                                    !for upper instruments too.
!
!       Set 'channel' limits accordingly.
!
        IF (UPPERS) THEN           
          IS = 1                     !all six instrument present
          IE = 6
        ELSE
          IS = 4                     !only lower instruments fitted
          IE = 6
        ENDIF

!                       Put RCONST values into program variables.)
        DO IN = IS,IE
          TSA(IN)    = RCONST((IN-1)*6 +1) !Temperature sensitivity coefficents
          TSB(IN)    = RCONST((IN-1)*6 +2) ! Alpha, Beta, Gamma                
          TSG(IN)    = RCONST((IN-1)*6 +3) !
          PITOFF(IN) = RCONST((IN-1)*6 +4) !Pitch offset of instrument
          ROLOFF(IN) = RCONST((IN-1)*6 +5) !Pitch offset of instrument

!         Check whether the configuration has been modified by examining the 
!         last constant for each instrument (=IOBTYP). If it is >10 an offset
!         has been added to it; identify this and restore correct constant.
!
          RTEMP = RCONST((IN-1)*6 +6)            !Get obscurer value (+offset?)
          IF (ABS(RTEMP) .GE. 10.0) THEN         !An offset has been added.
              RTEMP      = RTEMP/10.             !Bring the offset into the
              ICONF(IN)  = INT(RTEMP)            !truncate range |1 - 6|>ICONF()
              ROBTYP     = (RTEMP-ICONF(IN))*10. !Restore the Obscurer const.
              ICONF(IN)  = IABS(ICONF(IN))       !Config indicator must be +ve.
              IOBTYP(IN) = NINT(ROBTYP)          !assign Obscurer type in use
                                                 !(1: none, 2: short, 3: tall)

          ELSE                                   !use default ICONF values
              IOBTYP(IN) = NINT(RTEMP)           !Obscurer type in use
          ENDIF

        END DO                           !next instrument.
      ENDIF                              !of First-time-through actions.
!-

!+
!  2. Derive/convert any intermediate results used several times
!     within code sections following.
!
!     Put input data into arrays. 

      IF (UPPERS) THEN
        DO IN = 1,3                              !Upper instruments
          RFLX (IN)  = RDER(1,673+IN -1)         !  Signal       w/m-2
          ZIN  (IN)  = RDER(1,676+IN -1)         !  zero         w/m-2
          RTHM (IN)  = RDER(1,679+IN -1)         !  thermistor   deg K
        END DO
      ENDIF

      DO IN = 1,3                                !Lower instruments
        RFLX (IN+3) = RDER(1,682+IN -1)          !  Signal       w/m-2
        ZIN  (IN+3) = RDER(1,685+IN -1)          !  zero         w/m-2
        RTHM (IN+3) = RDER(1,688+IN -1)          !  thermistor   deg K
      END DO

      HDGINS = CIRC_AVRG( RDER(1,562), 32)       !Mean of INS Heading samples
                                                 !(special for circular values)
      SOLAZM        = RDER(1,642)                !Solar azimuth angle
      SOLZEN        = RDER(1,643)                !Solar zenith   "
!-

!+    set flags for corrections

      IFLAG_INHDG = ITSTFLG (HDGINS)             !Flag of INS   heading
      CALL ISETFLG(HDGINS,0)                     !Strip flag
      IFLAG_ZEN   = ITSTFLG (SOLZEN)             !Flag of solar zenith angle
      CALL ISETFLG(SOLZEN,0)                     !Strip flag
      IFLAG_AZM   = ITSTFLG (SOLAZM)             !Flag of solar azimuth angle
      CALL ISETFLG(SOLAZM,0)                     !Strip flag
      IFLAG_SHDG  = MAX(IFLAG_INHDG,IFLAG_AZM)   !Choose higher heading flag
!-

!+    Convert samples to radians measure.

      HDGRAD = HDGINS /DEG2RD            !Convert INS   heading to radians   
      ZENRAD = SOLZEN/DEG2RD             !Convert Solar Zenith ang to radians
      AZMRAD = SOLAZM/DEG2RD             !Convert Solar Zenith ang to radians
      SUNHDG = AZMRAD - HDGRAD           !Sun Heading (Solar Az-A/C hdg (INS))
!-

      IF (SOLZEN .GT. 0. .AND. SOLZEN .LT.90.)THEN !Prevent exponentiation error
      FCRIT  = 920.*(COS(ZENRAD))**1.28  !Critical flux value (direct/diffuse)
      ENDIF

!+  3. Derive running mean of zero offsets for each instrument over ten seconds
       

      DO I=IS,IE
      CALL S_RUNM(ZBUF(1,I),IZP(I),IZCNT(I),10,ZIN(I),ZSUM(I),ZBAR(I))
      END DO

!-

!+  4. means of 32hz INS PITCH & ROLL arguments for one second.
   
      CALL RMEANOF(32 ,RDER(1,560), ROLINS, IDUM) !Mean of INS Roll samples.
      CALL RMEANOF(32 ,RDER(1,561), PITINS, IDUM) !Mean of  "  Pitch  "    .

!    then derive running mean of pitch and roll values. (meaned over two secs)

      CALL S_RUNM(RBUF,IRPT,IRCNT,2,ROLINS,RSUM,ROLBAR)         !Roll
      CALL S_RUNM(PBUF,IPPT,IPCNT,2,PITINS,PSUM,PITBAR)         !Pitch

!     Set Pitch flag, no acceptability test currently used.

      IFLAG_PIT = ITSTFLG (PITBAR)
      CALL ISETFLG(PITBAR,0)                   !Strip flag

!     Roll limit acceptable?

      IFLAG_ROLL= ITSTFLG (ROLBAR)             !Flag of meaned Roll.
      CALL ISETFLG(ROLBAR,0)                   !Strip flag
      IF ( ABS(ROLBAR) .GT. ROLLIM)            !Comparison in degrees
     -    IFLAG_ROLL= MAX(IFLAG_ROLL,1)        !Flag if Roll too great

!  5.  Correct thermistor values for linearity
      
      CALL CORR_THM (RTHM,THM)                 !Input temps deg K, output deg C

!-----------------------------------------------------------------------------

      DO IN = IS,IE                        !Cycle through available instruments

      FOBSC     = ROBSC(IOBTYP(IN),IN)     !select correction for obscurer
      IFLAG_CORRN  = 0                     !Set corrections flag to valid
      IFLAG_FLX = ITSTFLG (RFLX(IN))       !Flag of raw flux input
      CALL ISETFLG(RFLX(IN),0)             !Strip flag
      IFLAG_ZER = ITSTFLG (ZBAR(IN))       !Flag of meaned zero-offset
      CALL ISETFLG(ZBAR(IN),0)             !Strip flag
      IFLAG_THM = ITSTFLG (THM (IN))       !Flag of corrected thermistor.
      CALL ISETFLG(THM (IN),0)             !Strip flag
                                           
      IFLAG_SIGNAL= MAX(IFLAG_FLX,IFLAG_ZER) !Obtain worst of (flx,zero) flag.

      IF (IFLAG_SIGNAL .EQ. 3) THEN         !**** Check Flux validity
         FLX(IN) =  -99.                    !Set output to 'failed' value.
         IFLAG_OUTPUT=  3                   !'Failed' flag.

      !------------------------------------------------------------------
      ELSE                                  ! OK to begin correcting flux.

        FLX(IN) = RFLX(IN) - ZBAR(IN)       !Subtract meaned zero-offset.

!       Perform temperature sensitivity correction. 

          IF (IFLAG_THM .LT. 2) THEN               !Thermistor temperatures
            FL      = FLX(IN)                      !have been corrected and 
            TH      = THM(IN)                      !converted  to C by CORR_THM.
            FLX(IN) = FL /
     -               (1.+ TH*(TSA(IN)         
     -                  + TH*(TSB(IN) 
     -                  + TH* TSG(IN) )))
          ENDIF

        !----------------------------------------------------------------------
        IF (ICONF(IN) .EQ. 3 .OR. ICONF(IN) .EQ. 6) THEN  !*** Pyrgeometers only
        !----------------------------------------------------------------------

!         Perform 'sigma* Tsink^4' correction

          IF (IFLAG_THM .LT. 2) THEN               
            FL = FLX(IN)                           
            FLX(IN) =FL * (1.0/(1.0-FOBSC))+SIGMA*(TH+273.16)**4
          ENDIF 
                                         !Correction to upper Pyrgeometer for   
                                         !dome transmission of downwelling I/R. 
          IF (ICONF(IN) .EQ. 3 )THEN      
            FLX(IN) = FLX(IN) + (-6.0 + 0.0175* FLX(IN))!see Tech note 3. page 2
          ENDIF                                    

          IFLAG_CORRN = IFLAG_THM                       !Relevant corrections
          IFLAG_OUTPUT = IFLAG_TABLE(IFLAG_SIGNAL,IFLAG_CORRN)

        !----------------------------------------------------------------------
        ELSE                      !Upper and Lower Pyranometer corrections 
        !----------------------------------------------------------------------

          IF (ICONF(IN) .EQ. 4 .OR. ICONF(IN) .EQ. 5) THEN  !Lower pyranometers

             FLX(IN)= FLX(IN)*(1.0/(1.0- FOBSC))            !Obscurer corr'n. 
                                                            !All corr'n complete
             IFLAG_CORRN = 0                                !no relevant corrs
             IFLAG_OUTPUT = IFLAG_TABLE(IFLAG_SIGNAL,IFLAG_CORRN)

          ELSE                                              !Upper Pyranometers

!+          Compare incoming flux with Fcrit (Critical value) of expected flux.
!           IF Flux > Fcrit; treat irradiation as being DIRECT.      
!           ELSE             assume it is DIFFUSE irradiation.        
!             (n.b. for RED dome, Fcrit value used is 1/2 normal Fcrit.) 

            FCRITVAL = FCRIT
            IF( ICONF(1)  .NE.  1) FCRITVAL = FCRIT * .5    !1/2 For RED dome.

            IF (FLX(1)  .GT. FCRITVAL) THEN                 !*Direct or Diffuse?
!-
                                                                     
!+            DIRECT is appropriate; check angle between Sun & normal-to-
!             instrument is not > 80 deg, before correction for platform level.

              PITCH=PITBAR + PITOFF(IN) !Combine  A/C mean and Inst offset Pitch
              PITCH=PITCH/DEG2RD        !.. and convert to radians
              ROLL =ROLBAR + ROLOFF(IN) !Combine A/C  mean and Inst offset Roll 
              ROLL = ROLL/DEG2RD        !.. and convert to radians

!             Find angle between Solar zenith and normal-to-Instrument.
                                                        !Ref:Tech note 7 Page 10
                                                        !Derive cosine of angle.
              RCOSTH = SIN(ROLL)*SIN(ZENRAD)*SIN(SUNHDG)
     &              +  COS(ROLL)*COS(PITCH) *COS(ZENRAD)
     &              -  COS(ROLL)*SIN(PITCH) *SIN(ZENRAD)*COS(SUNHDG)
              THETA = ACOS(RCOSTH)            !Express angle in radians

!             Compare with maximum allowable angle. ( must be < 80 Deg)

              IF (THETA .GT. THTMAX/DEG2RD) THEN 
                IFLAG_ANG =  2                !Failed Low sun test; Flag value  
              ELSE
                IFLAG_ANG =  0                !Angle Sun/Instr acceptable.
              ENDIF                                                         

!             Apply levelling correction using combined pitch and roll, if
!             necessary conditions are met:-

              IFLAG_CORRN = MAX (IFLAG_PIT,  IFLAG_ROLL)  !A/c  Attitude flags.
              IFLAG_CORRN = MAX (IFLAG_CORRN,IFLAG_ANG)                       
              IFLAG_SUN   = MAX (IFLAG_SHDG ,IFLAG_ZEN)                       
              IFLAG_CORRN = MAX (IFLAG_CORRN,IFLAG_SUN)                       

              IFLAG_OUTPUT = IFLAG_TABLE(IFLAG_SIGNAL,IFLAG_CORRN)

              IF ( IFLAG_CORRN .LT. 2 .AND. RCOSTH .NE.0.) THEN 

! *OLD VERSION* FLX(IN) = FLX(IN) * (COS(ZENRAD)/RCOSTH)   !levelling correction

!            Correct the flux for attitude of aircraft for direct component of 
!            beam. Also include COSINE effect correction.    (Ref: M/MRF/13/5)

                INDX = NINT(SOLZEN/10) + 1
                INDX = MIN (INDX,10)
                                                              
                FLX (IN) =              FLX(IN)/      
!                         --------------------------------------------
     &            (1.- FDIR(INDX)*(1.- CEFF(INDX)*(RCOSTH/COS(ZENRAD))))
              ENDIF

            ELSE                            !* Critical value, (flux less than.)
                                            !  Diffuse case;   make Obscurer
                                            !  correction if signal is valid.

              IFLAG_CORRN  = MAX(IFLAG_PIT,  IFLAG_ROLL)  
              IFLAG_CORRN  = MAX(IFLAG_CORRN,IFLAG_ZEN)  
              IFLAG_OUTPUT = IFLAG_TABLE (IFLAG_SIGNAL,IFLAG_CORRN)  
              FLX(IN) = FLX(IN)*(1.0/(1.0- FOBSC))

            ENDIF                           !* Critical value for direct?

            IF ( IFLAG_SIGNAL .EQ. 3) THEN 
              FLX(IN) = -99.                     !set  invalid flux to obvious
            ENDIF                                !known value.

          ENDIF                             !**  Upper or Lower pyranometers?
        ENDIF                               !*** pyranometer or pyrgeometer?

!       Perform range checks on valid output fluxes.

        IF (IFLAG_OUTPUT .LT. 3 ) THEN
            IF (FLX(IN) .GT. RMAXFLX(ICONF(IN)) .OR.
     -          FLX(IN) .LT. RMINFLX(ICONF(IN))     ) THEN
               IFLAG_OUTPUT = 2             !Failed, flag result as 'suspect'
            ENDIF
        ENDIF
      ENDIF                                 !**** Flux signal validity?   

!     Assign processed flux to output parameter

      RDER(1,1018 + IN) = FLX(IN)                      !Fill output argument
      CALL ISETFLG (RDER(1,1018 + IN), IFLAG_OUTPUT)   !Set output flag

      IFLAG_CORRN       = 0
      IFLAG_SIGNAL      = 0
      IFLAG_OUTPUT      = 0
      END DO                                           !(..Control value IN)

      RETURN
      END


C-----------------------------------------------------------------------------
C ROUTINE          CORR_THM     SUBROUTINE     FORTVAX            [C_RFLUX.FOR]
C
C PURPOSE          Correct thermistors for non-linearity using a quintic eqn.
C
C DESCRIPTION      The thermistors used in the pyrgeometer/pyranometers all
C                  have characteristic non-linear temperature dependence
C                  due to the manufacturing process. If not corrected for,
C                  this can lead to errors in temperature of up to 1 deg C.
C                  The thermistor manufacturers provide a curve of the the
C                  correction needed to be applied for a range of
C                  temperatures.  A quintic equation has been fitted to this
C                  curve to give the best fit coefficients used by this routine.
C
C METHOD           The routine takes an array of six thermistor values in deg K.
C                  In turn; notes each ones flag then clears the flag.      
C                  Fits -50 deg C to +40 deg C to within +/- .07 deg C.
C                  Eqn: RT + (RCON +V.RT +W.RT^2 +X.RT^3 +Y.RT^4 +Z.RT^5)
C                  where RT  : Raw thermistor value  (converted to Celsius)
C                        RCON: A constant
C                   V,W,X,Y,Z: Coefficients of quintic equation correcting temp.
C
C                  Loop through six thermistor values:
C                  a)   note each one's flag
C                  b)   if flag indicates input is valid (flag <3)
C                       - clear the flag bits from the raw thermistor value
C                       - assign the value (converted to deg C.) to a working
C                         variable,  which becomes the input variable to a the
C                         quintic equation above.
C                       - derive the corrected output using that equation.
C                       - set input flag value in output thermistor temperature.
C                       else; for an 'invalid' flag
C                       - set the output thermistor value to zero C
C                       - set its output's flag to 3 (= invalid)
C                  next loop.
C
C                  n.b. The corrected thermistor values are not saved at the
C                       end of calibration and are only calculated for local
C                       use in deriving corrected solar fluxes.
C
C VERSION          1.02  30-07-91  A.D HENNINGS
C
C REFERENCES       Best-fit coefficients and constants taken from fitting to
C                  manufacturers calibration data sheet.
C
C ARGUMENTS        REAL*4 RTHM(6)  IN   Six uncorrected thermistor values. deg K
C                  REAL*4 THM (6) OUT   Six  corrected thermistor values.  deg C
C
C SUBPROGRAM       ITSTFLG ISETFLG
C
C CHANGES          1.01 201190 Documentation.
C                  1.02 300791 Documentation.
C                  1.03 17-01-96 D Lauchlan
C                  Unused variables removed
C                  1.04 22-03-04 D Tiddeman flag stripping before calculation 
C                  changed to prevent crashes.
C------------------------------------------------------------------------------
      SUBROUTINE CORR_THM (RTHM,THM)
CDEC$ IDENT 'V1.04'
C
      IMPLICIT NONE
      REAL*8 V,W,X,Y,Z,            !Coefficients of powers 1, 2, 3, 4 & 5
     -       RT,RCON               !placeholder  for thermistor for calc.       
      REAL*4 RTHM(6),THM(6)        !Raw Thermistor, corrected thermistor.       
      INTEGER*4 I,IFLAG ,ITSTFLG
c      LOGICAL OFIRST_TIME/.TRUE./  !   "      "
      PARAMETER (RCON = -0.774,
     -              V =  6.08E-02,
     -              W =  2.47E-03,
     -              X = -6.29E-05,
     -              Y = -8.78E-07,
     -              Z =  1.37E-08)
!

      DO  I=1,6 
      IFLAG = ITSTFLG(RTHM(I))
      CALL ISETFLG(RTHM(I),0)                      !Clear flag before calc.
      IF (IFLAG .LT. 3) THEN
        RT     = RTHM(I) - 273.16                  !convert to Celsius
        THM(I) = RT + (RCON + RT*(V+ RT*(W+RT*(X+RT*(Y+RT*Z)))))                
        CALL ISETFLG(THM(I),IFLAG)                 !Replace original flag.
      ELSE
        THM(I) = 0.0                               !Set thermistors to failed.
        CALL ISETFLG(THM(I),3)                     !and flag as such
      ENDIF                                                                     
      END DO

      RETURN
      END                                                                       

        
C-------------------------------------------------------------------------------
C ROUTINE          RMEANOF        SUBROUTINE     FORTVAX         [C_RFLUX.FOR] 
C
C PURPOSE          Calculate the mean of an array of real values.
C
C DESCRIPTION      An array containing NOELS  real elements is received.
C                  Each element is checked and, if it has a Flag value
C                  (bits 16+17) of zero, is accumulated to a total, and
C                  the  count of good elements incremented.
C                  When all elements have been checked, the mean is derived
C                  such that:
C                  If no good elements were found, the mean is zero, flagged 3.
C                  Otherwise, the mean is the total/count, flagged 0.
C
C ARGUMENTS        INTEGER*4  NOELS IN   Number of elements in array passed
C                  REAL*4     RARR  IN   Array of reals - dimensioned to NOELS
C                  REAL*4     RMEAN OUT  Arithmetic mean of good samples, or 0.
C                  INTEGER*4  IFLAG OUT  Flag value of mean, 0:good 3:invalid.
C                    
C VERSION          1.00   19-03-90  A.D.HENNINGS
C
C SUBPROGRAMS      ITSTFLG  ISETFLG
C
C REFERENCES       None
C
C-----------------------------------------------------------------------------

      SUBROUTINE RMEANOF(NOELS,RARR,RMEAN,IFLAG)
CDEC$ IDENT 'V1.00'
C
      IMPLICIT NONE
      INTEGER*4 NOELS,IX,ITSTFLG,ICOUNT,IFLAG
      REAL*4    RARR(NOELS),RMEAN,SUMM

      SUMM = 0.
      ICOUNT   = 0
      DO IX= 1,NOELS
      IF (ITSTFLG(RARR(IX)) .EQ. 0) THEN
        SUMM = SUMM + RARR(IX)
        ICOUNT = ICOUNT+1
      ENDIF 
      END DO

      IF (ICOUNT .GT. 0 )THEN
        RMEAN = SUMM/FLOAT(ICOUNT)
        IFLAG = 0
      ELSE
        RMEAN  = 0.
        IFLAG  = 3
      ENDIF
      CALL ISETFLG(RMEAN,IFLAG)

      RETURN
      END
*--------------------------------------------------------------
C ROUTINE          CIRC_AVRG  FUNCTION   FORTVAX  
C
C PURPOSE          CALCULATE MEAN OF A SET (>2 <1000)  OF ANGLES, IN DEG.
C
C ARGUMENTS        REAL*4    ARR  IN         Array of Angles (in  Degrees)
C                  INTEGER*4 NUM  IN         Number of angle in array ARR.
C                  REAL*4    CIRC_AVANG OUT  Average angle of set (0-360 deg)
C
C DESCRIPTION      Given a set of angles (0-360 Deg) calculates their mean. 
C                  Handles values spanning 0 or 180.
C                  Returns mean    Flagged 0: If >2 and <= 1/2 of inputs valid
C                                          1: If < 1/2 of inputs valid.
C                                          3: If no valid inputs.
C                  N.B  ASSUMES ALL INPUT ANGLES ARE BETWEEN 0 & 360 DEG.
C
C VERSION          1.0   JAN 1992  A D HENNINGS
C                        MODIFIED FROM  "AVANG" V3.0 SEP 1984  D OFFILER
C                  1.01  DEC 1997  W D N JACKSON
C                        Stips flags before using data
C-------------------------------------------------------------------------------
      REAL  FUNCTION CIRC_AVRG( ARR , NUM)
CDEC$ IDENT 'V1.00'

      IMPLICIT NONE
      INTEGER NUM,NM1,I,ITSTFLG,ICOUNT,IFLAG
      REAL ARR(NUM)
      REAL TARR(1000),DIF
 

      DO I=1,NUM
      TARR (I) = ARR(I)                         !Move values to temporary array
      CALL ISETFLG(TARR(I),0)                   !Strip flag
      END DO                                    !as they may be altered later.

C Alter angles to same sign .

      IF ( NUM .GT. 2 ) THEN
         NM1 = NUM - 1
         DO I = 1 , NM1
            DIF = TARR(I) - TARR(I+1)
            IF ( ABS ( DIF ) .GT. 180.0 ) THEN
                     TARR(I+1) = TARR(I+1) + SIGN (360.0 , DIF )
            ENDIF
         ENDDO
      ENDIF

C  Sum the good points.

      CIRC_AVRG= 0.0
      ICOUNT= 0

      DO I = 1 , NUM
         IF (ITSTFLG (ARR(I)) .LE. 1) THEN         !Do check on original array
            CIRC_AVRG = CIRC_AVRG + TARR(I)        !..but use changed data
            ICOUNT =ICOUNT+1
         ENDIF
      ENDDO

C Calculate average.

      IF (ICOUNT .GT. 0 )THEN
          CIRC_AVRG = CIRC_AVRG / FLOAT (ICOUNT )
          IF (ICOUNT .GT. NUM/2 ) THEN         !More than half rejected, then
              IFLAG = 0                        !flag as reduced quality data.
          ELSE
              IFLAG = 1
          ENDIF
      ELSE
          CIRC_AVRG  = 0.
          IFLAG  = 3
      ENDIF

      IF ( CIRC_AVRG .LT.   0.0 ) CIRC_AVRG = CIRC_AVRG + 360.0
      IF ( CIRC_AVRG .GE. 360.0 ) CIRC_AVRG = CIRC_AVRG - 360.0

C Set the flag in the returned value

      CALL ISETFLG(CIRC_AVRG,IFLAG)

      END

c_rvsm.for

!
! ROUTINE          C_RVSM SUBROUTINE FORTVAX
!     
! PURPOSE          Computes static pressure, pitot-static pressure, and pressure
!                  height from the 146 RVSM altitude and airspeed data.
!
! DESCRIPTION      RVSM altitude is available in ARINC-429 message 203 and is
!                  recorded as by the DRS as a 16 bit signed word, with the 
!                  LSB representing 4 feet.
!
!                  RVSM computed airspeed is available in ARINC-429 message
!                  206 and is recorded by the DRS as a 16 bit signed word, with
!                  the LSB representing 1/32 kt, but always zero.
!
!                  These values should be within the system accuracy
!                  specification and do not require calibration.
!
!                  Note that altitude is updated by the RVSM at about 20 Hz
!                  and airspeed is updated at about 10 Hz.  Both signals are
!                  sampled by the DRS at 32 Hz so there will be multiple
!                  values and aliasing effects.
!
! METHOD           For each DRS parameter to be calibrated:
!                  1. If data is FFFF or FFFE or out of range then flag 3
!                  2. Decode the altitude and use the tables in NASA TN D-822
!                     to back compute the static pressure.
!                  3. Decode the airspeed and use fundamental equations to 
!                     compute pitot-static pressure.
!                  4. Check the results for being within acceptable values.
!                  5. Set data flag bits (16+17) 0: Good data
!                                                1: Data of lower quality
!                                                2: Probably faulty, exceed lims
!                                                3: Data absent or invalid.
!
!                  Flagging - If a value can't be computed, due to missing data
!                  missing constants, divide be zeroes, etc, a value of 0 is
!                  used, flagged with a three.  If a value is outside its 
!                  limits for range, it is flagged with a two.
!                  If there are no problems with the data it is flagged with 0.
!                  Any flags on input data are propagated through subsequent 
!                  calculations.
!
!                  Note that routine does not currently apply position error
!                  corrections, nor interpolate missing data.
!
! VERSION          1.00  23/07/03  W.D.N.JACKSON
!
! ARGUMENTS        Inputs:
!                    DRS para 222 RVAL 32 Hz RVSM altitude
!                        para 223 RVAS 32 Hz RVSM computed airspeed
!
!                  Outputs:
!                    Derived para 576 SPR  mb 32 Hz Static pressure
!                            para 577 PSP  mb 32 Hz Pitot-static pressure
!                            para 578 PHGT m  32 Hz Pressure height
!
!                  Flags:
!                    Missing/corrupt data output as 0 flagged 3.
!                    Out of range derived data flagged 2.
!
! SUBPROGRAMS      S_PSP, ALT2PRESS, ISETFLG 
!
! REFERENCES       NASA Technical Note D-822, Aug 1961, Tables of airspeed,
!                  altitude, and mach number.
!
!                  Interface Control Document, Air Data Display Unit, ISS
!                  1G-80130-22.
!
! CHANGES          V1.00 23/07/03  WDNJ Original version
!                  V1.01 23/10/03  WDNJ Now replicates data when missing
!                  V1.02 11/12/03  WDNJ Fixes bug if initial data missing
!                  V1.03 11/03/04  DAT Flags data outside altitude range 3
!                  V1.04 17/03/04  WDNJ Now handles negative heights correctly
!                                       and uses more accurate flagging criteria
!
!*******************************************************************************
      SUBROUTINE C_RVSM(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.04'
!
      INTEGER*4 IRAW(64,512),IFRQ(512),IS,IVAL,IFLG1,IFLG2,ILSTVAL1,
     &    ILSTVAL2
      REAL*4    RCONST(64),RDER(64,1024),RVAL,RALT,RCAS,RPSP,RSTP
      DATA      ILSTVAL1 /'FFFE'X/, ILSTVAL2 /'FFFE'X/
!
      PARAMETER RSTPMX=1050.           !Max static pressure (mb)
      PARAMETER RSTPMN=116.            !Min static pressure (mb)
      PARAMETER RPSPMX=159.            !Max Pitot-static press (mb) 305 kts at SL!
      PARAMETER RPSPMN=0.              !Min Pitot-static pressure (mb)
      SAVE ILSTVAL1,ILSTVAL2
!
! Derive static pressure, pressure height, and pitot-static.
!
      DO IS=1,32
        IFLG1=0
        RDER(IS,576)=0.
        RDER(IS,578)=0.
! Process height and pressure
        IVAL=IRAW(IS,222)
        IF((IVAL.AND.'FFFF'X).EQ.'FFFE'X) IVAL=ILSTVAL1
        ILSTVAL1=IVAL
        IF(((IVAL.AND.'FFFF'X).EQ.'FFFF'X.AND.IRAW(IS,223).EQ.'FFFF'X)
     &      .OR.(IVAL.AND.'FFFF'X).EQ.'FFFE'X) IFLG1=3
        IF(BTEST(IVAL,15)) IVAL=IVAL.OR.'FFFF0000'X !Extend sign
        IF(IVAL.LT.-250.OR.IVAL.GT.12500) IFLG1=3 !Outside table range        
        IF(IFLG1.NE.3) THEN
          RVAL=FLOAT(IVAL)*4.          !Altitude in feet
          RALT=RVAL*0.3048             !Altitude in m
          CALL ALT2PRESS(RVAL,RSTP)    !Compute static pressure in mb
          IF(RSTP.LT.RSTPMN.OR.RSTP.GT.RSTPMX) IFLG1=2        
          RDER(IS,576)=RSTP
          RDER(IS,578)=RALT
        END IF
        CALL ISETFLG(RDER(IS,576),IFLG1)
        CALL ISETFLG(RDER(IS,578),IFLG1)
! Process airspeed
        IFLG2=0
        RDER(IS,577)=0.
        IVAL=IRAW(IS,223)
        IF((IVAL.AND.'FFFF'X).EQ.'FFFE'X) IVAL=ILSTVAL2 !No Arinc 429 signal
        ILSTVAL2=IVAL
        IF((IVAL.AND.'FFFF'X).EQ.'FFFF'X.OR.
     &  (IVAL.AND.'FFFF'X).EQ.'FFFE'X) IFLG2=3
        IF(BTEST(IVAL,15)) IVAL=IVAL.OR.'FFFF0000'X !Extend sign
        IF(IVAL.LT.0) IFLG2=3          !Should always be +ve
        IF(IVAL/32.GT.350) IFLG2=3     !Gross error (max 146 IAS is 305 kts)
        IF(IFLG1.NE.3.AND.IFLG2.NE.3) THEN
          IVAL=IVAL.AND.'FFFFFFF7'X    !Clear padding in LSB
          RCAS=FLOAT(IVAL)/32.         !computed airspeed in kt
          RCAS=RCAS*0.514444           !computed airspeed in m/s
          CALL S_PSP(RCAS,RSTP,RPSP)   !Compute pitot-static pressure in mb
          IF(RPSP.LT.RPSPMN.OR.RPSP.GT.RPSPMX) IFLG2=2        
          RDER(IS,577)=RPSP
        END IF
        CALL ISETFLG(RDER(IS,577),MAX(IFLG1,IFLG2))
      END DO
! 
      RETURN
      END
!*******************************************************************************
      SUBROUTINE S_PSP(RCAS,RSTP,RPSP)
CDEC$ IDENT 'V1.00'
!
! Computes pitot-static pressure from indicated (computed) airspeed and static 
! pressure from the following equations (see S_MACH and C_AIRSPD modules):
!
! IAS = 340.294 * Mach * SQRT(Static/1013.25)
! Mach= SQRT(5*((1+Pitot/Static)**(2/7)-1))
!
! where 340.294 is the speed of sound in m/s.
!
! RCAS - Computed airspeed (m/s)
! RSTP - Static pressure (mb)
! RPSP - Pitot-static pressure (mb)
!
      REAL*4 RCAS,RSTP,RPSP,RMACH

      RMACH=RCAS/340.294/SQRT(RSTP/1013.25)
      RPSP=RSTP*((((RMACH**2.)/5.+1.)**3.5)-1.)
      RETURN
      END
!*******************************************************************************
      SUBROUTINE ALT2PRESS(RALT,RPRESS)
CDEC$ IDENT 'V1.00'
!
! Converts altitudes in feet to pressures in mb using the tables provided in
! NASA Technical Note D-822 (Tables of airspeed, altitude and mach number based 
! on latest international values for atmospheric properties and physical
! constants. Sadie P Livingston and William Gracey. August 1961).  If altitude
! is outside the range -1000 to 50000 ft then returns a pressure of 0 mb.
!
! This routine is provided to convert the altitudes provided by the 146 RVSM
! system (Innovative Solutions & Support Inc Air Data Display Unit) into 
! static pressures, using the same standard tables as are used by the RVSM 
! system to convert pressure into altitude.
!
! Pressure values in the NASA tables are given in lb/sq ft.  These have been
! converted to mb using 1 lb/sq in = 68.9476258 mb and 144 sq in = 1 sq ft.
!
! Only simple linear interpolation is used between the tabulated values. This
! will give maximum error of 0.005 mb which is well below the recorded
! resolution, let alone the system accuracy.
!
! V1.00  14/05/03  W.D.N.Jackson
!
      REAL*4 RALT,RPRESS,RTABLE(2,442)
      INTEGER*4 IL,IP,IH

      DATA RTABLE(1:2,1:88) / !Heights (ft) and pressures (mb)
     & -1000.0,1050.408,
     &  -900.0,1046.644,
     &  -800.0,1042.890,
     &  -700.0,1039.146,
     &  -600.0,1035.416,
     &  -500.0,1031.691,
     &  -400.0,1027.985,
     &  -300.0,1024.284,
     &  -200.0,1020.597,
     &  -100.0,1016.915,
     &     0.0,1013.252,
     &   100.0,1009.594,
     &   200.0,1005.951,
     &   300.0,1002.312,
     &   400.0,998.6872,
     &   500.0,995.0770,
     &   600.0,991.4716,
     &   700.0,987.8806,
     &   800.0,984.2991,
     &   900.0,980.7273,
     &  1000.0,977.1649,
     &  1100.0,973.6171,
     &  1200.0,970.0739,
     &  1300.0,966.5452,
     &  1400.0,963.0259,
     &  1500.0,959.5163,
     &  1600.0,956.0211,
     &  1700.0,952.5306,
     &  1800.0,949.0544,
     &  1900.0,945.5880,
     &  2000.0,942.1310,
     &  2100.0,938.6836,
     &  2200.0,935.2458,
     &  2300.0,931.8176,
     &  2400.0,928.4037,
     &  2500.0,924.9947,
     &  2600.0,921.5999,
     &  2700.0,918.2147,
     &  2800.0,914.8392,
     &  2900.0,911.4732,
     &  3000.0,908.1168,
     &  3100.0,904.7700,
     &  3200.0,901.4328,
     &  3300.0,898.1098,
     &  3400.0,894.7917,
     &  3500.0,891.4880,
     &  3600.0,888.1891,
     &  3700.0,884.9045,
     &  3800.0,881.6294,
     &  3900.0,878.3640,
     &  4000.0,875.1033,
     &  4100.0,871.8571,
     &  4200.0,868.6204,
     &  4300.0,865.3932,
     &  4400.0,862.1757,
     &  4500.0,858.9677,
     &  4600.0,855.7693,
     &  4700.0,852.5804,
     &  4800.0,849.4012,
     &  4900.0,846.2316,
     &  5000.0,843.0715,
     &  5100.0,839.9209,
     &  5200.0,836.7800,
     &  5300.0,833.6486,
     &  5400.0,830.5268,
     &  5500.0,827.4146,
     &  5600.0,824.3120,
     &  5700.0,821.2189,
     &  5800.0,818.1354,
     &  5900.0,815.0615,
     &  6000.0,811.9971,
     &  6100.0,808.9376,
     &  6200.0,805.8924,
     &  6300.0,802.8568,
     &  6400.0,799.8259,
     &  6500.0,796.8095,
     &  6600.0,793.7979,
     &  6700.0,790.8005,
     &  6800.0,787.8080,
     &  6900.0,784.8251,
     &  7000.0,781.8517,
     &  7100.0,778.8879,
     &  7200.0,775.9337,
     &  7300.0,772.9891,
     &  7400.0,770.0540,
     &  7500.0,767.1238,
     &  7600.0,764.2078,
     &  7700.0,761.2966/
      DATA RTABLE(1:2,89:176) / !Heights (ft) and pressures (mb)
     &  7800.0,758.3951,
     &  7900.0,755.5032,
     &  8000.0,752.6208,
     &  8100.0,749.7479,
     &  8200.0,746.8847,
     &  8300.0,744.0263,
     &  8400.0,741.1822,
     &  8500.0,738.3429,
     &  8600.0,735.5132,
     &  8700.0,732.6930,
     &  8800.0,729.8824,
     &  8900.0,727.0767,
     &  9000.0,724.2852,
     &  9100.0,721.4986,
     &  9200.0,718.7215,
     &  9300.0,715.9540,
     &  9400.0,713.1913,
     &  9500.0,710.4431,
     &  9600.0,707.6995,
     &  9700.0,704.9655,
     &  9800.0,702.2411,
     &  9900.0,699.5215,
     & 10000.0,696.8162,
     & 10100.0,694.1158,
     & 10200.0,691.4250,
     & 10300.0,688.7437,
     & 10400.0,686.0671,
     & 10500.0,683.4003,
     & 10600.0,680.7429,
     & 10700.0,678.0951,
     & 10800.0,675.4521,
     & 10900.0,672.8187,
     & 11000.0,670.1948,
     & 11100.0,667.5806,
     & 11200.0,664.9711,
     & 11300.0,662.3712,
     & 11400.0,659.7809,
     & 11500.0,657.2001,
     & 11600.0,654.6241,
     & 11700.0,652.0578,
     & 11800.0,649.5010,
     & 11900.0,646.9490,
     & 12000.0,644.4065,
     & 12100.0,641.8737,
     & 12200.0,639.3456,
     & 12300.0,636.8271,
     & 12400.0,634.3181,
     & 12500.0,631.8188,
     & 12600.0,629.3242,
     & 12700.0,626.8392,
     & 12800.0,624.3591,
     & 12900.0,621.8884,
     & 13000.0,619.4274,
     & 13100.0,616.9711,
     & 13200.0,614.5244,
     & 13300.0,612.0873,
     & 13400.0,609.6599,
     & 13500.0,607.2322,
     & 13600.0,604.8191,
     & 13700.0,602.4108,
     & 13800.0,600.0120,
     & 13900.0,597.6227,
     & 14000.0,595.2383,
     & 14100.0,592.8586,
     & 14200.0,590.4933,
     & 14300.0,588.1328,
     & 14400.0,585.7771,
     & 14500.0,583.4310,
     & 14600.0,581.0944,
     & 14700.0,578.7626,
     & 14800.0,576.4405,
     & 14900.0,574.1278,
     & 15000.0,571.8200,
     & 15100.0,569.5169,
     & 15200.0,567.2235,
     & 15300.0,564.9396,
     & 15400.0,562.6605,
     & 15500.0,560.3910,
     & 15600.0,558.1262,
     & 15700.0,555.8710,
     & 15800.0,553.6255,
     & 15900.0,551.3846,
     & 16000.0,549.1487,
     & 16100.0,546.9222,
     & 16200.0,544.7054,
     & 16300.0,542.4933,
     & 16400.0,540.2908,
     & 16500.0,538.0931/
      DATA RTABLE(1:2,177:275) / !Heights (ft) and pressures (mb)
     & 16600.0,535.9050,
     & 16700.0,533.7216,
     & 16800.0,531.5431,
     & 16900.0,529.3789,
     & 17000.0,527.2147,
     & 17100.0,525.0601,
     & 17200.0,522.9150,
     & 17300.0,520.7748,
     & 17400.0,518.6441,
     & 17500.0,516.5183,
     & 17600.0,514.4019,
     & 17700.0,512.2904,
     & 17800.0,510.1837,
     & 17900.0,508.0865,
     & 18000.0,505.9990,
     & 18100.0,503.9113,
     & 18200.0,501.8382,
     & 18300.0,499.7697,
     & 18400.0,497.7061,
     & 18500.0,495.6472,
     & 18600.0,493.6028,
     & 18700.0,491.5583,
     & 18800.0,489.5233,
     & 18900.0,487.4980,
     & 19000.0,485.4727,
     & 19100.0,483.4617,
     & 19200.0,481.4507,
     & 19300.0,479.4493,
     & 19400.0,477.4565,
     & 19500.0,475.4686,
     & 19600.0,473.4877,
     & 19700.0,471.5137,
     & 19800.0,469.5462,
     & 19900.0,467.5851,
     & 20000.0,465.6311,
     & 20100.0,463.6833,
     & 20200.0,461.7422,
     & 20300.0,459.8079,
     & 20400.0,457.8802,
     & 20500.0,455.9588,
     & 20600.0,454.0440,
     & 20700.0,452.1356,
     & 20800.0,450.2337,
     & 20900.0,448.3387,
     & 21000.0,446.4498,
     & 21100.0,444.5671,
     & 21200.0,442.6911,
     & 21300.0,440.8219,
     & 21400.0,438.9584,
     & 21500.0,437.1021,
     & 21600.0,435.2515,
     & 21700.0,433.4076,
     & 21800.0,431.5695,
     & 21900.0,429.7386,
     & 22000.0,427.9134,
     & 22100.0,426.0944,
     & 22200.0,424.2816,
     & 22300.0,422.4756,
     & 22400.0,420.6753,
     & 22500.0,418.8817,
     & 22600.0,417.0939,
     & 22700.0,415.3127,
     & 22800.0,413.5373,
     & 22900.0,411.7682,
     & 23000.0,410.0052,
     & 23100.0,408.2480,
     & 23200.0,406.4970,
     & 23300.0,404.7527,
     & 23400.0,403.0137,
     & 23500.0,401.2814,
     & 23600.0,399.5548,
     & 23700.0,397.8340,
     & 23800.0,396.1194,
     & 23900.0,394.4110,
     & 24000.0,392.7084,
     & 24100.0,391.0121,
     & 24200.0,389.3214,
     & 24300.0,387.6364,
     & 24400.0,385.9578,
     & 24500.0,384.2848,
     & 24600.0,382.6176,
     & 24700.0,380.9562,
     & 24800.0,379.3010,
     & 24900.0,377.6515,
     & 25000.0,376.0078,
     & 25100.0,374.3698,
     & 25200.0,372.7376,
     & 25300.0,371.1111,
     & 25400.0,369.4908,
     & 25500.0,367.8758,
     & 25600.0,366.2665,
     & 25700.0,364.6630,
     & 25800.0,363.0652,
     & 25900.0,361.4733,
     & 26000.0,359.8865,
     & 26100.0,358.3059,
     & 26200.0,356.7307,
     & 26300.0,355.1612,
     & 26400.0,353.5970/
      DATA RTABLE(1:2,276:363) / !Heights (ft) and pressures (mb)
     & 26500.0,352.0389,
     & 26600.0,350.4862,
     & 26700.0,348.9387,
     & 26800.0,347.3969,
     & 26900.0,345.8609,
     & 27000.0,344.3302,
     & 27100.0,342.8047,
     & 27200.0,341.2850,
     & 27300.0,339.7705,
     & 27400.0,338.2618,
     & 27500.0,336.7584,
     & 27600.0,335.2607,
     & 27700.0,333.7678,
     & 27800.0,332.2806,
     & 27900.0,330.7987,
     & 28000.0,329.3221,
     & 28100.0,327.8512,
     & 28200.0,326.3856,
     & 28300.0,324.9248,
     & 28400.0,323.4697,
     & 28500.0,322.0199,
     & 28600.0,320.5753,
     & 28700.0,319.1356,
     & 28800.0,317.7015,
     & 28900.0,316.2723,
     & 29000.0,314.8488,
     & 29100.0,313.4301,
     & 29200.0,312.0167,
     & 29300.0,310.6086,
     & 29400.0,309.2057,
     & 29500.0,307.8076,
     & 29600.0,306.4147,
     & 29700.0,305.0272,
     & 29800.0,303.6449,
     & 29900.0,302.2673,
     & 30000.0,300.8947,
     & 30100.0,299.5272,
     & 30200.0,298.1649,
     & 30300.0,296.8076,
     & 30400.0,295.4554,
     & 30500.0,294.1081,
     & 30600.0,292.7655,
     & 30700.0,291.4282,
     & 30800.0,290.0957,
     & 30900.0,288.7684,
     & 31000.0,287.4455,
     & 31100.0,286.1279,
     & 31200.0,284.8155,
     & 31300.0,283.5074,
     & 31400.0,282.2045,
     & 31500.0,280.9060,
     & 31600.0,279.6128,
     & 31700.0,278.3243,
     & 31800.0,277.0406,
     & 31900.0,275.7618,
     & 32000.0,274.4877,
     & 32100.0,273.2184,
     & 32200.0,271.9539,
     & 32300.0,270.6936,
     & 32400.0,269.4387,
     & 32500.0,268.1885,
     & 32600.0,266.9427,
     & 32700.0,265.7017,
     & 32800.0,264.4654,
     & 32900.0,263.2339,
     & 33000.0,262.0067,
     & 33100.0,260.7843,
     & 33200.0,259.5663,
     & 33300.0,258.3534,
     & 33400.0,257.1449,
     & 33500.0,255.9408,
     & 33600.0,254.7414,
     & 33700.0,253.5468,
     & 33800.0,252.3564,
     & 33900.0,251.1705,
     & 34000.0,249.9892,
     & 34100.0,248.8124,
     & 34200.0,247.6402,
     & 34300.0,246.4724,
     & 34400.0,245.3089,
     & 34500.0,244.1502,
     & 34600.0,242.9958,
     & 34700.0,241.8458,
     & 34800.0,240.7000,
     & 34900.0,239.5590,
     & 35000.0,238.4223,
     & 35100.0,237.2895,
     & 35200.0,236.1614/
      DATA RTABLE(1:2,364:442) / !Heights (ft) and pressures (mb)
     & 35300.0,235.0381,
     & 35400.0,233.9187,
     & 35500.0,232.8036,
     & 35600.0,231.6927,
     & 35700.0,230.5862,
     & 35800.0,229.4840,
     & 35900.0,228.3861,
     & 36000.0,227.2925,
     & 36100.0,226.2028,
     & 36200.0,225.1183,
     & 36400.0,222.9646,
     & 36600.0,220.8316,
     & 36800.0,218.7191,
     & 37000.0,216.6267,
     & 37200.0,214.5545,
     & 37400.0,212.5018,
     & 37600.0,210.4688,
     & 37800.0,208.4555,
     & 38000.0,206.4613,
     & 38200.0,204.4857,
     & 38400.0,202.5298,
     & 38600.0,200.5921,
     & 38800.0,198.6731,
     & 39000.0,196.7727,
     & 39200.0,194.8900,
     & 39400.0,193.0256,
     & 39600.0,191.1793,
     & 39800.0,189.3503,
     & 40000.0,187.5385,
     & 40200.0,185.7444,
     & 40400.0,183.9676,
     & 40600.0,182.2075,
     & 40800.0,180.4647,
     & 41000.0,178.7381,
     & 41200.0,177.0283,
     & 41400.0,175.3348,
     & 41600.0,173.6570,
     & 41800.0,171.9961,
     & 42000.0,170.3504,
     & 42200.0,168.7211,
     & 42400.0,167.1070,
     & 42600.0,165.5083,
     & 42800.0,163.9249,
     & 43000.0,162.3563,
     & 43200.0,160.8036,
     & 43400.0,159.2652,
     & 43600.0,157.7416,
     & 43800.0,156.2325,
     & 44000.0,154.7376,
     & 44200.0,153.2572,
     & 44400.0,151.7911,
     & 44600.0,150.3393,
     & 44800.0,148.9010,
     & 45000.0,147.4766,
     & 45200.0,146.0655,
     & 45400.0,144.6679,
     & 45600.0,143.2842,
     & 45800.0,141.9134,
     & 46000.0,140.5560,
     & 46200.0,139.2110,
     & 46400.0,137.8795,
     & 46600.0,136.5603,
     & 46800.0,135.2542,
     & 47000.0,133.9600,
     & 47200.0,132.6787,
     & 47400.0,131.4094,
     & 47600.0,130.1520,
     & 47800.0,128.9072,
     & 48000.0,127.6738,
     & 48200.0,126.4523,
     & 48400.0,125.2424,
     & 48600.0,124.0444,
     & 48800.0,122.8580,
     & 49000.0,121.6825,
     & 49200.0,120.5185,
     & 49400.0,119.3656,
     & 49600.0,118.2236,
     & 49800.0,117.0922,
     & 50000.0,115.9723/

      RPRESS=0.
      IF(RALT.LT.-1000..OR.RALT.GE.50000.) RETURN
      IL=1                             !Find nearest two altitudes
      IH=442
      DO WHILE(IL+1.NE.IH)
        IP=(IH+IL)/2
        IF(RALT.LT.RTABLE(1,IP)) IH=IP
        IF(RALT.GE.RTABLE(1,IP)) IL=IP
      END DO
      RPRESS=RTABLE(2,IL)+(RTABLE(2,IH)-RTABLE(2,IL)) !Linear interpolation
     &    *(RALT-RTABLE(1,IL))/(RTABLE(1,IH)-RTABLE(1,IL))
      RETURN
      END

c_so2.for

C
C ROUTINE	C_SO2 SUBROUTINE FORTVAX
C
C PURPOSE	A subroutine to calculate Carbon monoxide.
C
C DESCRIPTION	The SO2 analyser outputs one measurement.
C		This is input to the program as DRS bits, and converted
C		into PPB by multiplying the DRS bits by a calibration factor.
C
C
C TO COMPILE	$FORT C_SO2
C
C VERSION	1.00  8-Jul-2004  	D.Tiddeman
C                                                                               
C ARGUMENTS	IRAW(1,214) - on entry contains the raw SO2 signal
C               RCONST(1,2,3,4) XO and X1 voltage cal for SO2, v to ppb, ppb offs
C		RDER(1,740) - on exit contains the derived SO2 signal
C
C*******************************************************************************
      SUBROUTINE C_SO2(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.00'
      IMPLICIT NONE
      INTEGER*4 IRAW(64,1024),IFRQ(512)                 
      INTEGER   IFLG
      REAL*4 SO2,RERR
      REAL*4 RCONST(64),RDER(64,1024)
C
C Set default values
C
      RERR=0.
      CALL ISETFLG(RERR,3)
      RDER(1,740)=RERR

C     Copy across raw signals
C
      SO2=FLOAT(IRAW(1,214))
C
C     Convert CO DRS signals first to voltage, then apply voltage to 
C     ppb conversion, then add instrument offset.
C
      SO2=(RCONST(1)+SO2*RCONST(2))*RCONST(3)+RCONST(4)
C
      IFLG=0
      IF(IRAW(1,214).EQ.0) IFLG=3
      IF(IRAW(1,214).EQ.'FFFF'X) IFLG=3
      IF(SO2.LT.0.) IFLG=MAX(2,IFLG)
      CALL ISETFLG(SO2,IFLG)
      RDER(1,740)=SO2
C
      RETURN 
      END

c_sols.for

C ROUTINE      C_SOLS    SUBROUTINE  FORTVAX
C
C PURPOSE     CALIBRATE  PYRANOMETER & PYRGEOMETER RAW SIGNALS AND THERMISTORS.
C
C DESCRIPTION  Apply calibration coefficients to RAW parameters 81-89 and 91-99
C	       to obtain uncorrected values of signal flux, zero offset signal
C              (W/m-2) and thermistor output (deg K)  for  each  of  the 
C              upward-facing and downward-facing sets of: clear dome & red dome
C              pyranometers and pyrgeometer.
C
C NOTE             The actual configuration is specified by the array
C                  ICONF, which has six elements whose meaning interpreted as:
C                    1,4 : Clear dome pyranometer  (upper/lower)
C                    2,5 : red    "       "           "     "
C                    3,6 : Silver "   pyrgeometer     "     "
C                  (normally: ICONF(1-3) Upper instruments.
C                             ICONF(4-6) Lower instruments.)
C                  
C                  This value assists the processing of each instrument by 
C                  selecting the correct range checking values to use.
C                  Should the configuration aboard the aircraft be changed
C                  the array ICONF should be adjusted accordingly by adding
C                  offsets to the second calibration constant in the constants
C                  file. 
C                  e.g. If  the second constant for, say, the second instrument
C                  was changed from 1.23456E-1 to 21.23456E-1, the offset would
C                  decode to "2" after decoding.
C                  This is assigned to ICONF(2) and would imply that the 
C                  'channel' contained raw flux, zero-offset and thermistor 
C                  values for a red dome - rather than clear dome - pyranometer.
C                  and should be range-checked for that type of output only.
C
C METHOD       For each RAW parameter to be calibrated, for the six instruments:
C
C              1. Check all its required constants are present (Flag <3)
C                 (if not, the calibration of that parameter will not proceed)
C                 [Also check that the normal configuration of instruments is to
C                 be used. Any changes are indicated by the presence of a large
C                 offset to the second calibration constant for any instrument.
C                 If this is present the offset is decoded to generate a revised
C                 ICONF indicator for that instrument. See note below.]
C              2. Obtain the raw signal/zero value and float the result.
C              3. Calibrate by applying the appropriate instrument cal in RCALB
C                 (which is loaded from the RCONST arguments) to both raw 
C                 signal flux and zero offset, which  use the same coefficients
C                 The gains are in W/m-2 /DRS count. DRS counts are related
C                 to radiometer output Voltage.
C                 Note that the output Voltage from the instrument  is the
C                 value after being amplified by the head amplifier.
C              4. Range check and Rate-of-change check: (S/R QCPT)
C                 - the calibrated signal (Wm-2)
C                 - Zero offset           (DRS units)
C                 - temperature           (deg K)  
C
C              5. Calibrate the thermistor input using two RCALB coefficients.
C                 Add 273.15 deg to thermistor results to express the 
C                 instrument thermopile temperature in degrees Kelvin.
C              6. Check the result is within pre-defined limits
C              7. Set the calibrated values flag bits (16+17) as follows:
C                         0: Good data  
C                         1: Data of lower quality
C                         2: Data probably faulty, exceeding limits
C                         3: Data absent or known to be invalid.
C
C VERSION      1.04 250692   A D HENNINGS
C
C ARGUMENTS       RCONST(1)  - REAL*4 IN  Upper Clear dome Signal & Zero const.
C              *  RCONST(2)  - REAL*4 IN  Upper Clear dome Signal & Zero gain.
C                 RCONST(3)  - REAL*4 IN  Upper Clear dome Thermistor: constant
C                 RCONST(4)  - REAL*4 IN  Upper Clear dome Thermistor: coeff x.
C                 RCONST(5)  - REAL*4 IN  Upper Red   dome Signal & Zero const.
C              *  RCONST(6)  - REAL*4 IN  Upper Red   dome Signal & Zero gain.
C                 RCONST(7)  - REAL*4 IN  Upper Red   dome Thermistor: constant
C                 RCONST(8)  - REAL*4 IN  Upper Red   dome Thermistor: coeff x.
C                 RCONST(9)  - REAL*4 IN  Upper I/R   dome Signal & Zero const.
C              *  RCONST(10) - REAL*4 IN  Upper I/R   dome Signal & Zero gain.
C                 RCONST(11) - REAL*4 IN  Upper I/R   dome Thermistor: constant
C                 RCONST(12) - REAL*4 IN  Upper I/R   dome Thermistor: coeff x.
C                 RCONST(13) - REAL*4 IN  Lower Clear dome Signal & Zero const.
C              *  RCONST(14) - REAL*4 IN  Lower Clear dome Signal & Zero gain.
C                 RCONST(15) - REAL*4 IN  Lower Clear dome Thermistor: constant
C                 RCONST(16) - REAL*4 IN  Lower Clear dome Thermistor: coeff x.
C                 RCONST(17) - REAL*4 IN  Lower Red   dome Signal & Zero const.
C              *  RCONST(18) - REAL*4 IN  Lower Red   dome Signal & Zero gain.
C                 RCONST(19) - REAL*4 IN  Lower Red   dome Thermistor: constant
C                 RCONST(20) - REAL*4 IN  Lower Red   dome Thermistor: coeff x.
C                 RCONST(21) - REAL*4 IN  Lower I/R   dome Signal & Zero const.
C              *  RCONST(22) - REAL*4 IN  Lower I/R   dome Signal & Zero gain.
C                 RCONST(23) - REAL*4 IN  Lower I/R   dome Thermistor: constant
C                 RCONST(24) - REAL*4 IN  Lower I/R   dome Thermistor: coeff x.
C             (*  also contains an offset evaluated to ICONF() ).
C
C                 IFRQ(par)  _ INT*4  IN  Input frequency of each sample. 
C                 IRAW(n,par)- INT*4  IN  Raw instrument voltage conversion.
C                                         (samples n=1; par=81-89, 91-99)
C                 RDER(op,opar)REAL*4 OUT Raw flux signal, zero-offset signal
C                                         and instrument temperature.
C                                         (samples op=1; opar=673-690)
C
C
C SUBPROGRAMS  ITSTFLG, ISETFLG
C
C FILES        none
C
C REFERENCES   Equations from MRF Instrument section.
C
C CHANGES      020490 Revised  range limits introduced.                 ADH
C              100191                                                   ADH
C                     a) Range limits revised to allow for Pyranometer changes
C               "     b) New arrays to hold raw input, constants etc for
C                        more straightforward indexing.
C               "     c) Include ICONF to aid reconfiguring instrument types.
C              010891 Range limits for ZERO now in terms of DRS units, revised
C                     limits in Wm-2 for signal.
C              030292 Rates of change checks instituted on all BBR inputs.  ADH
C              120698 Bug fixed in quality control processing when using non-
C                     standard configurations. MDG/WDNJ
C              270600 I/R signal maximum increased to stop flagging good data
C                     value arbitary, as no explanation of numbers found.
C                     1050. > 1500. DAT
C              V1.06  02/10/02  Changed to use 16 bit DRS data.
C              V1.07  27/11/02  Now takes X0 sensitivity constant as well as X1
C              V1.08  22/07/04  Bug so doesn't crash if first data flagged 3
C              V1.09  13/08/04  Quality Control zero limits increased for 
C                               16 bit data

c_sun.for

C
C ROUTINE          C_SUN         SUBROUTINE FORTVAX  C_SUN.FOR
C
C PURPOSE          PUT SOLAR ZENITH AND AZIMUTH ANGLES IN MFD
C
C DESCRIPTION      Given date, time and location on the earth's
C                  surface this routine puts a solar zenith and
C                  azimuth angle in the array of derived parameters.
C                  It computes a value once every second. The 
C                  angles are only obtained if all the flags are
C                  set to less than 3 and the date, time and location
C                  are all within sensible limits. Any flags set on input
C                  are also set in the solar angles derived. If
C                  the input is in error or the flags are set to 3
C                  a value of -99. is returned for ZEN and AZIM.
C                  To test the routine:
C                  $ FOR C_SUN
C                  $ FOR TEST_C_SUN
C                  $ LINK TEST_C_SUN,C_SUN
C                  Ensure contents of files RCONST.DAT and TEST_C_SUN.DAT
C                  contain simulated data you require to test the routine
C                  with.
C
C VERSION          1.02  1st May 1992   J.A.Smith
C
C ARGUMENTS        RDER(1,515)  R*4 IN Time GMT (seconds from midnight)
C                  RDER(1,550)  R*4 IN Omega latitude degrees (north +ve)
C                  RDER(1,551)  R*4 IN Omega longitude degrees (east +ve)
C               or RDER(1,541)  R*4 IN INU latitude degrees (north +ve)
C               or RDER(1,542)  R*4 IN INU longitude degrees (east +ve)
C                  RCONST(1)    R*4 IN Day in month (1-31)
C                  RCONST(2)    R*4 IN Month in year (1-12)
C                  RCONST(3)    R*4 IN Year (eg 1984)
C                  RDER(1,642)  R*4 OUT Solar azimuth in degrees
C                  RDER(1,643)  R*4 OUT Solar zenith in degrees
C
C SUBPROGRAMS      S_SUN , ITSTFLG, ISETFLG
C
C CHANGES          01 Range checks for input data now done in S_SUN 
C                     RWS 30/10/90
C                1.02 Check added if time RSECS has reached midnight and
C                     if so to reduce RSECS to less than 86400 s and increase
C                     the date.  JAS 1/5/92
C                1.03 Following the demise of the Omega, now uses INU position
C                     for flights after 30/09/97.  Note that this routine is
C                     now always called by CALIBRATE, even if neither Omega or
C                     INU were available.  WDNJ 20/10/97
C                1.04 Now strips flags from data before use.  WDNJ 22/12/97
C#########################################################################
      SUBROUTINE C_SUN ( IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.04'
C
      INTEGER*4 IRAW(64,512), IFRQ(512), IFLAG(6)
      INTEGER*4 DAYM(12)/31,29,31,30,31,30,31,31,30,31,30,31/
      INTEGER*4 IMIDNIGHTS           ! added for v1.02
      REAL*4    RCONST(64), RDER(64,1024)
      LOGICAL   BAD_INPUT
C

      RSECS = RDER(1,515)            ! Seconds elapsed since midnight GMT
      IDAY = INT(RCONST(1))          ! Date in month
      IMON = INT(RCONST(2))          ! Month in Year
      IYR = INT(RCONST(3))           ! Year
      IF((IYR.EQ.1997.AND.IMON.GE.10).OR.IYR.GT.1997) THEN
        RLAT = RDER(1,541)           ! INU latitude
        RLON = RDER(1,542)           ! INU longitude
      ELSE    
        RLAT = RDER(1,550)           ! Omega latitude
        RLON = RDER(1,551)           ! Omega longitude
      END IF
C
      BAD_INPUT = .FALSE.
C
C   Check flags and only proceed if all less than 3
C
      DO I = 1 , 3
      IFLAG(I) = ITSTFLG(RCONST(I))
      ENDDO            
      IFLAG(4) = ITSTFLG(RSECS)
      IFLAG(5) = ITSTFLG(RLAT)
      IFLAG(6) = ITSTFLG(RLON)
      CALL ISETFLG(RSECS,0)
      CALL ISETFLG(RLAT,0)
      CALL ISETFLG(RLON,0)
C
      IMAXFL = 0
      DO I = 1 , 6
      IMAXFL = MAX ( IMAXFL , IFLAG(I) )       ! Get highest flag value
      IF (IFLAG(I) .GE. 3)THEN
        BAD_INPUT = .TRUE.
        CALL ISETFLG ( AZIM , 3 )             ! Set invalid data flags
        CALL ISETFLG ( ZEN  , 3 )
      ENDIF
      ENDDO
C
C If input parameters OK proceed
C
      IF ( .NOT. BAD_INPUT )THEN
C.........................................................................
C v1.02 If time has run over midnight reduce RSECS to less than 24 hours of
C	seconds, ( 86400 ). The day of the month IDAY is then increased by 
C	the number of midnights passed over.  
C	If this gives too many days for the month then IDAY is set to the 
C	first day and IMON to the next month. 
C	If the data has crossed into a New Year then IMON is set to January
C	and the year is incremented. 
C
      IF (RSECS.GE.86400.) THEN
          IMIDNIGHTS = (NINT(RSECS))/86400
          RSECS = RSECS - REAL(IMIDNIGHTS*86400)
          IDAY = IDAY + IMIDNIGHTS
          IF (MOD(IYR,4).NE.0) DAYM(2)=28  !reduce February if not a leap year
          IF (IDAY.GT.DAYM(IMON)) THEN
              IDAY = IDAY - DAYM(IMON)
              IMON = IMON + 1
              IF (IMON.EQ.13) THEN
                  IMON = 1
                  IYR = IYR + 1
              ENDIF
          ENDIF
      ENDIF
C.........................................................................
C
C  Now compute solar zenith and azimuth angle
C
      CALL S_SUN(IDAY,IMON,IYR,RSECS,RLAT,RLON,AZIM,ZEN) 

C
C  Flag values with highest input flag value
C
C  If azimuth or zenith angle not computed in S_SUN set flags to 3
C
      IF (AZIM.EQ.-99) THEN 
        CALL ISETFLG(AZIM,3) 
      ELSE
        CALL ISETFLG(AZIM,IMAXFL)
      ENDIF

      IF (ZEN.EQ.-99) THEN 
        CALL ISETFLG(ZEN,3) 
      ELSE
        CALL ISETFLG(ZEN,IMAXFL)
      ENDIF
C                                                        
      ELSE
      BAD_INPUT = .TRUE.
      AZIM = -99.0
      ZEN = -99.0
      CALL ISETFLG ( AZIM , 3 )             ! Set invalid data flags
      CALL ISETFLG ( ZEN  , 3 )
C
      ENDIF
C
C  Transfer to output array
C
      RDER(1,642) = AZIM
      RDER(1,643) = ZEN
C         
      RETURN
      END

c_temps2.for

C
C ROUTINE          C_TEMPS2 SUBROUTINE FORTVAX
C     
C PURPOSE          Produces calibrated deiced and non-deiced temperatures
C
C DESCRIPTION      Calculates indicated and true air temperatures in K for the
C                  Deiced and Non-Deiced temperature sensors as follows:
C
C                  519 - Indicated Air Temperature  from Deiced     [K] at 32Hz
C                  520 - True Air Temperature       from Deiced     [K] at 32Hz
C                  524 - Indicated Air Temperature  from Non-deiced [K] at 32Hz
C                  525 - True Air Temperature       from Non-deiced [K] at 32Hz
C
C                  Note that this module only processes data recorded on the
C                  146 which only uses one parameter per temperature.
C                
C                  The Deiced Temperature is recorded on the DRS at 32Hz as 
C                  parameter 10 and the Non-deiced Temperature is recorded on 
C                  the DRS as parameter 23.
C
C                  Indicated Air Temperature is derived by application of 
C                  the appropriate second order calibration coefficients to the
C                  raw data.
C
C                  A correction for heating from the deicing heater is made to
C                  the deiced indicated air temperature if the heater is 
C                  switched on, as indicated by bit 5 of the signal register
C                  (parameter 27) being clear.  This heating correction is
C                  obtained from graphs of Temperature vs Machno in Rosemount
C                  Technical Reports 7597 & 7637.  If Machno is less than
C                  0.1 the data is flagged 1, because the Rosemount graph is 
C                  invalid below 0.1, and if Machno below 0.05, a value of 0.05
C                  is use to ensure a valid logarithm.  The algorithm used for
C                  heating correction is:
C
C             (exp(exp(1.171+(log(Machno)+2.738)*(-0.000568*(s+q)-0.452))))*0.1 
C
C                  where: s=static pressure       [mbs]
C                         q=pitot static pressure [mbs]
C
C
C                  True Air Temperature is derived as:
C
C                  TAT[K] = (Indicated Air Temperature[K]) /
C                                (1.0 +(0.2 * MACHNO * MACHNO * TRECFTR))
C
C                  where: MACHNO  is computed by scientific subroutine S_MACH.
C                         TRECFTR is the Temperature recovery factor - used to
C                                 compensate for effects of kinetic heating.
C                                 This is supplied as a constant from the
C                                 flight constants file to this routine.
C
C                                 It can be calculated from flight results of
C                                 slow/fast runs as:
C
C                   (Tindfast-Tindslow)/(Ffast*Tindslow-Fslow*Tindfast)
C
C                                 where: Tind = indicated temperature [K]
C                                        F    = 0.2 * Machno * Machno
C
C                  Flagging:
C
C                  Both deiced and non-deiced temperature calculations follow
C                  a similar scheme for error flagging, with worst case flags
C                  being propagated through the calculations.  Sources of error
C                  flags are: 
C
C                      Absence of calibration constants    - flag 3
C                      Absence of recovery factor constant - flag 3
C                      Static pressure errors              - Parameter 576 flag
C                      Pitot pressure errors               - Parameter 577 flag
C                      Max/min/rate of change errors       - flag 2
C                      Mach No less than 0.1               - flag 1
C
C                  Not all the above errors need affect all measurements.  For
C                  instance pressure errors will not affect Indicated Air
C                  Temperatures, unless the deicing heater is on.  Note that
C                  this module cannot be called if any of the raw (not derived)
C                  parameters are missing.  Also note that no raw data on which
C                  this module can be used will be carrying flags (only raw
C                  data transcribed on the Gould computer can carry flags).  If
C                  any temperature has a flag of three, its value is set to
C                  0.0 K (and flagged with a three).
C
C VERSION          1.00  10/09/92  W.D.N.JACKSON
C
C ARGUMENTS     
C                  Constants:
C                  RCONST(1)   Recovery factor for Deiced sensor
C                  RCONST(2)   Recovery factor for Non-deiced sensor
C                  RCONST(3)   Deiced X0 calibration constant (deg C)
C                  RCONST(4)   Deiced X1 calibration constant (deg C)
C                  RCONST(5)   Deiced X2 calibration constant (deg C)
C                  RCONST(6)   Non-deiced X0 calibration constant (deg C)
C                  RCONST(7)   Non-deiced X1 calibration constant (deg C)
C                  RCONST(8)   Non-deiced X2 calibration constant (deg C)
C
C                  Inputs: 
C                  DEICED TEMPERATURE            [bits 0-15]     Para  10 32Hz
C                  NON DEICED TEMPERATURE        [bits 0-15]     Para  23 32Hz
C                  SIGNAL REGISTER               [drs units-bcd] Para  27  2Hz
C                  STATIC PRESSURE               [mbs]           Para 576 32Hz
C                  PITOT STATIC PRESSURE         [mbs]           Para 577 32Hz
C
C                  Outputs: 
C                  INDICATED AIR TEMPERATURE (Deiced)   [K]      Para 519 32Hz
C                  TRUE AIR TEMPERATURE      (Deiced)   [K]      Para 520 32Hz
C                  INDICATED AIR TEMPERATURE (NonDeiced)[K]      Para 524 32Hz
C                  TRUE AIR TEMPERATURE      (NonDeiced)[K]      Para 525 32Hz
C                
C SUBPROGRAMS      S_MACH           Calculates Mach no
C                  ITSTFLG          Examines bits 16,17 for flags
C                  ISETFLG          Sets flag bits 16,17 = 0 --> 3
C                  S_QCPT           Performs range and rate of change check
C
C REFERENCES       Code adapted from C_TEMPS module.  See MRF Internal Note 55 -
C                  'Temperature Measurement Working Group Report' for full
C                  details of C-130 temperature measurement.
C
C CHANGES          V1.01  27/09/02  W.D.N.JACKSON
C                  Changed to handle 16 bit temperature recording.
C                  V1.02  23/05/05  D.A.TIDDEMAN
C                  Temperature heater correction changed to opposite sense
C                  Now raw para 27 bit 5 on = heater on
C*******************************************************************************
      SUBROUTINE C_TEMPS2(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.01'
      INTEGER*4 IRAW(64,512),IFRQ(512)
      REAL*4    RCONST(64),RDER(64,1024),RMACH(32)

      DATA      RLV519,RLV520,RLT519,RLT520/4*0./    !Init first time through
      DATA      RLV524,RLV525,RLT524,RLT525/4*0./    !Init first time through
      DATA      R519ERCNT,R520ERCNT/2*1.0/           !Init first time through
      DATA      R524ERCNT,R525ERCNT/2*1.0/           !Init first time through
      
      PARAMETER (R519MX=320.,R519MN=203.,R519RG=1.)  !Limits checks TEMPS [K]
      PARAMETER (R520MX=320.,R520MN=203.,R520RG=1.)  !Limits checks TEMPS [K]
      PARAMETER (R524MX=320.,R524MN=203.,R524RG=1.)  !Limits checks TEMPS [K]
      PARAMETER (R525MX=320.,R525MN=203.,R525RG=1.)  !Limits checks TEMPS [K]
C
      SAVE
      RSEC=RDER(1,515)                 !Time in seconds past midnight
      DO IS=1,32                       !Compute mach no for each sample
        RMACH(IS)=0.
        CALL ISETFLG(RMACH(IS),3)
        IF(ITSTFLG(RDER(IS,576)).NE.3.AND.ITSTFLG(RDER(IS,577)).NE.3)
     &    CALL S_MACH(RDER(IS,576),RDER(IS,577),RMACH(IS)) !Compute mach no
        IFLAG=ITSTFLG(RMACH(IS))       !Save its flag
        CALL ISETFLG(RMACH(IS),0)      !Strip flag
        IF(RMACH(IS).LT.0.05) RMACH(IS)=0.05 !Must be small and +ve
        IF(RMACH(IS).LT.0.1) IFLAG=MAX(IFLAG,1) !If airspeed <.1 set flag to 1
        CALL ISETFLG(RMACH(IS),IFLAG)  !Reapply flag
      END DO
C
C Calculate indicated and true deiced temperatures.
C
      ICFLAG=ITSTFLG(RCONST(3))        !Find worst flag on cal constants
      ICFLAG=MAX(ICFLAG,ITSTFLG(RCONST(4)))
      ICFLAG=MAX(ICFLAG,ITSTFLG(RCONST(5)))
      DO IS=1,IFRQ(10)                 !For each sample of data
        RV=FLOAT(IRAW(IS,10))          !Convert to real
C Calibrate to get indicated temperature
        RDER(IS,519)=RCONST(3)+RCONST(4)*RV+RCONST(5)*RV**2+273.16 !Calibrate
        IFLAG=ICFLAG                   !Set flag if constants were invalid
        IP=((IS*IFRQ(27)-1)/IFRQ(10))+1 !Signal register sample (1 or 2)
C If deicing heater is on, correct for the heating effect
        IF(BTEST(IRAW(IP,27),5)) THEN !If heater was on - removed.NOT.23/05/05
          RM=RMACH(IS)                 !Get mach no
          RS=RDER(IS,576)              !Get static pressure
          RP=RDER(IS,577)              !Get pitot-static pressure
          CALL ISETFLG(RM,0)           !Clear any flag bits
          CALL ISETFLG(RS,0)           !Clear any flag bits
          CALL ISETFLG(RP,0)           !Clear any flag bits
          RHCORR=0.1*EXP(EXP(1.171+(ALOG(RM)+2.738)* !Compute heater correction
     -        (-0.000568*(RS+RP)-0.452)))
          RDER(IS,519)=RDER(IS,519)-RHCORR !Apply to indicated temperature
          IFLAG=MAX(IFLAG,ITSTFLG(RMACH(IS))) !Note errors on mach no
          IFLAG=MAX(IFLAG,ITSTFLG(RDER(IS,576))) !Note errors on static
          IFLAG=MAX(IFLAG,ITSTFLG(RDER(IS,577))) !Note errors on pitot
        END IF
C Apply any flags, do quality control, any reflag if necessary
        IF(IFLAG.EQ.3) RDER(IS,519)=0.0 !If completely invalid set to zero
        CALL S_QCPT(RSEC,RLT519,RDER(IS,519),RLV519,R519MX,R519MN,
     -      R519RG,64.0,R519ERCNT,IQFLAG) !Carry out quality control
        IFLAG=MAX(IFLAG,IQFLAG)        !Use QC flag if worse
C Now work out true temperature
        RM=RMACH(IS)                   !Get mach no
        CALL ISETFLG(RM,0)             !Clear any flag bits
        RDER(IS,520)=RDER(IS,519)/(1.0+(0.2*RM**2*RCONST(1))) !Convert to true
        CALL ISETFLG(RDER(IS,519),IFLAG) !Apply flag to indicated temperature
C Apply any flags, do quality control, and reflag if necessary
        IFLAG=MAX(IFLAG,ITSTFLG(RMACH(IS))) !Note any errors on mach no
        IFLAG=MAX(IFLAG,ITSTFLG(RCONST(1))) !Note any errors on recovery factor
        IF(IFLAG.EQ.3) RDER(IS,520)=0.0 !If completely invalid set to zero
        CALL S_QCPT(RSEC,RLT520,RDER(IS,520),RLV520,R520MX,R520MN,
     -      R520RG,64.0,R520ERCNT,IQFLAG) !Carry out quality control
        IFLAG=MAX(IFLAG,IQFLAG)        !Use QC value if worse
        CALL ISETFLG(RDER(IS,520),IFLAG) !Apply flag to true temperature
      END DO                           !Get next temperature sample
C
C Calculate indicated and true non-deiced temperatures.
C
      ICFLAG=ITSTFLG(RCONST(6))        !Find worst flag on cal constants
      ICFLAG=MAX(ICFLAG,ITSTFLG(RCONST(7)))
      ICFLAG=MAX(ICFLAG,ITSTFLG(RCONST(8)))
      DO IS=1,IFRQ(23)                 !For each sample of data
        RV=FLOAT(IRAW(IS,23))          !Convert to real
C Calibrate to get indicated temperature
        RDER(IS,524)=RCONST(6)+RCONST(7)*RV+RCONST(8)*RV**2+273.16 !Calibrate
C Apply any flags, do quality control, any reflag if necessary
        IFLAG=ICFLAG                   !Set flag if constants were invalid
        IF(IFLAG.EQ.3) RDER(IS,524)=0.0 !If completely invalid set to zero
        CALL S_QCPT(RSEC,RLT524,RDER(IS,524),RLV524,R524MX,R524MN,
     -      R524RG,64.0,R524ERCNT,IQFLAG) !Carry out quality control
        IFLAG=MAX(IFLAG,IQFLAG)        !Use QC flag if worse
C Now work out true temperature
        RM=RMACH(IS)                   !Get mach no
        CALL ISETFLG(RM,0)             !Clear any flag bits
        RDER(IS,525)=RDER(IS,524)/(1.0+(0.2*RM**2*RCONST(2))) !Convert to true
        CALL ISETFLG(RDER(IS,524),IFLAG) !Apply flag to indicated temperature
C Apply any flags, do quality control, and reflag if necessary
        IFLAG=MAX(IFLAG,ITSTFLG(RMACH(IS))) !Note any errors on mach no
        IFLAG=MAX(IFLAG,ITSTFLG(RCONST(2))) !Note any errors on recovery factor
        IF(IFLAG.EQ.3) RDER(IS,525)=0.0 !If completely invalid set to zero
        CALL S_QCPT(RSEC,RLT525,RDER(IS,525),RLV525,R525MX,R525MN,
     -      R525RG,64.0,R525ERCNT,IQFLAG) !Carry out quality control
        IFLAG=MAX(IFLAG,IQFLAG)        !Use QC value if worse
        CALL ISETFLG(RDER(IS,525),IFLAG) !Apply flag to true temperature
      END DO                           !Get next temperature sample
C
      RETURN
      END

c_tpress.for

!
! ROUTINE          C_TPRESS SUBROUTINE FORTVAX
!     
! PURPOSE          Calibrates the five turbulence probe pressure transducers
!                  into mb.
!
! DESCRIPTION      Apply calibration the combined transducer and DRS 
!                  coefficients to DRS parameters 215 to 219 to obtain derived
!                  parameters 773 to 777.  Invalid data is flagged with 3, data
!                  outside limits is flagged with 2.
!
! METHOD           For each DRS parameter to be calibrated:
!                  1. If data is FFFF or FFFE then flag 3
!                  2. Apply the calibration constants
!                  3. Check the results for being within acceptable values.
!                  4. Set data flag bits (16+17) 0: Good data
!                                                1: Data of lower quality
!                                                2: Probably faulty, exceed lims
!                                                3: Data absent or invalid.
!
!                  Flagging - If a value can't be computed, due to missing data
!                  missing constants, divide be zeroes, etc, a value of 0 is
!                  used, flagged with a three.  If a value is outside its 
!                  limits for range or rate of change, it is flagged with a two.
!                  If there are no problems with the data it is flagged with 0.
!
! VERSION          1.00  23/07/03  W.D.N.JACKSON
!
! ARGUMENTS        Inputs:
!                    DRS para 215 TBP1 32 Hz Turbulence probe centre port
!                        para 216 TBP2 32 Hz Turbulence probe attack ports
!                        para 217 TBP3 32 Hz Turbulence probe sideslip ports
!                        para 218 TBP4 32 Hz Turbulence probe attack check
!                        para 219 TBP5 32 Hz Turbulence probe sideslip check
!
!                  Constants:
!                        RCONST(1 to 4) Para 215 cal constants X0 to X3
!                        RCONST(5 to 8) Para 216 cal constants X0 to X3
!                        RCONST(9 to 12) Para 217 cal constants X0 to X3
!                        RCONST(13 to 14) Para 218 cal constants X0 to X1
!                        RCONST(15 to 16) Para 219 cal constants X0 to X1
!
!                  Outputs:
!                    Derived para 773 TBP0 mb 32 Hz Centre pressure
!                            para 774 TBPA mb 32 Hz Attack pressure
!                            para 775 TBPB mb 32 Hz Sideslip pressure
!                            para 776 TBPC mb 32 Hz Attack check pressure
!                            para 777 TBPD mb 32 Hz Sideslip check pressure
!
!                  Flags:
!                    Missing/corrupt data output as 0 flagged 3.
!                    Out of range data flagged 2.
!
! SUBPROGRAMS      ISETFLG 
!
! REFERENCES       
!
! CHANGES          V1.00 23/07/03  WDNJ Original version
!                  Note that V1.00 has no limit checking and no use is made of
!                  the check pressures.
!                  V1.01 25/03/04  WDNJ
!                  Now takes third order calibration constants for the main
!                  transducers, and first order for the check transducers.
!                  V1.02 26/01/06 Phil Brown
!                  Realistic min/max values provided for centre-port, Pa, Pb
!                  for flagging purposes. Values alsoe provided for check
!                  pressures Ca, Cb based on current (and probably wrong)
!                  calibration coefficients.
!                  V1.03 09/02/11 Axel Wellpott
!                  From an email from Phil Brown: "The P0-S10 differential pressure
!                  (para 773) is flagged 2 if it exceeds 130.0 hPa. This is easily 
!                  exceeded when we do acceleration to max speed (min Angle of Attack)
!                  so all the subsequent parameters calculated n C_TURB.for end up with a
!                  flag-3 saetting. I reckon a better value would be 180.0 hPa."
!
!*******************************************************************************
      SUBROUTINE C_TPRESS(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.03'
!
      INTEGER*4 IRAW(64,512),IFRQ(512),IS,IP,IFLG,IVAL
      REAL*4    RCONST(64),RDER(64,1024),RVAL,RMAX(5),RMIN(5)
      DATA RMIN /30.,-30.,-20.,50.,50./
!      DATA RMAX /130.,30.,20.,200.,200./
!     Values changed on 09/02/2011
      DATA RMAX /180.,30.,20.,200.,200./
!
! Derive port pressures.  Note that by default derived parameters will have a 
! value of 0 flagged with a 3.
!
      DO IP=1,5                        !For each parameter
        DO IS=1,IFRQ(215)              !For each sample
          IFLG=0
          IVAL=IRAW(IS,214+IP)
          IF(IVAL.EQ.'FFFF'X.OR.IVAL.EQ.'FFFE'X) IFLG=3
          IF(IFLG.NE.3) THEN
            RVAL=FLOAT(IVAL)
            IF(IP.EQ.1) THEN
              RVAL=RCONST(1)+RVAL*RCONST(2)+RVAL*RVAL*RCONST(3)
     &             +RVAL*RVAL*RVAL*RCONST(4)
            ELSE IF(IP.EQ.2) THEN
              RVAL=RCONST(5)+RVAL*RCONST(6)+RVAL*RVAL*RCONST(7)
     &             +RVAL*RVAL*RVAL*RCONST(8)
            ELSE IF(IP.EQ.3) THEN
              RVAL=RCONST(9)+RVAL*RCONST(10)+RVAL*RVAL*RCONST(11)
     &             +RVAL*RVAL*RVAL*RCONST(12)
            ELSE IF(IP.EQ.4) THEN
              RVAL=RCONST(13)+RVAL*RCONST(14)
            ELSE IF(IP.EQ.5) THEN
              RVAL=RCONST(15)+RVAL*RCONST(16)
            END IF
            IF(RVAL.LT.RMIN(IP).OR.RVAL.GT.RMAX(IP)) IFLG=2
            RDER(IS,772+IP)=RVAL
            CALL ISETFLG(RDER(IS,772+IP),IFLG)
          END IF
        END DO
      END DO
! 
      RETURN
      END

c_turb.for

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!         ROUTINE      C_TURB
!
!         PURPOSE      To calibrate and apply designated correction factors to
!                      angle of attack (AOA), angle of sideslip (AOSS) and the
!                      centre-static differential pressure (to derive TAS)).
!
!         DESCRIPTION  Calibration of AOA and AOSS is assumed to be of the form:
!                      
!                      PA/q = a0(M) + a1(M)*alpha
!                      PB/q = b0(M) + b1(M)*beta
!                      where q is the pitot(dynamic) pressure.
!                      Calculations follow the scheme described in BAES doc
!                      ADE-46S-R-463-34 1233 (Page 78 of 116).
!                      Initial value of pitot pressure is taken from RVSM and
!                      used to calculate first guess AOA and AOSS. These are
!                      to derive corrections to the centre-port along with 
!                      separate calculation of static position error in the
!                      centre-port measurement. AOA and AOSS are recalculated
!                      with iteration continuing until specified tolerance is
!                      achieved or max.iteration count exceeded. Corrected
!                      centre-port pressure is then used to calculate TAS
!                      (currently only the dry value) using:
!
!                      TAS = Corrtn.fac * 340.294*M*SQRT(T/288.15)
!
!         VERSION      1.01   Phil Brown 24/5/2004
!
!         CHANGES      1.02   Phil Brown 11/6/2004
!                             Logic changed to reproduce PVWAVE test version
!                             MRFB:[BROWN.PVWAVE]TURB.PRO at this date
!                      1.03   Phil Brown 28/6/2004
!                             Check flags and values following return of calls
!                             to S_MACH. Unacceptable causes C_TURB to return
!                             its default values of output parameters (flag 3)
!                      1.04   Phil Brown 2/7/04
!                             Uses G_MACH routine to calculate Mach no. and
!                             avoid complications due to flagging.
!                      1.05   Phil Brown 08/07/04
!                             Uses simpler Mach-dependent PE.Corrtn derived
!                             empirically from B001-012 s&l legs.
!                      1.06   Phil Brown 09/07/04
!                             No position error correction currently applied
!                             to P0 differential pressure.
!                      1.07   Phil Brown 26/08/04
!                             Change sign of AOSS. Cals were done against INS
!                             drift angle (-ve for +ve AOSS).
!                      1.08   Phil Brown 27/8/04
!                             AOSS calcs revert to original, but assumed to use
!                             new fit coefficients for B0 and B1
!                      1.09   26/01/06 Phil Brown
!                             Min/max limits provided for AoA, AoSS and TAS for
!                             flagging purposes.
!                      1.10   20/06/06 Phil Brown
!                             Takes additional input of non-deiced temp, used as
!                             alternative when de-iced is flagged 2 or more.
!                      1.11   24/10/06 Phil Brown
!                             Fix bug setting flag on TTND to zero before use.
!                             Define 4 additional flight constants to apply
!                             fudge factors to the calculated AoA / AoSS
!                             These have the form:
!                             AoA_new = AoA * ALPH1 + ALPH0
!                             AoSS_new= AoSS * BET1 + BET0
!                      1.12   08/10/2010 Axel Wellpott
!                             added line "DATA TAS/-9999./"
!                             Missing TAS data values were set to -999.
!                             and not to -9999. as specified in the netcdf
!                             files.
!
!         SUBROUTINES: S10_PECORR, ITSTFLG, ISETFLG, G_MACH
!
!         FILES        
!
!         REFERENCES 
!
!         CONSTANTS 
!           RCONST(1-3) Coefficients of 2nd order polynomial in Mach to 
!                       calculate AOA offset, A0 
!           RCONST(4-6) Coefficients of 2nd order polynomial in Mach to 
!                       calculate AOA sensitivity, A1 
!           RCONST(7-9) Coefficients of 2nd order polynomial in Mach to 
!                       calculate AOSS offset, B0 
!           RCONST(10-12) Coefficients of 2nd order polynomial in Mach to 
!                       calculate AOSS sensitivity, B1
!           RCONST(13)  Tolerance for AOA/AOSS iteration
!           RCONST(14)  True Airspeed correction factor (fudge factor to 
!                       remove residual along-heading wind errors).
!           RCONST(15-16) Coefficients of linear correction to calculated AoA
!           RCONST(17-18) Coefficients of linear correction to calculated AoSS
!  
!         INPUT PARAMETERS
!           516  IAS   32Hz
!           520  TTDI  32Hz
!           525  TTND  32Hz
!           576  SPR   32Hz
!           577  PSP   32Hz
!           578  PHGT  32Hz
!           773  TBP0  32Hz
!           774  TBPA  32Hz
!           775  TBPB  32Hz
!           776  TBPC  32Hz
!           777  TBPD  32Hz
!
!         OUTPUT PARAMETERS
!           
!           548  AOA   32Hz  deg
!           549  AOSS  32Hz  deg
!           779  TASD  32Hz  ms-1
!           780  TASW  32Hz  ms-1
!           781  TPSP  32Hz  mb
! 
!         TURBULENCE PROBE CONSTANT KEYWORDS
!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE C_TURB(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.12'
      IMPLICIT NONE
      INTEGER*4 IRAW(64,512),IFRQ(512),I,J
      INTEGER*4 ITSTFLG, ITTDIFLG, ITTNDFLG, ISPRFLG, IPSPFLG, IPHGTFLG
      INTEGER*4 IP0FLG, IPAFLG, IPBFLG, ICAFLG, ICBFLG, IMACHFLG
      INTEGER*4 IASFLG, IFLAG
      REAL*4    RCONST(64),RDER(64,1024)
      REAL*4    AIAS,TTDI,TTND,SPR,PSP,PHGT,TP0,TPA,TPB,CA,CB
      REAL*4    AOA, AOANEW, AOSS, AOSSNEW, TOL
      REAL*4    DCP_S10, DCPA, DCPB, P0, Q
      REAL*4    AMACH, A0, A1, B0, B1, DAOA, DAOSS, TAS
      DATA TAS/-9999./                   ! set all TAS values to -9999.
!
      REAL*4    AIASMIN,TASMIN,TASMAX
      DATA AIASMIN,TASMIN,TASMAX/50.0,50.,250./
!
      REAL*4    AOAMIN,AOAMAX,AOSSMIN,AOSSMAX
      DATA AOAMIN,AOAMAX,AOSSMIN,AOSSMAX/0.,15.0,-5.0,5.0/
!
      INTEGER*4 ITER, ITERMAX, MAXITER
      DATA ITER,ITERMAX,MAXITER/0,5,0/   ! iteration counters, within each
!                                        ! sample and each second
!
      DO I=1,32                         ! set placeholder values and flags
        RDER(I,548)=-99.9                !Set AoA to 0
        CALL ISETFLG(RDER(I,548),3)
        RDER(I,549)=-99.9                !Set AoSS to 0
        CALL ISETFLG(RDER(I,549),3)
        RDER(I,779)=-9999.                !Set dry turbulence probe airspeed
        CALL ISETFLG(RDER(I,779),3)
        RDER(I,780)=-9999.                !Set wet turbulence probe airspeed
        CALL ISETFLG(RDER(I,780),3)
        RDER(I,781)=-950.                !Set turbulence probe pitot-static
        CALL ISETFLG(RDER(I,781),3)
      END DO

! now do the real calculations
      MAXITER = 0

      DO I=1,32                         ! outer loop over 32 samples
        AIAS = RDER(I,516)
        IASFLG   = ITSTFLG(AIAS)        ! preserve flags from all inputs params
        CALL ISETFLG(AIAS,0)            ! and reset flag to zero
        TTDI = RDER(I,520)
        ITTDIFLG = ITSTFLG(TTDI)
        CALL ISETFLG(TTDI,0)
        TTND = RDER(I,525)
        ITTNDFLG = ITSTFLG(TTND)
        CALL ISETFLG(TTND,0)                   ! V1.11 bug fix here
        SPR  = RDER(I,576)
        ISPRFLG  = ITSTFLG(SPR)
        CALL ISETFLG(SPR,0)
        PSP  = RDER(I,577)
        IPSPFLG  = ITSTFLG(PSP)
        CALL ISETFLG(PSP,0)
        PHGT = RDER(I,578)
        IPHGTFLG = ITSTFLG(PHGT)
        CALL ISETFLG(PHGT,0)
        TP0   = RDER(I,773)
        IP0FLG   = ITSTFLG(TP0)
        CALL ISETFLG(TP0,0)
        TPA   = RDER(I,774)
        IPAFLG   = ITSTFLG(TPA)
        CALL ISETFLG(TPA,0)
        TPB   = RDER(I,775)
        IPBFLG   = ITSTFLG(TPB)
        CALL ISETFLG(TPB,0)
        CA   = RDER(I,776)
        CB   = RDER(I,777)

!        IF(AIAS.LE.AIASMIN) THEN
!          PRINT *,'Inputs'
!          PRINT *,AIAS,TTDI,SPR,PSP,PHGT,TP0,TPA,TPB,CA,CB
!          PRINT *,'RDER(515-520)'
!          PRINT *,(RDER(I,J),J=515,1024)
!        ENDIF

! Proceed only with acceptable flag settings and IAS > 50m/s
        IF(ISPRFLG.LE.1.AND.IPSPFLG.LE.1.AND.IPHGTFLG.LE.1.AND.
     -     IP0FLG.LE.1.AND.IPAFLG.LE.1.AND.IPBFLG.LE.1.AND.
     -     AIAS.GT.AIASMIN) THEN

! Mach number from RVSM pitot pressure
!        CALL ISETFLG(SPR,0)
!        CALL ISETFLG(PSP,0)
        Q = PSP
        CALL G_MACH(SPR, Q, AMACH)
! Check values returned by Mach number calculation
        IF(AMACH.GT.0.0.AND.AMACH.LT.1.0) THEN
!        PRINT *,SPR,PSP,AMACH

! First guess AOA and AOSS
        A0 = RCONST(1)+AMACH*(RCONST(2)+AMACH*RCONST(3))
        A1 = RCONST(4)+AMACH*(RCONST(5)+AMACH*RCONST(6))
        B0 = RCONST(7)+AMACH*(RCONST(8)+AMACH*RCONST(9))
        B1 = RCONST(10)+AMACH*(RCONST(11)+AMACH*RCONST(12))

!        PRINT *,'A0,A1,B0,B1',A0,A1,B0,B1,AMACH

        AOA  = (TPA/Q - A0)/A1
        AOSS = (TPB/Q - B0)/B1

! Calculate position error in S10 static pressure.
!        PRINT *,P0,PHGT,PSP,AOA,AOSS
        CALL S10_PECORR(DCP_S10,AMACH)

! Calculate and apply flow angle corrections to derive true pitot pressure
! from centre-port measurement.
        DCPA = 0.0273+ AOA*(-0.0141+ AOA*(0.00193- AOA*5.2E-5))
        DCPB = 0.0   +AOSS*(0.0    + AOSS*7.6172E-4)

! Apply corrections to measured differential pressure
!        P0 = TP0+(DCPA+DCPB+DCP_S10)*Q
        P0 = TP0+(DCPA+DCPB)*Q
        Q = P0
!        PRINT *,'P0 = ',P0

! Recalculate Mach number
!        CALL ISETFLG(SPR,0)
        CALL ISETFLG(Q,0)
        CALL G_MACH(SPR,Q,AMACH)
! Check values returned by Mach number calculation
        IF(AMACH.GT.0.0.AND.AMACH.LT.1.0) THEN
!        PRINT *,SPR,Q,AMACH

        ITER=0
! Recalculate AOA/AOSS
100     ITER=ITER+1
        A0 = RCONST(1)+AMACH*(RCONST(2)+AMACH*RCONST(3))
        A1 = RCONST(4)+AMACH*(RCONST(5)+AMACH*RCONST(6))
        B0 = RCONST(7)+AMACH*(RCONST(8)+AMACH*RCONST(9))
        B1 = RCONST(10)+AMACH*(RCONST(11)+AMACH*RCONST(12))

        AOANEW  = (TPA/Q - A0)/A1
        AOSSNEW = (TPB/Q - B0)/B1

        DAOA = AOANEW-AOA
        DAOSS= AOSSNEW-AOSS
        TOL  = RCONST(13)

        AOA = AOANEW
        AOSS= AOSSNEW

! Recalculate position error correction to S10
        CALL S10_PECORR(DCP_S10,AMACH)

! Recalculate flow-angle corrections to centre-port.
        DCPA = 0.0273+ AOA*(-0.0141+ AOA*(0.00193- AOA*5.2E-5))
        DCPB = 0.0   +AOSS*(0.0    + AOSS*7.6172E-4)

! Apply corrections to measured pressure
!        P0 = TP0+(DCPA+DCPB+DCP_S10)*Q
        P0 = TP0+(DCPA+DCPB)*Q
        Q  = P0

! Recalculate Mach number
!        CALL ISETFLG(SPR,0)
        CALL ISETFLG(Q,0)
        CALL G_MACH(SPR,Q,AMACH)
! Check values returned by Mach number calculation
        IF(AMACH.GT.0.0.AND.AMACH.LT.1.0) THEN

! Test flow angles changes wrt tolerance
        IF((ABS(DAOA).GT.TOL.OR.ABS(DAOSS).GT.TOL)
     *     .AND.ITER.LT.ITERMAX) GOTO 100

! Calculate dry (and later also wet) TAS from Mach number and temperature
!        PRINT *,'AMACH / TTDI', AMACH, TTDI
        IF(ITTDIFLG.LE.1) THEN     ! de-iced OK
          TAS = RCONST(14) * 340.294 * AMACH * SQRT(TTDI/288.15)
        ELSE
          TAS = RCONST(14) * 340.294 * AMACH * SQRT(TTND/288.15)
        ENDIF

! Apply linear corrections to calculated AoA and AoSS, derived from Al Rodi
! analysis - minimization of residual vertical wind during yawing orbits.
        IF((ITSTFLG(RCONST(15)).EQ.0.).AND.
     &     (ITSTFLG(RCONST(16)).EQ.0.).AND.
     &     (ITSTFLG(RCONST(17)).EQ.0.).AND.
     &     (ITSTFLG(RCONST(18)).EQ.0))THEN
             AOA = AOA*RCONST(16) + RCONST(15)
             AOSS= AOSS*RCONST(18) + RCONST(17)
        ENDIF

! Check data flagging and output parameters. 

        RDER(I,548) = AOA
        IFLAG=0
        IF(AOA.LT.AOAMIN.OR.AOA.GT.AOAMAX) IFLAG=2
        IFLAG=MAX(IFLAG,IPAFLG)
        CALL ISETFLG(RDER(I,548),IFLAG)

        RDER(I,549) = AOSS
        IFLAG=0
        IF(AOSS.LT.AOSSMIN.OR.AOSS.GT.AOSSMAX) IFLAG=2
        IFLAG=MAX(IFLAG,IPBFLG)
        CALL ISETFLG(RDER(I,549),IPBFLG)

        RDER(I,779) = TAS
        IFLAG=0
        IF(TAS.LT.TASMIN.OR.TAS.GT.TASMAX) IFLAG=2
        IFLAG=MAX(IFLAG,IP0FLG)
        CALL ISETFLG(RDER(I,779),IP0FLG)

        RDER(I,780) = -99.9
        CALL ISETFLG(RDER(I,780),3)
        RDER(I,781) = Q
        CALL ISETFLG(RDER(I,781),IP0FLG)

        ENDIF   ! test on third Mach number calculation
        ENDIF   ! test on second Mach number calculation
        ENDIF   ! test on first Mach number calculation

        ENDIF ! end of test on flag settings

! track maximum iteration count in this 1-second sample
        IF(ITER.GT.MAXITER) MAXITER=ITER

      ENDDO ! end of calculation loop
!      PRINT *,'Max. iteration count this second =',MAXITER

      RETURN
      END
!
      SUBROUTINE S10_PECORR(DCP_S10,AMACH)
CDEC$ IDENT 'V1.00'
!
! PURPOSE  To calculate values of the S10 static pressure position error  
!          as a function of Mach number, derived from B001-B012 calibrations
!
! AUTHOR   Phil Brown
!
! VERSION  1.00 08/07/2004
!
      IMPLICIT NONE
      REAL*4 DCP_S10, AMACH, A0,A1,A2
      DATA A0,A1,A2/-0.011482, -0.148295, 0.407040/

      DCP_S10 = A0 + AMACH*(A1 + AMACH*A2)

      RETURN
      END

c_twc.for

C
C ROUTINE	    C_TWC   subroutine fortvax/fort77
C
C PURPOSE	    To calibrate DRS pars. 70-78 into TARDIS parameters 664-672
C	
C DESCRIPTION       The same algorithm is used for all nine parameters. First
C		    check to see if the right frequency has been set. Find
C		    the flag of the raw data. Work out the derived parameter,
C		    #665-#671, values of RCONST are used in a polynomial
C		    fit. For #664(Detector) and #672(status word) the raw
C		    data is converted from an integer to a real. Then the 
C		    derived data is tested to see if it lies between the
C		    accepted envelope of values for that parameter. The flag
C		    is set to 2 if it lies outside the envelope. If any
C		    other tests are failed the derived parameter is set to
C		    -9999.0 with the flag at 3. At the end, with all the
C		    parameters calculated,  a rate of change check is made. 
C		    This looks at the values set in RATE_CHANGE.
C
C		    Derived data limits and rate of change limits;
C
C		    DRS  TARDIS   min    max   rate/change   units
C		    par   par
C		    70    664     0      4094       -         DRS
C                   71    665     314    383      10.0         K
C                   72    666     323    388       3.0         K
C                   73    667     289    343       2.0         K
C                   74    668     378    393       5.0         K
C                   75    669     0.3    6.6       0.5         A
C                   76    670     0.3    6.6       0.5         A
C                   77    671     0.4E-3 1.1E-3    0.05E-3     A
C                   78    672     0      4095       -         DRS
C
C VERSION 	    1.00 080190 M.J.GLOVER
C
C ARGUMENTS         IRAW(64,512) I*4  IN   Raw data for the parameters
C		    IFRQ(512)    I*4  IN   Frequencies of the data
C		    RCONST(64)   R*4  IN   Constants required by routine,(1-32)
C		    RDER(64,1024)R*4  OUT  Tardis parameters
C	
C COMMON	    None.
C                 
C SUBPROGRAMS	    ISETFLG (linked automatically)
C
C FILES		    None.
C	
C REFERENCES	    MRF2 Specification for Total Water Hygrometer 4 Dec 1989
C
C CHANGES           V1.01  10/06/94  W.D.N.JACKSON / S.J.MOSS
C                   Modified to correctly compute evaporator currents when the
C                   modified TWC instrument is flown (ie for A188 onwards).  In
C                   this case DRS parameters 173 and 174 are also used.  If
C                   the CALHTR1 and CALHTR2 keywords in the flight constants 
C                   file have four values then processing for the modified 
C                   probe is used; if they have two values then the old
C                   processing is used.  Note that parameters 173 and 174 are
C                   optional for this routine and CALIBRATE does not insist
C                   that they are present.  Also note that when this routine is
C                   used for flights before A188 CALIBRATE issues a warning
C                   that some of the constants are absent; this can be ignored.
C
C###############################################################################

	SUBROUTINE C_TWC(IRAW, IFRQ, RCONST, RDER)
CDEC$ IDENT 'V1.01'
	INTEGER*4 IRAW(64,512), IFRQ(512)
	REAL*4 RCONST(64), RDER(64, 1024)
        REAL OLD_PARAS(7), RATE_CHANGE(7)

	DATA RATE_CHANGE/10.0, 3.0, 2.0, 5.0, 0.5, 0.5, 0.05E-03/

C	Calibrate the hygrometer detector output - DRS parameter 70, sample
C	rate 64 Hz. To be left as bits.                 
	IF (IFRQ(70).EQ.64) THEN   ! See if the right frequency is there.
       		DO IS=1, IFRQ(70)  ! Do for each sample.

C			If the raw data is inside the bounds, process it.
			IF (((IRAW(IS, 70).AND.'FFF'X).GT.-1).AND.
     1					((IRAW(IS,70).AND.'FFF'X)
     2							.LT.4095)) THEN
C				IFLAG=ITSTFLG(IRAW(IS, 70))
				IFLAG=0
               
C     				If the flag of the raw data is less than three,
C      				then convert the raw data into derived data.
	 			IF (IFLAG.LT.3) THEN
					RDER(IS, 664)=FLOAT(IRAW(IS,70)
     1						      .AND.'FFF'X)

C				If the flag is three or above, set the 
C				derived data to -9999.0.
	     			ELSE
					RDER(IS, 664)=-9999.0
				END IF
			ELSE

C				If the raw data is outside the bounds, set it 
C				to -9999.0.
				RDER(IS, 664)=-9999.0
          		ENDIF
               

C			If the derived data is outside the bounds of 0 and 
C			4094, set the flag to three.
			IF ((RDER(IS, 664).LT.0.0).OR.
     1					(RDER(IS, 664).GT.4094)) THEN
	     			CALL ISETFLG(RDER(IS, 664), 3) 
      			ELSE

C				If the derived data is within the bounds of 0
C				and 4094, then set the flag to that of the raw
C				data's.
				CALL ISETFLG(RDER(IS, 664), IFLAG) 
	    		END IF
   		END DO
	ELSE 

C		If the wrong frequency is there for the detector, then set all
C		the samples for this second to -9999.0, with their flags set 
C		to 3.
		DO IS=1, 64
			RDER(IS, 664)=-9999.0
			CALL ISETFLG(RDER(IS,664),3)
		END DO
	ENDIF

C	Calibrate the nose temperature - DRS parameter 71, sample rate 1 Hz
C	This is to be put into Kelvin. A do loop is used, as the sample rate
C	may well change. This uses the elements of RCONST from 1 to 5.
	IF (IFRQ(71).EQ.1) THEN  ! check the frequency.
		DO IS=1, IFRQ(71)  ! for each sample

C			See if all the const are there,if not set the flag to 3
		       	ICHECK=1
			DO I=1,5
				IF (ITSTFLG(RCONST(I)).GT.2) THEN
					ICHECK=ICHECK+1
				END IF
                        END DO
			
C			ICHECK will be more than one if any of the constants 
C			are missing 
			IF (ICHECK.EQ.1) THEN
C				IFLAG=ITSTFLG(IRAW(IS, 71))
				IFLAG=0
			ELSE
				IFLAG=3
			END IF
     				
C			If the flag of the raw data is less than three, then 
C			convert the raw data into derived data. This is done 
C			using a polynomial fit.
	       	       	IF (IFLAG.LT.3) THEN
		                RAW=FLOAT(IRAW(IS,71).AND.'FFF'X)
				RDER(IS, 665)=RCONST(1)

				DO INC=2,5
					RDER(IS, 665)=RDER(IS, 665)+
     1					              RCONST(INC)*
     2						      (RAW**(INC-1))
      				END DO
	     		ELSE

C				If the flag is three or above, set the 
C				derived data to -9999.0.
				RDER(IS, 665)=-9999.0
    			END IF


C			If the derived data is outside the bounds but not 
C			-9999.0, then set the flag to two.
			IF (((RDER(IS, 665).LT.314.0).OR.
     1					(RDER(IS, 665).GT.383.0)).AND.
     2					(RDER(IS, 665).GT.-9000.0)) THEN
				CALL ISETFLG(RDER(IS, 665), 2)
			ELSE

C				The derived data is within the limits then 
C				set the flag to that of the raw data. If the 
C				data is -9999.0 the flag will be three.
			 	CALL ISETFLG(RDER(IS, 665), IFLAG) 
	    		ENDIF	

 		END DO
        ELSE

C		The data has not got the right frequency.
		RDER(1, 665)=-9999.0
		CALL ISETFLG(RDER(1,665),3)
	ENDIF

C	Calibrate the sample temp -DRS parameter 72, sample rate 1 HZ. This is 
C	to be turned into Kelvin. This uses the elements of RCONST from 6 to 11
	IF (IFRQ(72).EQ.1) THEN  ! check the frequency.
		DO IS=1, IFRQ(72)  ! for each sample

C			See if all the const are there,if not set the flag to 3
		       	ICHECK=1
			DO I=6,11
				IF (ITSTFLG(RCONST(I)).GT.2) THEN
					ICHECK=ICHECK+1
				END IF
                        END DO
			
			
C			ICHECK will be more than one if any of the constants 
C			are missing. 
			IF (ICHECK.EQ.1) THEN
C				IFLAG=ITSTFLG(IRAW(IS, 72))
				IFLAG=0
			ELSE
				IFLAG=3
			END IF
     				
C			If the flag of the raw data is less than three, then 
C      			convert the raw data into derived data. This is done 
C			using a polynomial fit.
	       	       	IF (IFLAG.LT.3) THEN
	           		RAW=FLOAT(IRAW(IS,72).AND.'FFF'X)
		       		RDER(IS, 666)=RCONST(6)
		
				DO INC=7,11
					RDER(IS, 666)=RDER(IS, 666)+
     1					     	      RCONST(INC)*
     2						      (RAW**(INC-6))
      	 			END DO
	     		ELSE

C				If the flag is three or above, set the
C				derived data to -9999.0. 
				RDER(IS, 666)=-9999.0
	   		END IF

C			If the derived data is outside the bounds but not 
C			-9999.0, then set the flag to two.
     			IF ( ( (RDER(IS, 666).LT.323.0).OR.
     1					(RDER(IS, 666).GT.388.0) ).AND.
     2					(RDER(IS, 666).GT.-9000.0)) THEN
 				CALL ISETFLG(RDER(IS, 666), 2)
			ELSE

C				The derived data is within the limits then 
C				set the flag to that of the raw data. If the 
C				data is -9999.0 the flag will be three.
			 	CALL ISETFLG(RDER(IS, 666), IFLAG) 
	   		ENDIF	

		END DO
        ELSE

C		The data has not got the right frequency.
		RDER(1, 666)=-9999.0
		CALL ISETFLG(RDER(1,666),3)
	ENDIF
	
c	Calibrate the ambient temp - DRS parameter 73, sample rate 1 Hz. This 
c	is to be turned into Kelvin. This uses the elements of RCONST from 12
C	to 16
	IF (IFRQ(73).EQ.1) THEN  ! check the frequency.
		DO IS=1, IFRQ(73)  ! Do for each sample.

C			See if all the const are there, if not set the flag to 3
		       	ICHECK=1
			DO I=12,16
				IF (ITSTFLG(RCONST(I)).GT.2) THEN
					ICHECK=ICHECK+1
				END IF
                        END DO
			
C			ICHECK will be more than one if any of the constants 
C			are missing. 
			IF (ICHECK.EQ.1) THEN
C				IFLAG=ITSTFLG(IRAW(IS, 73))
				IFLAG=0
			ELSE
				IFLAG=3
			END IF
     				
C			If the flag of the raw data is less than three, then 
C			convert the raw data into derived data. This is done 
C			using a polynomial fit.
	       	       	IF (IFLAG.LT.3) THEN
	        	        RAW=FLOAT(IRAW(IS,73).AND.'FFF'X)
		     		RDER(IS, 667)=RCONST(12)

				DO INC=13,16
					RDER(IS, 667)=RDER(IS, 667)+
     1						      RCONST(INC)*
     2						      (RAW**(INC-12))
      		   		END DO
	     		ELSE

C				If the flag is three or above, set the 
C				derived data to -9999.0.
				RDER(IS, 667)=-9999.0
	
			END IF

C			If the derived data is outside the bounds but not 
C			-9999.0, then set the flag to two.
	     		IF (((RDER(IS, 667).LT.289.0).OR.
     1					(RDER(IS, 667).GT.343.0)).AND.
     2					(RDER(IS, 667).GT.-9000.0)) THEN
	    			CALL ISETFLG(RDER(IS, 667), 2)
	      		ELSE

C				The derived data is within the limits then 
C				set the flag to that of the raw data. If the 
C				data is -9999.0 the flag will be three.
			 	CALL ISETFLG(RDER(IS, 667), IFLAG) 
	  		ENDIF	

		END DO
        ELSE

C		The data has not got the right frequency.
		RDER(1, 667)=-9999.0
		CALL ISETFLG(RDER(1,667),3)
	ENDIF

C	Calibrate the source temp - DRS parameter 74, sample rate 1 Hz. This 
C	will be in Kelvin.This uses the elements of RCONST from 17 to 22.
	IF (IFRQ(74).EQ.1) THEN  ! check the frequency.
		DO IS=1, IFRQ(74)  ! Do for each sample.

C			See if all the const are there, if not set the flag to 3
			ICHECK=1
			DO I=17,22
				IF (ITSTFLG(RCONST(I)).GT.2) THEN
					ICHECK=ICHECK+1
				END IF
                        END DO
			
C			ICHECK will be more than one if any of the constants 
C			are missing. 
			IF (ICHECK.EQ.1) THEN
C				IFLAG=ITSTFLG(IRAW(IS, 74))
				IFLAG=0
			ELSE
				IFLAG=3
			END IF

C			If the flag of the raw data is less than three, then 
C			convert the raw data into derived data. This is done 
C			using a polynomial fit.
       	      		IF (IFLAG.LT.3) THEN
	        	        RAW=FLOAT(IRAW(IS,74).AND.'FFF'X)
		  		RDER(IS, 668)=RCONST(17)
		
				DO INC=18,22
					RDER(IS, 668)=RDER(IS, 668)+
     1					     	      RCONST(INC)*		
     2						      (RAW**(INC-17))
      		   		END DO
	     		ELSE

C				If the flag is three or above, set the 
C				derived data to -9999.0.
				RDER(IS, 668)=-9999.0
	      		END IF

C			If the derived data is outside the bounds but not 
C			-9999.0, then set the flag to two.
	      		IF (((RDER(IS, 668).LT.378.0).OR.
     1					(RDER(IS, 668).GT.393.0)).AND.
     2					(RDER(IS, 668).GT.-9000.0)) THEN
	     			CALL ISETFLG(RDER(IS, 668), 2)
	       		ELSE

C				The derived data is within the limits then 
C				set the flag to that of the raw data. If the 
C				data is -9999.0 the flag will be three.
			 	CALL ISETFLG(RDER(IS, 668), IFLAG) 
	  		ENDIF	

 		END DO
        ELSE

C		The data has not got the right frequency.
		RDER(1, 668)=-9999.0
		CALL ISETFLG(RDER(1,668),3)
	ENDIF
	
C	Calibrate the evaporator current 1- DRS parameter 75, sample rate 1 Hz
C	If it is a modified probe, ie there are four constants in the flight
C	constants file for the CALHTR1 keyword, then parameter 173 is also used.
C	This will be in amps. This uses the elements of RCONST from 23 to 26.
	IF (IFRQ(75).EQ.1) THEN  ! check the frequency.
		DO IS=1, IFRQ(75)  ! Do for each sample.

C			See if all the const are there, if not set the flag to 3
   			ICHECK=1
			DO I=23,26
				IF (ITSTFLG(RCONST(I)).GT.2) THEN
					ICHECK=ICHECK+1
				END IF
                        END DO
			
C			ICHECK will be more than one if any of the constants 
C			are missing. 
			IF (ICHECK.EQ.1.OR.ICHECK.EQ.3) THEN
C				IFLAG=ITSTFLG(IRAW(IS, 75))
				IFLAG=0
			ELSE
				IFLAG=3
			END IF
     				
C			If the flag of the raw data is less than three, then 
C			convert the raw data into derived data. This is done 
C			using a polynomial fit.
	       	       	IF (IFLAG.LT.3) THEN
				RAW=FLOAT(IRAW(IS,75).AND.'FFF'X)
				IF(ICHECK.EQ.1) THEN !It is a modified probe
				  RAW2=FLOAT(IRAW(IS,173).AND.'FFF'X)
				  RDER(IS, 669)=RCONST(23)+(RCONST(24)*RAW2)
     1				      +RCONST(25)*(RAW+RCONST(26))
				ELSE                 !It is an unmodified probe
				  RDER(IS, 669)=RCONST(23)+RCONST(24)*RAW
				END IF
	     		ELSE

C				If the flag is three or above, set the 
C				derived data to -9999.0.
				RDER(IS, 669)=-9999.0
	 		END IF

C			If the derived data is outside the bounds but not 
C			-9999.0, then set the flag to two.
	       		IF (((RDER(IS, 669).LT.0.3).OR.
     1					(RDER(IS, 669).GT.6.6)).AND.
     2					(RDER(IS, 669).GT.-9000.0)) THEN
	  			CALL ISETFLG(RDER(IS, 669), 2)
	  		ELSE

C				The derived data is within the limits then 
C				set the flag to that of the raw data. If the 
C				data is -9999.0 the flag will be three.
			 	CALL ISETFLG(RDER(IS, 669), IFLAG) 
	 		ENDIF	

		END DO
        ELSE

C		The data has not got the right frequency.
		RDER(1, 669)=-9999.0
		CALL ISETFLG(RDER(1,669),3)
	ENDIF

C	Calibrate the evaporator current 2- DRS parameter 76, sample rate 1Hz.
C	If it is a modified probe, ie there are four constants in the flight
C	constants file for the CALHTR2 keyword, then parameter 174 is also used.
C	This will be in amps. This uses the elements of RCONST from 27 to 30.
	IF (IFRQ(76).EQ.1) THEN  ! check the frequency.
		DO IS=1, IFRQ(76)  ! Do for each sample.

C			See if all the const are there, if not set the flag to 3
		      	ICHECK=1
			DO I=27,30
				IF (ITSTFLG(RCONST(I)).GT.2) THEN
					ICHECK=ICHECK+1
				END IF
                        END DO
			
C			ICHECK will be more than one if any of the constants 
C			are missing. 
			IF (ICHECK.EQ.1.OR.ICHECK.EQ.3) THEN
C				IFLAG=ITSTFLG(IRAW(IS, 76))
				IFLAG=0
			ELSE
				IFLAG=3
			END IF
     				
C			If the flag of the raw data is less than three, then 
C			convert the raw data into derived data. This is done 
C			using a polynomial fit.
	       	       	IF (IFLAG.LT.3) THEN
				RAW=FLOAT(IRAW(IS,76).AND.'FFF'X)
				IF(ICHECK.EQ.1) THEN !It is a modified probe
				  RAW2=FLOAT(IRAW(IS,174).AND.'FFF'X)
				  RDER(IS, 670)=RCONST(27)+(RCONST(28)*RAW2)
     1				      +RCONST(29)*(RAW+RCONST(30))
				ELSE                 !It is an unmodified probe
				  RDER(IS, 670)=RCONST(27)+RCONST(28)*RAW
				END IF
	     		ELSE

C				If the flag is three or above, set the 
C				derived data to -9999.0.
				RDER(IS, 670)=-9999.0
       			END IF

C			If the derived data is outside the bounds but not 
C			-9999.0, then set the flag to two.
			IF (((RDER(IS, 670).LT.0.3).OR.
     1					(RDER(IS, 670).GT.6.6)).AND.
     2					(RDER(IS, 670).GT.-9000.0)) THEN
				CALL ISETFLG(RDER(IS, 670), 2)
	    		ELSE

C				The derived data is within the limits then 
C				set the flag to that of the raw data. If the 
C				data is -9999.0 the flag will be three.
			 	CALL ISETFLG(RDER(IS, 670), IFLAG) 
	   		ENDIF	

		END DO
        ELSE

C   		The data has not got the right frequency.
		RDER(1, 670)=-9999.0
		CALL ISETFLG(RDER(1,670),3)
	ENDIF

C	Calibrate the source current - DRS parameter 77, sample rate 1 Hz. 
C	This will be in amps. This uses the elements of RCONST from 31 to 32.
	IF (IFRQ(77).EQ.1) THEN  ! check the frequency.
		DO IS=1, IFRQ(77)  ! Do for each sample.

C			See if all the const are there, if not set the flag to 3
			ICHECK=1
			DO I=31,32
				IF (ITSTFLG(RCONST(I)).GT.2) THEN
					ICHECK=ICHECK+1
				END IF
                        END DO
			
C			ICHECK will be more than one if any of the constants 
C			are missing. 
			IF (ICHECK.EQ.1) THEN
C				IFLAG=ITSTFLG(IRAW(IS, 77))
				IFLAG=0
			ELSE
				IFLAG=3
			END IF
     				
C			If the flag of the raw data is less than three, then 
C			convert the raw data into derived data. This is done 
C			using a polynomial fit.
	       	        IF (IFLAG.LT.3) THEN
	        	        RAW=FLOAT(IRAW(IS,77).AND.'FFF'X)
		      		RDER(IS, 671)=(RCONST(31)+RCONST(32)*
     1					       RAW)
	     		ELSE

C			If the flag is three or above, set the derived data 
C			to -9999.0. 
				RDER(IS, 671)=-9999.0
	  		END IF

C			If the derived data is outside the bounds but not 
C			-9999.0, then set the flag to two.
	   		IF (((RDER(IS, 671).GT.-0.4E-03).OR.
     1 					(RDER(IS, 671).LT.-1.1E-03)).AND.
     2					(RDER(IS, 671).GT.-9000.0)) THEN
				CALL ISETFLG(RDER(IS, 671), 2)
	  		ELSE

C				The derived data is within the limits then 
C				set the flag to that of the raw data. If the 
C				data is -9999.0 the flag will be three.
			 	CALL ISETFLG(RDER(IS, 671), IFLAG) 
	       		ENDIF	

		END DO
        ELSE

C		The data has not got the right frequency.
		RDER(1, 671)=-9999.0
		CALL ISETFLG(RDER(1,671),3)
	ENDIF

C	Calibrate the status word - DRS parameter 78, sample rate 1 Hz. This 
C	will be in raw data.
	IF (IFRQ(78).EQ.1) THEN ! check the frequency.
		DO IS=1, IFRQ(78) ! Do for each sample.

C			If the raw data is inside the bounds, process it.
			IF (((IRAW(IS, 78).AND.'FFF'X).GT.0).OR.
     1					((IRAW(IS,78).AND.'FFF'X).LT.4094)) 
     2								THEN
C				IFLAG=ITSTFLG(IRAW(IS, 78))
				IFLAG=0
               
C				If the flag of the raw data is less than 
C				three, then convert the raw data into derived
C				data.
	 			IF (IFLAG.LT.3) THEN
					RDER(IS, 672)=FLOAT(IRAW(IS,78)
     1 						      .AND.'FFF'X)
	     			ELSE

C 					If the flag is three or above, set the
C					derived data to -9999.0.
					RDER(IS, 672)=-9999.0
	 	  		END IF
            		ENDIF
               
C			If the derived data is outside the bounds of 0 and 
C			4095, set the flag to two.
	       		IF (((RDER(IS, 672).LT.0.0).OR.
     1 					(RDER(IS, 672).GT.4095)).AND.
     2					(RDER(IS, 672).GT.-9000.0)) THEN
		  		CALL ISETFLG(RDER(IS, 672), 2) 
	    		ELSE

C				If the derived data is within the bounds of 0
C				and 4095, then set the flag to that of the raw
C				data's.
				CALL ISETFLG(RDER(IS, 672), IFLAG) 
	   		END IF
                                                 
     		END DO
        ELSE

C 		If the wrong frequency is there for the status, then set all
C		the samples for this second to -9999.0, with their flags set 
C		to 3.
		RDER(1, 672)=-9999.0
		CALL ISETFLG(RDER(1,672),3)
	ENDIF

C	Check the rate of change for parametrs 665 to 671
	TIME=ABS(RDER(1, 515)-OLD_TIME)

C	If the time has been incremented by more than one, store the
C	parameters, and return.
	IF ((TIME.gt.1.1).or.(ITSTFLG(RDER(1,515)).GT.2)) THEN
		DO INC=665, 671
			OLD_PARAS(INC-664)=RDER(1, INC)
		END DO
	
		OLD_TIME=RDER(1, 515)
		RETURN
	END IF
	
	DO INC=665, 671           
C		Only bother with a parameter that is inside its bounds.
		IF (ITSTFLG(RDER(1,INC)).LT.2) THEN
			CHANGE=OLD_PARAS(INC-664)-RDER(1, INC)

C			Check the differnce of the old and new value against
C			the stored value in the array RATE_CHANGE.
			IF (ABS(CHANGE).GT.RATE_CHANGE(INC-664)) THEN
				CALL ISETFLG(RDER(1, INC), 2)
	    		END IF
		END IF
	END DO 

C	Store away the parameters
	DO INC=665, 671
		OLD_PARAS(INC-664)=RDER(1, INC)
	END DO
	
C	Store away the time.
	OLD_TIME=RDER(1, 515)

	RETURN

	END

c_winds.for

C
C ROUTINE          C_WINDS SUBROUTINE FORTVAX
C
C PURPOSE          Computes raw winds from TAS, vanes, and INS data
C
C DESCRIPTION      Computes values of the three wind components, using true
C                  airspeed, angle of attack and sideslip, and INS velocity,
C                  attitude, and attitude rate information. Note that at this
C                  stage the INS data have not been corrected for drift, so
C                  these are 'raw' winds, which will normally be corrected
C                  later as part of the interactive renavigation processing. 
C                  Once errors have been evaluated for the three INS velocity
C                  components, they can be applied directly to the three wind
C                  components; the wind components do not need to be recomputed 
C                  from scratch.  To show that the winds are 'raw' all values
C                  of U, V and W are increased by 1000 m/s by this routine.  
C                  This makes it easy to see that normal (flagged 0 or 1) data
C                  are 'raw', but it may not be enough to say unabiguously 
C                  whether data that are already bad (flagged 2 or 3) are 'raw'
C                  or 'corrected'.
C
C                  The processing will handle the case that the INS is mounted
C                  off the boom axis, provided its position is specified in
C                  the flight constants file, using the INSPOSN keyword.  If
C                  the INS position is not specified then it is assumed to be
C                  in the nose bay, 7.06m behind the vanes, but on the axis of
C                  the boom.  All data is assumed to be at 32 Hz.
C                  
C                  This routine will not be called if there is no True
C                  Airspeed, or no INS information (with the exception of roll
C                  rate).  If there is no information from the angle of attack
C                  and sideslip vanes, winds will be computed using values of
C                  zero for these angles flagged with
C                  1's.  If there is no roll rate available (this wasn't
C                  recorded for the Ferranti 1012 INS), a value of 0 is used. 
C                  This doesn't matter if the INS is located on the boom axis,
C                  since in this case roll rate has no effect on winds.
C                  
C                  The output vertical wind takes the worst flag present on the
C                  AOA, VZ, TAS and pitch data.  The output horizontal wind
C                  components take the worst flag present on the AOSS, VN, VE,
C                  TAS, and heading data.  This is suitable when the
C                  aircraft is not banking and reflects the fact that good
C                  horizontal winds can be found even when the vertical
C                  velocity is bad.  However this flagging scheme fails to 
C                  reflect coupling between the vertical and horizontal
C                  measurement when the aircraft is banking.
C                  In addition horizontal wind components greater
C                  than 100 m/s and vertical components greater than 25 m/s
C                  are flagged with 2's, and if the change between adjacent
C                  samples (at 32 Hz) is greater than 1 m/s a flag of 2 is
C                  also applied.
C
C                  Input parameters (all at 32 Hz except 515):
C
C                  Para 515   Time, secs
C                  Para 779   Turb.probe dry true airspeed, m s-1
C                  Para 548   Angle of attack, deg
C                  Para 549   Angle of side slip, deg
C                  Para 558   INS velocity north, m s-1
C                  Para 559   INS velocity east, m s-1
C                  Para 557   INS vertical velocity, m s-1
C                  Para 560   INS roll, deg
C                  Para 561   INS pitch, deg
C                  Para 562   INS heading, deg
C                  Para 567   INS roll rate, deg s-1 (optional)
C                  Para 565   INS pitch rate, deg s-1
C                  Para 566   INS yaw rate, deg s-1
C
C                  Constants:
C
C                  RCONST(1)  Distance of vanes ahead of INS, m (optional)
C                  RCONST(2)  Distance of vanes to port of INS, m (optional)
C                  RCONST(3)  Distance of vanes above INS, m (optional)
C
C                  Output parameters (all at 32 Hz):
C
C                  Para 714   Northward wind component + 1000, m s-1
C                  Para 715   Eastward wind component + 1000, m s-1
C                  Para 716   Vertical wind component + 1000, m s-1
C            
C VERSION          1.00  10-5-93  W.D.N.JACKSON
C
C ARGUMENTS        IRAW(64,512) I*4 IN  Up to 64 samples for up to 512 DRS pars
C                  IFRQ(512)    I*4 IN  Sample rate of each DRS par (0-64)
C                  RCONST(64)   R*4 IN  Inputs constants
C                  RDER(64,1024)R*4 OUT Output array of up to 64 samples for
C                                       each of 1024 parameters
C
C CHANGES          1.01  20-04-98 W.D.N.JACKSON
C                  Error in computation of airspeed corrected. 
C                  1.02  14-06-2004 Phil Brown
C                  AoA and AoSS now compulsory input parameters to ensure
C                  this routine gets called after C_TURB
C                  1.03  09/07/04 Phil Brown
C                  Input TAS parameter is now 779 (Turb.probe dry TAS)
C                  1.04  25/08/04 Phil Brown
C                  Temporary. Suspend rate-of-change checking on winds.
C                  1.05  29/11/04 Phil Brown
C                  Temporary. Check flagging of RU,RV,RW when returned to try
C                  to suppress FLTINV errors.
C
********************************************************************************
      SUBROUTINE C_WINDS(IRAW,IFRQ,RCONST,RDER)
CDEC$ IDENT 'V1.04'
      INTEGER*4 IRAW(64,512)      !Raw data array
      INTEGER*4 IFRQ(512)         !Raw data frequency
      REAL*4    RCONST(64)        !Constants array
      REAL*4    RDER(64,1024)     !Derived data array
C
C This routine uses the following parameters (note that the absence of AOA,
C AOSS or roll rate will not stop C_WINDS from being called).  All parameters,
C except time, are at 32 Hz:
C
      PARAMETER GMT=515                !Time, secs
      PARAMETER TAS=779                !True airspeed, m s-1
      PARAMETER AOA=548                !Angle of attack, deg
      PARAMETER AOS=549                !Angle of side slip, deg
      PARAMETER VN=558                 !INS velocity north, m s-1
      PARAMETER VE=559                 !INS velocity east, m s-1
      PARAMETER VZ=557                 !INS vertical velocity, m s-1
      PARAMETER ROL=560                !INS roll, deg
      PARAMETER PIT=561                !INS pitch, deg
      PARAMETER HDG=562                !INS heading, deg
      PARAMETER ROLR=567               !INS roll rate, deg s-1 (optional)
      PARAMETER PITR=565               !INS pitch rate, deg s-1
      PARAMETER YAWR=566               !INS yaw rate, deg s-1
C
C This routine takes three constants from the RCONST array.  They are
C all optional and if not specified will be defaulted to the position of the
C H423 INU on the 146 Core Console (16.002,-0.8128,-0.4390 m).
C
      PARAMETER PL=1                   !Const dist of vanes ahead of INS
      PARAMETER PM=2                   !Const dist of vanes to port of INS
      PARAMETER PN=3                   !Const dist of vanes above INS
C
C This routine computes the following parameters, all at 32 Hz:
C Note that TARDIS conventially labels parameter 714, Northerly component, as V
C and parameter 715, Easterly component, as U.
C
      PARAMETER U=714                  !Northward wind component, m s-1
      PARAMETER V=715                  !Eastward wind component, m s-1
      PARAMETER W=716                  !Vertical wind component, m s-1
C
C Set LFLAG to false if you want to treat all data as unflagged.
C
      DATA LFLAG   /.TRUE./           !Set false if want to ignore flagging

      DATA RLSTSEC /-2.0/              !Initial dummy value for last sec processed

      RDEFAOA=0.0                      !If not specified AOA is 0.0 flagged 1
      CALL ISETFLG(RDEFAOA,1)
      RDEFAOS=RDEFAOA                  !If not specified AOSS is 0.0 flagged 1

      IF(.NOT.LFLAG) THEN              !Ignore flagging
        DO I=1,32                      !For each sample in second
          CALL C_WINDS_UVW(RDER(I,TAS),RDER(I,AOA),RDER(I,AOS),
     -        RDER(I,VN),RDER(I,VE),RDER(I,VZ),
     -        RDER(I,HDG),RDER(I,PIT),RDER(I,ROL),
     -        RCONST(PL),RCONST(PM),RCONST(PN),
     -        RDER(I,YAWR),RDER(I,PITR),RDER(I,ROLR),
     -        RDER(I,U),RDER(I,V),RDER(I,W))
        END DO
      ELSE                             !Apply flags
        RL=RCONST(PL)                  !Get the INS position offsets
        RM=RCONST(PM)
        RN=RCONST(PN)
        IF(ITSTFLG(RL).GE.2) RL=16.002 !Use default values if not available
        IF(ITSTFLG(RM).GE.2) RM=-0.8128
        IF(ITSTFLG(RN).GE.2) RN=-0.4390
        LCONSEQ=.FALSE.                !Will set true if this is next second
        IF(RDER(1,GMT).EQ.RLSTSEC+1.0) LCONSEQ=.TRUE.
        RLSTSEC=RDER(1,GMT)            !Save current time
        DO I=1,32                      !For each sample in second
          RTAS=RDER(I,TAS)             !Get the input values
          RAOA=RDER(I,AOA)
          RAOS=RDER(I,AOS)
          RVN=RDER(I,VN)
          RVE=RDER(I,VE)
          RVZ=RDER(I,VZ)
          RHDG=RDER(I,HDG)
          RPIT=RDER(I,PIT)
          RROL=RDER(I,ROL)
          RYAWR=RDER(I,YAWR)
          RPITR=RDER(I,PITR)
          RROLR=RDER(I,ROLR)
          IF(ITSTFLG(RAOA).GE.2) RAOA=RDEFAOA !Set AOA to 0 if missing
          IF(ITSTFLG(RAOS).GE.2) RAOS=RDEFAOS !Set AOSS to 0 if missing
          IF(ITSTFLG(RROLR).GE.2) RROLR=0.0   !Set roll rate to 0 if missing
          IHFLAG=MAX(ITSTFLG(RTAS),ITSTFLG(RAOS), !Compute worst horiz flag
     -        ITSTFLG(RVN),ITSTFLG(RVE),ITSTFLG(RHDG))
          IWFLAG=MAX(ITSTFLG(RTAS),ITSTFLG(RAOA), !Compute worst vert flag
     -        ITSTFLG(RVZ),ITSTFLG(RPIT))
          CALL ISETFLG(RTAS,0)         !Clear any flags before computation
          CALL ISETFLG(RAOA,0)
          CALL ISETFLG(RAOS,0)
          CALL ISETFLG(RVN,0)
          CALL ISETFLG(RVE,0)
          CALL ISETFLG(RVZ,0)
          CALL ISETFLG(RHDG,0)
          CALL ISETFLG(RPIT,0)
          CALL ISETFLG(RROL,0)
          CALL ISETFLG(RYAWR,0)
          CALL ISETFLG(RPITR,0)
          CALL ISETFLG(RROLR,0)
          CALL C_WINDS_UVW(RTAS,RAOA,RAOS,RVN,RVE,RVZ,RHDG,RPIT,RROL,
     -        RL,RM,RN,RYAWR,RPITR,RROLR,RU,RV,RW) !Compute wind components
          IUFLAG=IHFLAG                !Propagate worst case flag for each comp
          IVFLAG=IHFLAG
          IF(ABS(RU).GT.100.0) IUFLAG=MAX(IUFLAG,2) !Flag if out of range
          IF(ABS(RV).GT.100.0) IVFLAG=MAX(IVFLAG,2)
          IF(ABS(RW).GT.25.0) IWFLAG=MAX(IWFLAG,2)
          CALL ISETFLG(RU, 0)          ! ensure winds have zero flag
          CALL ISETFLG(RV, 0)
          CALL ISETFLG(RW, 0)
          RU=RU+1000.                  !Add offset to show winds are 'raw'
          RV=RV+1000.
          RW=RW+1000.

C suspend rate-of-change checks.
C          IF(ITSTFLG(RLSTU).EQ.0.AND.LCONSEQ.AND.ABS(RLSTU-RU).GT.1.0)
C     -        IUFLAG=MAX(IUFLAG,2)     !Flag if rate of change too high
C          IF(ITSTFLG(RLSTV).EQ.0.AND.LCONSEQ.AND.ABS(RLSTV-RV).GT.1.0)
C     -        IVFLAG=MAX(IVFLAG,2)
C          IF(ITSTFLG(RLSTW).EQ.0.AND.LCONSEQ.AND.ABS(RLSTW-RW).GT.1.0)
C     -        IWFLAG=MAX(IWFLAG,2)

          CALL ISETFLG(RU,IUFLAG)      !Apply flags to result
          CALL ISETFLG(RV,IVFLAG)
          CALL ISETFLG(RW,IWFLAG)
          RDER(I,U)=RU                 !Transfer results to output array
          RDER(I,V)=RV
          RDER(I,W)=RW
          RLSTU=RU                     !Save latest values
          RLSTV=RV
          RLSTW=RW
          LCONSEQ=.TRUE.               !Further samples in second are consequetve
        END DO
      END IF
      RETURN
      END
********************************************************************************
C
C SUBROUTINE C_WINDS_UVW
C
C Computes the three wind components, using INS velocities, attitudes,
C attitude rates, vanes location, true airspeed, and angles of attack and
C sideslip.  All data are treated as unflagged real by 4 numbers.
C
C Arguments (all R*4) - no input arguments are changed:
C
C  RTAS   In  True airspeed (m/s)
C  RAOA   In  Angle of attack (deg, +ve when vane points down)
C  RAOS   In  Angle of attack (deg, +ve when vane points to left)
C  RVN    In  INS aircraft velocity component northwards (m/s, +ve when to N)
C  RVE    In  INS aircraft velocity component eastwards (m/s, +ve when to E)
C  RVZ    In  INS aircraft verical velocity component (m/s, +ve when up)
C  RHDG   In  INS aircraft heading (deg, +ve when left wing forward)
C  RPIT   In  INS aircraft pitch (deg, +ve when nose is up)
C  RROL   In  INS aircraft roll (deg, +ve left wing up)
C  RL     In  Distance of vanes/nose from INS (m, +ve when nose ahead)
C  RM     In  Distance of the vanes/nose from the INS (m, +ve when nose to port)
C  RN     In  Distance of the vanes/nose from the INS (m, +ve when nose above)
C  RYAWR  In  Yaw rate (deg/s, +ve when left wind moving ahead)
C  RPITR  In  Pitch rate (deg/s, +ve when nose moving up)
C  RROLR  In  Roll rate (deg/s, +ve when left wing moving up)
C  RU     Out Wind component Northwards (m/s)
C  RV     Out Wind component Eastwards (m/s)
C  RW     Out Wind component Upwards (m/s)
C
C Derives winds using the following matrix formulation of the wind equations:
C
C (U)              (-U'      ) (VN) [( 0 )    (0  )         (r')]            (l)
C (V) = (A3.A2).A1.(-U'tan(b))+(VW)+[( 0 )+A3.(-t')+(A3.A2).(0 )]x(A3.A2).A1.(m)
C (W)              ( U'tan(a)) (VZ) [(-p')    (0  )         (0 )]            (n)
C
C where U' = TAS / (1+ tan(b)^2 + tan(a)^2)^(1/2), b is angle of sideslip, a is
C angle of attack, p' is heading rate, t' is pitch rate, r' is roll rate, l m 
C and n are the position of the vanes and nose with respect to the INS (l +ve 
C forwards, m +ve to port, n +ve up), U is wind component northwards, V is wind 
C component westwards, W is wind component upwards, VN is aircraft velocity 
C northwards, VW is aircraft velocity westwards, VZ is aircraft velocity 
Cupwards, and
C
C    (1  0       0    )     (cos(t) 0 -sin(t))     ( cos(p) sin(p) 0)
C A1=(0 cos(r) -sin(r))  A2=( 0     1   0    )  A3=(-sin(p) cos(p) 0)
C    (0 sin(r)  cos(r))     (sin(t) 0  cos(t))     (  0      0     1)
C
C where r is roll, t is pitch, and p is heading.
C
C This is simpler to use than explicit wind component equations when the INS
C is off the aircraft axis.  Comparisons of the wind components derived by this
C subroutine with those derived by the normal wind equations, as used in 
C C_INS_WINDS, show no differences greater than 2E-5 m/s.  However direct use
C of the wind equations is about 30% faster.
C
C Ref: MRF Internal Note No 8 - 'The measurement of flight level winds and 
C aircraft position by the MRF Hercules' by S. Nicholls, together with
C additional notes by W.D.N.Jackson, February 1993, which extend the
C analysis to cases where the INS is off axis and derives the matrix equation
C used here.
C
C V1.00  15/03/93  W.D.N.JACKSON
C V1.01  20/04/98  W.D.N.JACKSON
C        Error in formulation of Axford/Nicholls/Jackson equations when
C        computing airspeed corrected.  (See note by R Wood and G W Inverarity)
C
      SUBROUTINE C_WINDS_UVW(RTAS,RAOA,RAOS,RVN,RVE,RVZ,RHDG,RPIT,RROL,
     -    RL,RM,RN,RYAWR,RPITR,RROLR,RU,RV,RW)
CDEC$ IDENT 'V1.01'
      REAL*4 RP(3)                     !Vanes posn wrt to INS, fore, port & up
      REAL*4 RWIND(3)                  !The 3 computed wind comps Un, Vw and Wu
      REAL*4 RVG(3)                    !INS VN, VW and VZ
      REAL*4 RA1(3,3)                  !Transformation matrix about roll axis
      REAL*4 RA2(3,3)                  !Transformation matrix about pitch axis
      REAL*4 RA3(3,3)                  !Transformation matrix about heading axis
      REAL*4 RT(3,3)                   !Full transformation matrix
      REAL*4 RTMP(3,3)                 !Temporary matrix store
      REAL*4 RUA(3)                    !Airflow vector in a/c frame
      REAL*4 RYR(3)                    !Yaw rate vector
      REAL*4 RPR(3)                    !Pitch rate vector
      REAL*4 RRR(3)                    !Roll rate vector
      REAL*4 RTEMP(3)                  !Temporary vector store

      RA1(1,1)=1.                      !Define roll transformation matrix
      RA1(1,2)=0.
      RA1(1,3)=0.
      RA1(2,1)=0.
      RA1(2,2)=COSD(RROL)
      RA1(2,3)=-SIND(RROL)
      RA1(3,1)=0.
      RA1(3,2)=-RA1(2,3)
      RA1(3,3)=RA1(2,2)

      RA2(1,1)=COSD(RPIT)              !Define pitch transformation matrix
      RA2(1,2)=0.
      RA2(1,3)=-SIND(RPIT)
      RA2(2,1)=0.
      RA2(2,2)=1.
      RA2(2,3)=0.
      RA2(3,1)=-RA2(1,3)
      RA2(3,2)=0.
      RA2(3,3)=RA2(1,1)

      RA3(1,1)=COSD(RHDG)              !Define heading transformation matrix
      RA3(1,2)=SIND(RHDG)
      RA3(1,3)=0.
      RA3(2,1)=-RA3(1,2)
      RA3(2,2)=RA3(1,1)
      RA3(2,3)=0.
      RA3(3,1)=0.
      RA3(3,2)=0.
      RA3(3,3)=1.

!      PRINT *,'RTAS/AOA/AOSS =',RTAS,RAOA,RAOS

      TANAOS=TAND(RAOS)                !Define airspeed vector
      TANAOA=TAND(RAOA)
      D=SQRT(1.0+TANAOS*TANAOS+TANAOA*TANAOA)
      RUA(1)=-RTAS/D
      RUA(2)=-RTAS*TANAOS/D
      RUA(3)=RTAS*TANAOA/D

      RP(1)=RL                         !Define INS offset vector
      RP(2)=RM
      RP(3)=RN

      RVG(1)=RVN                       !Define INS velocity vector
      RVG(2)=-RVE                      !Matrix eqn requires VW
      RVG(3)=RVZ

      RYR(1)=0.                        !Define yaw rate vector
      RYR(2)=0.
      RYR(3)=-RYAWR*3.14159/180.       !Convert to rad/s

      RPR(1)=0.                        !Define pitch rate vector
      RPR(2)=-RPITR*3.14159/180.       !Convert to rad/s
      RPR(3)=0.

      RRR(1)=RROLR*3.14159/180.        !Define roll rate vector in rad/s
      RRR(2)=0.
      RRR(3)=0.

      RWIND(1)=0.                      !Clear wind vector
      RWIND(2)=0.
      RWIND(3)=0.

      CALL C_WINDS_MULM(RA3,RA2,RTMP)  !Compute full transformation vector
      CALL C_WINDS_MULM(RTMP,RA1,RT)      
      CALL C_WINDS_MATV(RT,RUA,RUA)    !Transform airspeed to ground frame
      CALL C_WINDS_VADD(RUA,RWIND,RWIND) !This is first wind component
      CALL C_WINDS_VADD(RVG,RWIND,RWIND) !Add ground speed component
      CALL C_WINDS_MATV(RT,RP,RP)      !Transform INS offset to ground frame
      CALL C_WINDS_MULM(RA3,RA2,RTMP)  !Transfm roll rate effects to ground fram
      CALL C_WINDS_MATV(RTMP,RRR,RRR)  !Compute roll rate effects
      CALL C_WINDS_MATV(RA3,RPR,RTEMP) !Transfm pitch rate effects to ground frm
      CALL C_WINDS_VADD(RRR,RTEMP,RTEMP) !Add pitch rate effects
      CALL C_WINDS_VADD(RYR,RTEMP,RTEMP) !Add yaw rate effects to get full effect
      CALL C_WINDS_VMUL(RTEMP,RP,RTEMP) !Apply rate effects to INS offset vector
      CALL C_WINDS_VADD(RTEMP,RWIND,RWIND) !This is the last wind component
 
      RU=RWIND(1)                      !Transfer result to output arguments
      RV=-RWIND(2)                     !Convert westwards to eastwards
      RW=RWIND(3)

      RETURN
      END
********************************************************************************
      SUBROUTINE C_WINDS_MULM(A,B,C)
C
C Applies the 3x3 matrix A to the 3x3 matrix B, and leaves the result in C
C which may be the same as A or B.
C
C V1.00  15/03/93  W.D.N.JACKSON
C
CDEC$ IDENT 'V1.00'
      REAL*4 A(3,3),B(3,3),C(3,3),T(3,3)
      T(1,1)=A(1,1)*B(1,1)+A(1,2)*B(2,1)+A(1,3)*B(3,1)
      T(1,2)=A(1,1)*B(1,2)+A(1,2)*B(2,2)+A(1,3)*B(3,2)
      T(1,3)=A(1,1)*B(1,3)+A(1,2)*B(2,3)+A(1,3)*B(3,3)
      T(2,1)=A(2,1)*B(1,1)+A(2,2)*B(2,1)+A(2,3)*B(3,1)
      T(2,2)=A(2,1)*B(1,2)+A(2,2)*B(2,2)+A(2,3)*B(3,2)
      T(2,3)=A(2,1)*B(1,3)+A(2,2)*B(2,3)+A(2,3)*B(3,3)
      T(3,1)=A(3,1)*B(1,1)+A(3,2)*B(2,1)+A(3,3)*B(3,1)
      T(3,2)=A(3,1)*B(1,2)+A(3,2)*B(2,2)+A(3,3)*B(3,2)
      T(3,3)=A(3,1)*B(1,3)+A(3,2)*B(2,3)+A(3,3)*B(3,3)
      DO I=1,3
        DO J=1,3
          C(I,J)=T(I,J)
        END DO
      END DO
      RETURN
      END
********************************************************************************
      SUBROUTINE C_WINDS_MATV(A,B,C)
C
C Applies the 3x3 matrix A to the column vector B, and returns with the result
C in C, which may be the same as B.
C
C V1.00  15/03/93  W.D.N.JACKSON
C
CDEC$ IDENT 'V1.00'
      REAL*4 A(3,3),B(3),C(3),T(3)
      T(1)=A(1,1)*B(1)+A(1,2)*B(2)+A(1,3)*B(3)
      T(2)=A(2,1)*B(1)+A(2,2)*B(2)+A(2,3)*B(3)
      T(3)=A(3,1)*B(1)+A(3,2)*B(2)+A(3,3)*B(3)
      C(1)=T(1)
      C(2)=T(2)
      C(3)=T(3)
      RETURN
      END
********************************************************************************
      SUBROUTINE C_WINDS_VADD(A,B,C)
C
C Adds the 3 element column vector A to column vector B and returns the result
C in C, which can be the same as A or B.
C
C V1.00  15/03/93  W.D.N.JACKSON
C
CDEC$ IDENT 'V1.00'
      REAL*4 A(3),B(3),C(3)
      C(1)=A(1)+B(1)
      C(2)=A(2)+B(2)
      C(3)=A(3)+B(3)
      RETURN
      END
********************************************************************************
      SUBROUTINE C_WINDS_VMUL(A,B,C)    
C
C Multiplies the 3 element column vector A with the column vector B and returns
C the result in C, which can be the same as A or B.
C
C V1.00  15/03/93  W.D.N.JACKSON
C
CDEC$ IDENT 'V1.00'
      REAL*4 A(3),B(3),C(3),T(3)
      T(1)=A(2)*B(3)-A(3)*B(2)
      T(2)=A(3)*B(1)-A(1)*B(3)
      T(3)=A(1)*B(2)-A(2)*B(1)
      C(1)=T(1)
      C(2)=T(2)
      C(3)=T(3)
      RETURN
      END

g_mach.for

C-------------------------------------------------------------------------------
C
C ROUTINE  	   G_MACH      SUBROUTINE FORTVAX                   [G_MACH.FOR]
C     
C PURPOSE 	   COMPUTE MACH  NO. FROM STATIC PRESSURE AND PITOT STATIC.
C
C DESCRIPTION      The two input arguments are Static and Pitot static pressure.
C                  The value of Static pressure is checked to make sure it is 
C                  not zero, to avoid a 'divide-by-zero' error. The division of
C		   Pitot staic pressure by Static pressure is check to make
C		   sure that it is not negative, is so the Mach number is set 
C		   to 0.0.
C                  Computation of the Mach no. 'RMACH' proceeds using the 
C                  formula below.
C                  
C                  RMACH = SQRT( 5.* ((1.+ PITOT/RSTAT)**(2./7.) - 1.)) 
C
C VERSION	   1.00    26-02-92	M.J.Glover
C                                                                  
C ARGUMENTS        RSTAT - R*4 IN    Static pressure       (100 - 1050 mb.)
C                  PITOT - R*4 IN    Pitot static pressure (0   - 125  mb.)
C                  RMACH - R*4 OUT   MACH NO.                 [none ]
C
C SUBPROGRAMS  	   None.
C
C REFERENCES 	   Code adapted from SCILIB:S_MACH
C
C CHANGES          None.
C                  
C------------------------------------------------------------------------------

	SUBROUTINE G_MACH (RSTAT,PITOT,RMACH)
CDEC$ IDENT 'V1.00'
C
	IMPLICIT NONE

	INTEGER*4  IFLAG

	REAL*4     RSTAT,PITOT,RMACH ,SRSTAT,SPITOT

C------------------------------------------------------------------------------

      	SPITOT = PITOT                                     !Put input arguments
      	SRSTAT = RSTAT                                     !into placeholders.
	IFLAG = 0

	IF (SRSTAT .EQ. 0 ) THEN                           !Divide-by-zero err?
        	RMACH  = 0.                                !Zero return value
	        RETURN                                     !.. cannot proceed.
      	ENDIF

	IF (SPITOT/SRSTAT .LT.0)IFLAG=3                    !Must be +ve or eqn
                                                           !below will fail.
                                                         
C If flag not fatal, compute Mach no.

  	IF (IFLAG.NE.3 ) THEN                                
        	RMACH = SQRT( 5.* ((1.+ SPITOT/SRSTAT)**(2./7.) - 1.)) 
	ELSE
		RMACH = 0.0                                !Return flagged zero
	ENDIF                                              !if input is invalid

	RETURN

	END

isetflg.for

C
C ROUTINE          ISETFLG SUBROUTINE FORTVAX
C
C PURPOSE          Sets the flag bits in a variable
C
C DESCRIPTION      Flagged values are stored in bits 0 and 1 of a 32 bit
C                  word.  This routine simply sets these bits.  It will work
C                  with either REAL*4 or INTEGER*4 values.
C
C VERSION          1.00  21-12-89  N.JACKSON
C
C ARGUMENTS        IVALUE    R*4 or I*4  IN/OUT   Variable with flag bits 
C                  IFLAG     I*4         IN       Flag value (0-3)
C
C CHANGES          1.01  16-06-05  N.JACKSON
C                  Now sets uses bits 0 and 1 instead of 16 and 17 to match
C                  IEEE S_Floating mantissa.
C
      SUBROUTINE ISETFLG(IVALUE,IFLAG)
CDEC$ IDENT 'V1.01'
C
C The routine masks off bits 0 and 1 (the lowest 2 bits of IVALUE(1)) and
C then sets them with the lowest 2 bits in IFLAG.  IFLAG is masked to 2 bits
C in case an invalid number is sent.
C
      INTEGER*2 IVALUE(2),IFLAG(2)
      IVALUE(1)=(IVALUE(1).AND.'FFFC'X).OR.(IFLAG(1).AND.'0003'X)
      RETURN
      END

itstflg.for

C
C ROUTINE          ITSTFLG FUNCTION FORTVAX
C
C PURPOSE          Returns the flag value of a variable
C
C DESCRIPTION      Flagged values are stored in bits 0 and 1 of a 32 bit
C                  word.  This routine simply extracts these bits and returns
C                  their value.  It will work with either REAL*4 or INTEGER*4
C                  values.
C
C VERSION          1.00  21-12-89  N.JACKSON
C
C ARGUMENTS        IVALUE    R*4 or I*4  IN   Variable with flag bits 
C                  ITSTFLG   I*4         OUT  Flag value (0-3)
C
C CHANGES          1.01  16-06-05  N.JACKSON
C                  Now uses bits 0 and 1 rather than 16 and 17 to match the
C                  IEEE S_Floating mantissa.
C
      INTEGER FUNCTION ITSTFLG(IVALUE)
CDEC$ IDENT 'V1.01'
C
      INTEGER*2 IVALUE(2)
      ITSTFLG=IVALUE(1).AND.'0003'X
      RETURN
      END

s_mach.for

C---------------------------------------------------------------------------
C
C ROUTINE  	   S_MACH      SUBROUTINE FORTVAX
C     
C PURPOSE 	   COMPUTE MACH  NO. FROM STATIC PRESSURE AND PITOT STATIC.
C
C DESCRIPTION      The two input arguments Static and Pitot static pressure
C                  (normally taken from samples of parameters 576 and 577)
C                  have their flag values noted. The input arguments are
C                  ranged-checked, with an out-of-range condition giving
C                  a flag value of two. The input flag values, together
C                  with results of range-checking give a 'worst' flag value.
C                  If the worst value is <2 computation of Mach number proceeds.
C                  Otherwise the value of Mach no will be set to zero later.
C                  The value of Static pressure is also checked that it is 
C                  not zero, to avoid a 'divide-by-zero' error.
C                  Computation of the Mach no. 'RMACH' proceeds using the 
C                  formula below.
C                  The return value of Mach no. has its flag area set to the
C                  'worst' flag value found.
C
C                  RMACH = SQRT( 5.* ((1.+ PITOT/RSTAT)**(2./7.) - 1.)) 
C
C VERSION	   1.00    070290   A.D.HENNINGS
C                                                                  
C ARGUMENTS        RSTAT - R*4 IN    Static pressure       (100 - 1050 mb.)
C                  PITOT - R*4 IN    Pitot static pressure (0   - 125  mb.)
C                  RMACH - R*4 OUT   MACH NO.                 [none ]
C
C SUBPROGRAMS  	   ISETFLG, ITSTFLG
C
C REFERENCES 	   Code adapted from MRF1/HORACE
C
C CHANGES          V1.01  020490  Include check for divide-by-zero error
C                                Return 0.0 flagged '3' if Static pressure
C                                input is zero.
C------------------------------------------------------------------------------
 	SUBROUTINE S_MACH (RSTAT,PITOT,RMACH)
CDEC$ IDENT 'V1.01'
C
      IMPLICIT NONE
      INTEGER*4  ITSTFLG, IFLAG, IFLAG2
      REAL*4     RSTAT,PITOT,RMACH ,SRSTAT,SPITOT
      REAL*4     STMAX,STMIN,PIMAX,PIMIN
      PARAMETER (STMAX=1050. ,STMIN= 100. ,PIMAX=125. ,PIMIN=0.) !Static,Pitot
                                                                 !range limits.
C------------------------------------------------------------------------------

      SPITOT = PITOT                                        !Put input arguments
      SRSTAT = RSTAT                                        !into placeholders.

      IFLAG  =ITSTFLG (SRSTAT)                              !Test validity of
      IF (SRSTAT .GT. STMAX .OR. SRSTAT .LT.STMIN) IFLAG=2
      IFLAG2 =ITSTFLG (SPITOT)                              !input arguments
      IF (SPITOT .GT. PIMAX .OR. SPITOT .LT.PIMIN) IFLAG2=2

      IF (IFLAG.LT.IFLAG2 ) IFLAG=IFLAG2                   !Choose worst flag.

      IF (SRSTAT .EQ. 0   ) THEN                           !Divide-by-zero err?
        RMACH  = 0.                                        !Zero return value
        IFLAG  = 3                                         !Set flag
        CALL ISETFLG (RMACH,IFLAG)                         !Flag result invalid
        RETURN                                             !.. cannot proceed.
      ENDIF

                                                           !Exponentiation err?
      IF (SPITOT/SRSTAT .LT.0)IFLAG=3                      !Must be +ve or eqn
                                                           !below will fail.
                                                         
      CALL ISETFLG(SPITOT,0)                               !Clear flag bits
      CALL ISETFLG(SRSTAT,0)                               !before computation

C  If flag not fatal, compute Mach no.

      IF (IFLAG.LT.3 ) THEN                                
        RMACH = SQRT( 5.* ((1.+ SPITOT/SRSTAT)**(2./7.) - 1.)) 
      ELSE
        RMACH = 0.0                                        !Return flagged zero
      ENDIF                                                !if input is invalid

      CALL ISETFLG (RMACH,IFLAG)                           !Re-flag result
      RETURN

      END

s_qcpt.for

C----------------------------------------------------------------------------
C ROUTINE  	   S_QCPT      SUBROUTINE FORTVAX
C     
C PURPOSE 	   PERFORM RANGE CHECK AND RATE OF CHANGE CHECK ON DATA POINT.
C
C DESCRIPTION      This routine is only valid for data which varies in a linear
C                  manner. It will not Q/C data which changes in a cyclic manner
C                  such as direction/angles going through 0/360.
C                  It quality-controls a data point with respect to range limits
C                  and check rate-of-change between it, and previous/good points
C                  Elementary checks performed to discrimimate between isolated
C                  'spikes' and a new trend departing from the previous data
C                  values.
C                  Data passing checks causes flag value: 0 to be returned
C                  Data failing checks causes flag value: 2 to be returned
C
C METHOD           1. Check for a break of time between samples (whole seconds 
C                     only).
C                     If true, initialise 'last time through' variables to
C                     current values of data and time.
C                  2. Attempt to eliminate spikes; after the error count RERCNT
C                     rises above RERRMX bad points, accept next point that is 
C                     within valid range.
C                     n.b  You must initialise RERRMX > 0, suggested value: 3
C                  3. Check rate-of-change and range limits:
C                     If either fails: set the return flag to 'failed' value: 2
C                                      increment the error counter.
C                     If both valid: Accept point, set flag to 'good'  value: 0 
C                                    reset error count
C                                    retain this value as 'last good point'
C                  4. Retain last-seconds time, for comparison next time through
C
C VERSION	   1.00  290190   A.D.HENNINGS
C                  1.01  17-01-96 D Lauchlan
C
C ARGUMENTS        RSEC   REAL*4 IN     Current time; seconds from midnight
C                  RLASTM REAL*4 IN/OUT Previous time; seconds from midnight
C                  RVAL   REAL*4 IN     Data value; current sample
C                  RLASTV REAL*4 IN/OUT Previous 'good' data value
C                  RMAX   REAL*4 IN     Q/C Max limit before rejecting
C                  RMIN   REAL*4 IN      "  Min   "     "       "
C                  RCHG   REAL*4 IN      "  Rate-of-change between succ samples.
C                  RERRMX REAL*4 IN      "  No.of succ bad pts before reset.    
C                  RERCNT REAL*4 IN/OUT  "  No.of succ bad pts found so far.    
C                  IFLAG  INT*4 OUT     Return value. 0: Good  2: Failed.
C                
C CHANGES          1.01 Unused variables removed.
C                  
C------------------------------------------------------------------------------
 	SUBROUTINE S_QCPT (rsec, rlastm, rval,rlastv,
     +                     rmax, rmin, rchg, rerrmx,rercnt,iflag)
CDEC$ IDENT 'V1.01'
C
        real*4  rsec                                   !Current second-from-mid.
        real*4  rlastm                                 !Last time (secs) checked
        real*4  rval                                   !current value
        real*4  rlastv                                 !Last acceptable value
        real*4  rmax                                   !Max acceptable value 
        real*4  rmin                                   !Min acceptable value 
        real*4  rchg                                   !acctble diff bet. samps 
        real*4  rerrmx                                 !no.bad pts before reset
        real*4  rercnt                                 !No. succ. bad pts found.
        integer*4 iflag                                !Value of flag on return
C-------------------------------------------------------------------------------



C       AFTER A BREAK, OR FIRST TIME THROUGH; INITIALISE 'PREVIOUS/LAST' VALUES

        if (rsec-rlastm .gt. 1. )then
           rlastv= rval                                 !Last 'good' value; this
           rlastm= rsec-1.                              !Last second processed.
        endif

C       DISCRIMINATE BETWEEN 'SPIKES' AND A NEW TREND.

        if (rercnt .gt.rerrmx)then                  !max error pts, accept next 
          if (rval .le. rmax .and. rval .ge. rmin) then  !within range limits.
            rlastv= rval                                 !Last good val is this
            rercnt  = 1.                                 !reset error counter
          endif                                   
        endif

C       CHECK NEW VALUE IS VALID FOR RATE-OF-CHANGE, AND RANGE LIMITS.

        if ( abs(rlastv-rval) .gt. rercnt*rchg .or.        !UNACCEPTABLE
     _       rval .gt. rmax .or. rval .lt. rmin) then    !------------
             rercnt = rercnt + 1.                        !Inc count of bad pts
             iflag = 2                                   !Set ret. flag invalid
        else                                           !ACCEPTABLE
                                                       !------------
             iflag = 0                                 !Set ret. flag valid
             rlastv = rval                             !only save if its good
             rercnt = 1.0                              !reset acc err marg count
        endif

C        PRESERVE VALUES FOR NEXT  TIME THROUGH.

        rlastm = rsec                                    !Preserve last second
        return
	end

s_sun.for

C
C ROUTINE          S_SUN         SUBROUTINE FORTVAX  S_SUN.FOR
C
C PURPOSE          COMPUTE SOLAR ZENITH AND AZIMUTH ANGLES 
C
C DESCRIPTION      Given date, time and location on the earth's
C                  surface this routine computes a solar zenith
C                  and azimuth angle. This routine was adapted from
C                  the one used in MRF1. 
C
C VERSION          1.01   301090 R.W. SAUNDERS
C
C ARGUMENTS        IDAY  I*4 IN Day in month (1-31)
C                  IMON  I*4 IN Month in year (1-12)
C                  IYR   I*4 IN Year (eg 1984)
C                  RSECS R*4 IN Time GMT (seconds from midnight)
C                  RLAT  R*4 IN Latitude degrees (north +ve)
C                  RLON  R*4 IN Longitude degrees (east +ve)
C                  AZIM  R*4 OUT Solar azimuth in degrees
C                  ZEN   R*4 OUT Solar zenith in degrees
C
C SUBPROGRAMS      DAT_CONV
C
C REFERENCES       Air Almanac useful for checking GHA and DECL
C                  Norton's Star Atlas for equation of time
C                  Robinson N. Solar Radiation Ch 2 for useful 
C                  introduction to theory/terminology
C
C CHANGES          01 Documentation improved, range checks now done on
C                     inputs RWS 30/10/90
C
C#########################################################################
      SUBROUTINE S_SUN(IDAY,IMON,IYR,RSECS,RLAT,RLON,AZIM,ZEN) 
CDEC$ IDENT 'V1.01'
C
!      IMPLICIT NONE
      INTEGER*4 LASTDAY/0/
      INTEGER*4 DAYM(12)/31,29,31,30,31,30,31,31,30,31,30,31/
!      REAL*8 RSECS,RLAT,RLON,TWOPI,HALFPI,D2R,R2D,RCD,RCD2
!      REAL*8 Y,Y2,EQNT,SINALP,TANEQN,DECL,RSINDC,RCOSDC,RSINLT,RCOSLT
!      REAL*8 RGMT,TIME,HRA,RSINEV,RCOSEV,ZEN,COSAZ,AZIM
!      INTEGER*4 ICD,IDAY,IMON,IYR
      DATA TWOPI/6.283185/,HALFPI/1.570796/,D2R/0.017453/
      DATA R2D/57.29578/

      SAVE
C
      AZIM = -99.                    ! Initialise azimuth
      ZEN = -99.                     ! Initialise zenith
C
C   Perform range checking for inputs
C
      IF (IMON .GT. 12)THEN
        RETURN
      ENDIF
      IF (( RSECS .GE. 0. AND. RSECS .LE. 86400.) .AND.
     1   ( IYR .GT. 1950 .AND. IYR .LT. 2200 ) .AND.
     2   ( IMON .GE.1 .AND. IMON .LE. 12) .AND.
     3   ( IDAY .GE. 1 .AND. IDAY .LE. DAYM(IMON)) .AND.
     4   ( RLAT .GE. -90. .AND. RLAT .LE. 90. ) .AND.
     5   ( RLON .GE. -180. .AND. RLON .LE. 180. ) )THEN

C
C   Only call this section once per day
C________________________________________________________________________
C
      IF ( LASTDAY .NE. IDAY)THEN
C
C   First get century day (ie no. of days since 0-JAN-1900)
C
      CALL DAT_CONV(IDAY,IMON,IYR,ICD)
!      print *,IYR,IMON,IDAY,RLAT,RLON,ICD
C
!      print *,sizeof(ICD)
      RCD = FLOAT(ICD) / 36525.0            ! Fraction of days elapsed this
      RCD2 = RCD*RCD                        ! century
      Y = (RCD * 36000.769 + 279.697) / 360.0 

!      print *,ICD
!      print *,sizeof(ICD)
!      print 10,FLOAT(ICD)
!      print 10,RCD
!      print 10,RCD2
!      print 10,Y
!10    format(f17.10)
!      print *,sizeof(Y)
C      Y = AMOD( Y , 1.0 ) * 360.0
      Y = AMOD( Y, 1.E0) * 360.E0
      Y2 = Y * D2R 
!      print *,RCD,RCD2,Y,Y2
!      print 20,Y
!20    format(f17.10)
!      print *,sizeof(RCD),sizeof(RCD2),sizeof(Y),sizeof(Y2)

C                       
C       Compute equation of time (in seconds) for this day 
C       (No reference for this but it gives the correct answers
C       when compared with table in Norton's star Atlas)
C
      EQNT=-((93.0+14.23*RCD-0.0144*RCD2)*SIN(Y2))-((432.5-3.71*RCD
     + -0.2063     
     + *RCD2)*COS(Y2))+((596.9-0.81*RCD-0.0096*RCD2)*SIN(2.0*Y2))-((1.4        
     + +0.28*RCD)*COS(2.0*Y2))+((3.8+0.6*RCD)*SIN(3.0*Y2))+((19.5-0.21        
     + *RCD-0.0103*RCD2)*COS(3.0*Y2))-((12.8-0.03*RCD)*SIN(4.0*Y2))            
C
C     Get solar declination for given day (radians)
C
      SINALP = SIN((Y-EQNT/240.0) * D2R)                                        
      TANEQN = 0.43382 - 0.00027*RCD
      DECL = ATAN(TANEQN*SINALP)                                              
      EQNT = EQNT / 3600.0                  ! Convert to hours
!      print *,SINALP,TANEQN,DECL,EQNT
C
C     Sine and cosine of declination                                
C
      RSINDC = SIN(DECL)                                                      
      RCOSDC = COS(DECL)
!      print *,RSINDC,RCOSDC
C
      ENDIF
C________________________________________________________________________
C
      LASTDAY = IDAY
C
      RSINLT = SIN(RLAT*D2R)                     ! Sine of lat
      RCOSLT = COS(RLAT*D2R)                     ! Cos of lat
      RGMT = RSECS / 3600.                       ! Convert secs elapsed to
C                                                ! gmt (eg 12:30 = 12.5)
C     Calculate solar zenith (degrees)                                    
C                                                                           
      TIME = ( RLON / 15.0 ) + EQNT + RGMT        ! Local solar time (hours)
      HRA = ( TIME*15.0 + 180.0 ) * D2R           ! Local hour angle (note
      RSINEV = RSINDC*RSINLT + RCOSDC*RCOSLT*COS(HRA) ! when longitude is zero
      RCOSEV = SQRT(1.0 - RSINEV*RSINEV)          ! this equals the GHA given 
      ZEN = (HALFPI - ASIN(RSINEV)) * R2D         ! in the Air Almanac)
C
C     Calculate solar azimuth (degrees)                                   
C
      COSAZ = ( RSINDC - RSINEV*RSINLT) / (RCOSLT*RCOSEV)                            
      IF (COSAZ .LT. -1.0) COSAZ = -1.0                                               
      IF (COSAZ .GT. 1.0) COSAZ = 1.0                                                 
      AZIM = ACOS(COSAZ)                                                       
      IF (AMOD(TIME+72.0,24.0) .GE. 12.0) AZIM = TWOPI-AZIM  
      AZIM = AZIM*R2D                     
C
      ENDIF
C

!      Following lines are for debugging purpose
!      =========================================
!      print *,IDAY,IMON,IYR,RSECS,RLAT,RLON,AZIM,ZEN
!      print *,RSECS,RLAT,RLON,TWOPI,HALFPI,D2R,R2D,RCD,RCD2
!      print *,Y,Y2,EQNT,SINALP,TANEQN,DECL,RSINDC,RCOSDC,RSINLT,RCOSLT
!      print *,RGMT,TIME,HRA,RSINEV,RCOSEV,ZEN,COSAZ,AZIM
!      print *,ICD,IDAY,IMON,IYR


      RETURN                                                                
      END                                                                   
C
C ROUTINE          DAT_CONV  SUBROUTINE FORTVAX
C
C PURPOSE          To convert day,mon,yr to days since 0/1/1900
C
C DESCRIPTION      Given the day, month and year this routine 
C                  computed the no. of days elpased since 
C                  Jan 0 1900, the so-called century day.
C
C VERSION          1.00   130290  R.W. SAUNDERS
C
C ARGUMENTS        IDAY  I*4 IN   Day in month (1-31)
C                  IMON  I*4 IN   Month in year (1-12)
C                  IYR   I*4 IN   Year (eg 1984)
C                  ICD   I*4 OUT  Century day 
C
C CHANGES          None
C
C#########################################################################
CDEC$ IDENT 'V1.00'
C
      SUBROUTINE DAT_CONV(IDAY,IMON,IYR,ICD)
C
      DIMENSION IMON2(12)
      DATA IMON2/0,31,59,90,120,151,181,212,243,273,304,334/
C
      IYD = IMON2(IMON) + IDAY !IYD is the number of days so far this year
      IF(MOD(IYR,4).EQ.0.AND.IMON.GT.2)IYD=IYD+1  !Leap year adjustment
      ILEAP = (IYR-1901) / 4 !Number of leap years since 1900 excluding this one
      ICD = (IYR-1900)*365 + ILEAP + IYD
C
      RETURN
      END