NASA Ocean Color

ocssw V2022
       subroutine tiltcomp( nlines, tlm, timref, time, gaclac, navqc, 
      1  tiltpr, tiltfl )
  
 c $Header$
 c $Log$
 c
 c  tiltcomp( nlines, tlm, gaclac, navqc, tiltpr, tiltfl )
 c
 c  Purpose: process tilt angle data to a line-by-line array
 c
 c  Calling Arguments:
 c
 c  Name         Type    I/O     Description
 c  --------     ----    ---     -----------
 c  nlines       I*4      I      number of scan lines covered
 c  tlm          struct   I      telemetry structure containing tilt info
 c  timref       R*8      I      size 3 reference time at start line
 c                               of data: year, day, sec
 c  time         R*8      I      array of time in seconds relative to
 c                               timref for every scan line
 c  gaclac       I*4      I      flag for GAC or LAC data.  If LAC
 c                               data, a time exists for each scan
 c                               line, else only once every 5 lines
 c  navqc        struct   I      navigation quality control info
 c  tiltpr       R*4      O      size nlines processed tilt data 
 c                               for each line and for two tilt measurements
 c  tiltfl       I*4      O      flags for goodness of tilts 0 - good,
 c                               1 - bad
 c
 c  By: W. Robinson, GSC, 13 Apr 93
 c
 c  Notes:  
 c
 c  Modification History:
 c
 c  Fixed error in last call to runfit3t.  F. S. Patt, January 12, 1995.
 c
 c  Fixed error in indexing of smoothed tilt angles.  F.S. Patt, Oct. 31, 1997 
 c
 c  Fixed bug in initializing counter for end-of-scene processing.  F. S. Patt,
 c  SAIC GSC, May 21, 1998.
 c  
 c  Added a consistency check on the tilt angles during tilt changes; include 
 c  a final limit check on tilt angles to catch processing problems.
 c  F. S. Patt, SAIC GSC, August 4, 1998.
  
  
       implicit none
 #include "tlm_str.fin"
 #include "navqc_s.fin"
       type(tlm_struct) :: tlm
       type(navqc_struct) :: navqc
 c
       integer*4 gaclac, nlines, tiltfl(nlines)
 c
       integer*4 nper, ilin, j, k, i1, in(4), ntilt, n1, n2, tfl(100)
       integer*4 nskip, iret, nfit, jp, sgn
       real*8 timref(3),time(nlines)
       real*4 tiltpr(nlines)
       real*4 tout(100),tlcl(100),tdif(100),tdlim(2),tldif,tlim(2)
       logical gottwo
       data nfit/9/,nskip/2/,tdif/100*0.0/,tdlim/-1.,10./,tlim/-20.,20./
 c
 c
 c       initialize output arrays for processed tilt
 c
       nper = 1
       if( gaclac .eq. 1 ) nper = 5
 c
       do ilin = 1, nlines
          tiltpr(ilin) = 0
          tiltfl(ilin) = 1
       end do
 c
 c       First transfer the tilt info
 c
       do ilin = 1, tlm%ntlm
           
          do j = 1, nper
           
 c
             tiltfl((ilin - 1) * nper + j ) = tlm%tilt(1)%flag(j,ilin)
 c            tiltfl(2,(ilin - 1) * nper + j ) = tlm%tilt(2)%flag(j,ilin)
 c
             tiltpr((ilin - 1) * nper + j ) = tlm%tilt(1)%ang(j,ilin)
 c            tiltpr(2,(ilin - 1) * nper + j ) = tlm%tilt(2)%ang(j,ilin)
          end do
       end do
  
 c       Add consistency check at some future date
 c     call tiltcnst(
  
 c       Now fill in missing values
  
 c      do itilt=1,2
       ilin = 1
       i1 = 1
  
 c       Initialize by finding first 4 static tilt times
       do k=1,4
         call fndflg(tiltfl(1),nlines,i1,in(k))
 c       If end of range encountered, process data and exit
         if (in(k).eq.-1) then
  
 c       If 0 or 1 static values, attempt smoothing
           if (k.lt.3) then
             print *,'Insufficient static tilt data samples'
             print *,' Smoothing attempted'
             do j=1,nlines
               if (tiltfl(j).eq.2) tiltfl(j) = 0
             end do
             ntilt = nlines
             call runfit3t(nfit,nskip,tlcl,tiltpr(1),ntilt,1,tiltfl(1),
      *        1,time(1),tdif,tout,tfl,iret)
             do j=1,nlines
                tiltpr(j) = tout(j)
                tiltfl(j) = 2 - tfl(j)
             end do
             go to 990
  
 c       Else if 2 static values, process data
           else if (k.eq.3) then
             in(3) = in(2)
           end if
         end if
       i1 = in(k) + 1
       end do
  
 c       Now handle cases of non-static tilt at start of interval
 c        Change tilt change data flags to be used in smoothing
       n2 = 0
       n1 = 0
       do j=1,in(3)-1
         if (tiltfl(j).eq.2) then
           tiltfl(j) = 0
           n2 = n2 + 1
           if (j.lt.in(1)) n1 = n1 + 1
         end if
       end do
  
 c       Try to perform smoothing  
       ntilt = in(3)
         call runfit3t(nfit,nskip,tlcl,tiltpr(1),ntilt,1,tiltfl(1),
      *    1,time(1),tdif,tout,tfl,iret)
  
 c       Fill in values before first pointer if necessary
       if (in(1).gt.1) then
          if ((n1.gt.0).and.(iret.eq.0)) then
             do j=1,in(1)-1
                tiltpr(j) = tout(j)
                tiltfl(j) = 2 - tfl(j)
             end do
          else
             do j=1,in(1)-1
                tiltpr(j) = tiltpr(in(1))
                tiltfl(j) = tiltfl(in(1))
             end do
          end if
       end if
  
 c       Fill in values between first and second pointers
       if (in(2).gt.(in(1)+1)) then
         if (tiltpr(in(2)).eq.tiltpr(in(1))) then
           do j=in(1)+1,in(2)-1
             tiltpr(j) = tiltpr(in(1))
             tiltfl(j) = tiltfl(in(1))
           end do
         else
           do j=in(1)+1,in(2)-1
             tiltpr(j) = tout(j)
             tiltfl(j) = 2 - tfl(j)
           end do
         end if
       end if
  
  
 c       Now fill remaining array locations with good values
       dowhile(in(4).ne.-1)
  
 c       Check for tilt change between second and third pointers
         if (tiltpr(in(3)).eq.tiltpr(in(2))) then
           if (in(3).gt.(in(2)+1)) then
             do j=in(2)+1,in(3)-1
               tiltpr(j) = tiltpr(in(2))
               tiltfl(j) = tiltfl(in(2))
             end do
           end if
           
 c       Else smooth and load tilt change data
         else
  
 c       Perform consistency check on tilt angles
            gottwo = .false.
            jp = in(2)
            sgn = sign(1.0,(tiltpr(in(3)) - tiltpr(in(2))))
            do j=in(2)+1,in(3)-1
               if (tiltfl(j).eq.2) then
                  if (time(j).ne.time(jp)) then
                     tldif = sgn*(tiltpr(j) - tiltpr(jp)) / 
      *                   (time(j)-time(jp))
                     if ((tldif.lt.tdlim(1)).or.(tldif.gt.tdlim(2))) then
                        if (.not.gottwo) tiltfl(jp) = 1
                        gottwo = .false.
                     else                       
                        tiltfl(j) = 0
                        gottwo = .true.
                     end if
                     jp = j
                  else
                     tiltfl(j) = 1
                  end if
               end if
            end do
            if (.not.gottwo) tiltfl(jp) = 1
            ntilt = in(3) - in(2) + 1
            call runfit3t(nfit,nskip,tlcl,tiltpr(in(2)),ntilt,1,
      1          tiltfl(in(2)),1,time(in(2)),tdif,tout,tfl,iret)
            do j=in(2)+1,in(3)-1
               tiltpr(j) = tout(j-in(2)+1)
               tiltfl(j) = 2 - tfl(j-in(2)+1)
            end do
         end if
         
 c       Find next static value and shift pointers
         do j=1,3
           in(j) = in(j+1)
         end do
         i1 = in(3) + 1
         call fndflg(tiltfl(1),nlines,i1,in(4))
  
 c       End of main processing loop
       end do
         
 c       Now process data at end of interval
 c        Change tilt change data flags to be used in smoothing
       n1 = 0
       n2 = 0
       do j=in(2),nlines
         if (tiltfl(j).eq.2) then
           tiltfl(j) = 0
           n2 = n2 + 1
           if (j.gt.in(3)) n1 = n1 + 1
         end if
       end do
  
 c       Try to perform smoothing  
       ntilt = nlines - in(1) + 1
         call runfit3t(nfit,nskip,tlcl,tiltpr(in(1)),ntilt,1,
      1    tiltfl(in(1)),1,time(in(1)),tdif,tout,tfl,iret)
  
 c       Fill in values between second and third pointers
       if (in(3).gt.(in(2)+1)) then
         if (tiltpr(in(3)).eq.tiltpr(in(2))) then
           do j=in(2)+1,in(3)-1
             tiltpr(j) = tiltpr(in(2))
             tiltfl(j) = tiltfl(in(2))
           end do
         else
           do j=in(2)+1,in(3)-1
             tiltpr(j) = tout(j-in(1)+1)
             tiltfl(j) = 2 - tfl(j-in(1)+1)
           end do
         end if
       end if
  
 c       Fill in values after third pointer if necessary
       if (in(3).lt.nlines) then
         if ((n1.gt.0).and.(iret.eq.0)) then
           do j=in(3)+1,nlines
             tiltpr(j) = tout(j-in(1)+1)
             tiltfl(j) = 2 - tfl(j-in(1)+1)
           end do
         else
           do j=in(3)+1,nlines
             tiltpr(j) = tiltpr(in(3))
             tiltfl(j) = tiltfl(in(3))
           end do
         end if
       end if
  
 c  
 c       and end
 c
   990 continue
  
       do j=1,nlines
 c       Perform final check to limit tilt angles to +/- 20 degrees
          if (tiltpr(j).gt.tlim(2)) then
             tiltpr(j) = tlim(2)
             tiltfl(j) = 1
          else if (tiltpr(j).lt.tlim(1)) then
             tiltpr(j) = tlim(1)
             tiltfl(j) = 1
          end if
          
 c       print *,tiltpr(j),tiltfl(j)
       end do
  
       return
       end
sign
#define sign(x)
Definition: misc.h:95
real
#define real
Definition: DbAlgOcean.cpp:26
fndflg
subroutine fndflg(flag, nflag, istndx, next)
Definition: fndflg.f:2
void print(std::ostream &stream, const char *format)
Definition: PrintDebug.hpp:38
tiltcomp
subroutine tiltcomp(nlines, tlm, timref, time, gaclac, navqc, tiltpr, tiltfl)
Definition: tiltcomp.f:3
runfit3t
subroutine runfit3t(nfpts, nskip, measlcl, meas, nmeas, nquant, flag, nper, time, timdif, measout, flgout, iret)
Definition: runfit3t.f:3
navqc_struct
Definition: navqc_s.h:35