SUBROUTINE NOAP18(NLPR,COBS,CTRUE,IRANGE)

c ******************************************************************
c
c      Given a single NOAA-18 SBUV/2 instrument raw count and gain range
c      identifier, make a correction to remove the instrument nonlinearity.
c      The prelaunch calibration in 1995 was delivered to NOAA for A&E.
c
c      LK Huang, Jan 2005  
c
c      FName- noap18.f
c
c      Description of Variables -
c      Name/Size       Type  I/O  Description
c      -------------   ----  ---  -------------------------------------
c      NLPR            I*4   I    = 13 for LPRINT, long printout
c      cobs            R*4   I    raw PMT count with electronic offset
c                                 subtracted that is to be linearized.
c      ctrue           R*4   O    PMT count corrected for nonlinearity.
c      irange          I*4   I    gain range of the PMT count to be
c                                 linearized. 
c      r3ccm           L*4   I    passed by common block to indicate
c                                 Range-3 cathode mode if true.
c
c ******************************************************************
c  The prelaunch launch calibration in 1995 for Range-2 nonlinearity
c  is modified based on analysis of counts dependence in the 1st 2 weeks
c  IRR23A calibration in orbit, comparison of Range-2 counts with CCR in
c  2 orbits of position mode at 380 nm, also, IRR23C count dependence in
c  1 day earth view and in 2003 calibration.  A linear function
c  1+6.4693256E-7*(counts-45000) for counts > 45000 is applied to the counts
c  after the prelaunch correction.   LK Huang   June 18, 2005 
c ******************************************************************      
       include "r3mode.inc"

       real*4  min_counts,max_counts(4),range2x_coef,x0_r2nln,
     +   range1_coef(4),range2_coef(2),range3_coef(4),range3c_coef(4)

c ---  set count ranges valid in the prelaunch (1995) calibration
       data min_counts/100/,max_counts/88000,83000,80000,39000/

c ---  set fitted polynomial parameters from prelaunch (1995) calibration 
       data range1_coef/-2.609066E-3,-1.443777E-6,
     +                  1.432471E-10,-2.356036E-15/,
     +      range2_coef/-3.128075E-1,1.141482E-1/,
     +      range3_coef/-3.063840,2.700974,-7.947728E-1,7.923654E-2/,
     +      range3c_coef/1.703226,-1.598036,4.693160E-1,-4.108451E-2/

c ---  Range-2 non-linearity after 1998 based on orbital data
       data range2x_coef/6.4693256E-7/,x0_r2nln/45000./

       integer*4  irange, mode, range_id
       real*4 ctrue,cobs,correction,cobs
       include "lpghf.inc"

c ------------------------------------------------------------------
       ctrue=-77.0
c ---  Check for range ID
       if( (irange .lt. 1) .or. (irange .gt. 3) ) then
          if( lprint(nlpr) ) write (luprt,800) irange
800    format(1x,'*** -F-(NOAP18) Invalid gain range -',i6)
          return
       end if
       
       if(r3ccm .and. irange .eq. 3) then
         range_id = 4
       else
         range_id = irange
       end if
       
c ---  Warn saturation and make no correction
       if( cobs .gt. max_counts(range_id) ) then
         if( lprint(nlpr) ) write (luprt,820) irange,cobs
820    format (1x,'*** -W-(NOAP18) Range ',i1,' counts=',f6.0,
     +           ' Possible saturation')
         ctrue = cobs
         return
       end if

c ---  Fixed correction at valid minimum counts for counts < min_counts
       if( cobs .le. min_counts )then
         x=min_counts
       else
         x=cobs
       end if
       
       if( range_id .eq. 1 ) then
          correction = range1_coef(1) + range1_coef(2) * x +
     +           range1_coef(3) * x**2 + range1_coef(4) * x**3
       else if( range_id .eq. 2 ) then
         x=log10(x)
         correction = range2_coef(1) + range2_coef(2) * x 
       else if( range_id .eq. 3) then
         x=log10(x)
         correction = range3_coef(1) + range3_coef(2) * x +
     +           range3_coef(3) * x**2 + range3_coef(4) * x**3
       else
         x=log10(x)
         correction = range3c_coef(1) + range3c_coef(2) * x +
     +           range3c_coef(3) * x**2 + range3c_coef(4) * x**3         
       end if
       
       ctrue = cobs / (1. + correction/100.)

c ---  Extra correction for Range-2 counts larger than 45000.   June 2005
       if(ctrue .gt. x0_r2nln .and. range_id .eq. 2)then
         ctrue=ctrue/(1.+range2x_coef*(ctrue-x0_r2nln))
       end if

       if( lprint(nlpr) ) write(luprt,1000) cobs, irange, ctrue
1000   format (1x,'*** -I-(NOAP18) COBS=',F8.1,' IRANGE=',I2,
     +         ' CTRUE=',F8.1)

       return
       end