SUBROUTINE CDP4AP (
*
*  inputs
*
     :                          S, FILTER, APERT, POLEFF, NPTS,
*
*  outputs
*
     :                          INTEN, Q, U, STATUS)
*
*  Module Number:
*
*  Module Name:
*
*  Keyphrase:
*  ----------
*  Calculate Stokes parameters from four measurements made at the four different
*  apertures of the same filter.
*
*  Description:
*  ------------
*  Calculate Stokes parameters from four measurements made at the four different
*  apertures of the same filter.
*  The orientations of the polaroids' transmission axes are supposed to be
*  0 degree for the first aperture, 90 degrees for the second, 45 degrees for
*  the third, and 135 degrees for the fourth.
*  The output intensity is actually the intensity of the light source
*  multiplied by (k1+k2)/2, where k1 and k2 are the principle transmittances of
*  the linear polarizer.
*
*  FORTRAN Name: CDP4AP.FOR
*
*  Keywords of Accessed Files and Tables:
*  --------------------------------------
*  Name                         I/O     Description / Comments
*       None
*
*  Subroutines Called:
*  -------------------
*  CDBS:
*       None
*  SDAS:
*       UMSPUT
*  OTHERS:
*       None
*
*  History:
*  --------
*  Version      Date        Author          Description
*     1       07-15-86     J.-C. Hsu        Design and coding
*     2       10-01-87     J.-C. Hsu        F77 standard
*-------------------------------------------------------------------------------
*
*== input:
*                                       --measurements made at different
*                                       --apertures, s(1) is at 0 deg, s(2) at
*                                       --90 deg, s(3) at 45 deg, s(4) at 135 deg
        REAL            S(*)
*                                       --filter name
        CHARACTER*(*)   FILTER,
*                                       --aperture names in the polarization
*                                       --efficiency table
     :                  APERT(1)
*                                       --polarization efficiencies
        REAL            POLEFF(1)
*                                       --number of entries in the polarization
*                                       --efficiency table
        INTEGER         NPTS
*
*== output:
*                                       --the intensity of the target
        REAL            INTEN,
*                                       --the second Stokes parameter
     :                  Q,
*                                       --the third Stokes parameter
     :                  U
*                                       --error status
        INTEGER         STATUS
*
*== local:
*
        INTEGER         I, J, STATOK
*                                       --polarization efficiency
        REAL            K(4)
*                                       --aperture name
        CHARACTER*10    APER(4)
*                                       --error message context
        CHARACTER*130   CONTXT, MESS
*=========================begin hsp.inc=========================================
*                                       --status return code
        INTEGER         OK, ERRNUM(20)
        INTEGER         DEST, PRIO
        DATA OK /0/
        DATA ERRNUM /701, 702, 703, 704, 705, 706, 707, 708, 709, 710,
     :               711, 712, 713, 714, 715, 716, 717, 718, 719, 720/
*                                       --message destination and priority
        DATA DEST, PRIO /1, 0/
*=========================end hsp.inc===========================================
*-------------------------------------------------------------------------------
*
*-- assign (HSP) aperture names for the given filter name
*
        APER(1) = 'V' // FILTER // 'P0'
        APER(2) = 'V' // FILTER // 'P90'
        APER(3) = 'V' // FILTER // 'P45'
        APER(4) = 'V' // FILTER // 'P135'
*
*-- match the aperture names with those in the polarization efficiency table
*
        DO 20 I = 1, 4
            DO 10 J = 1, NPTS
                IF (APER(I) .EQ. APERT(J)) THEN
                    K(I) = POLEFF(J)
                    GO TO 20
                END IF
   10       CONTINUE
*
*  check if the aperture is in the polarization efficiency table
*
            STATUS = ERRNUM(1)
            CONTXT = 'no polarization coefficiency for '// APER(I)
            GO TO 999
   20   CONTINUE
*
*  calculate the intensity
*
        INTEN = ((S(1) * K(2) + S(2) * K(1)) / (K(1) + K(2)) +
     :           (S(3) * K(4) + S(4) * K(3)) / (K(3) + K(4))) / 2.
*
*  check if the intensity is zero
*
        IF (INTEN .EQ. 0) THEN
            CONTXT = 'zero intensity, can not calculate other Stokes '
     :                  // 'parameters'
            STATUS = ERRNUM(2)
            GO TO 999
        END IF
*
*  calculate q
*
        Q = (S(1) - S(2)) / ((K(1) + K(2)) * INTEN)
*
*  calculate u
*
        U = (S(3) - S(4)) / ((K(3) + K(4)) * INTEN)
*
        STATUS = OK
        GO TO 1000
*
  999   MESS = 'CDP4AP: ' // CONTXT
        CALL UMSPUT (MESS, DEST, PRIO,   STATOK)
*
 1000   RETURN
        END