C$Procedure  GETOM( Get OM matrix )

      SUBROUTINE GETOM (  A,        B,        C,
     .                    OBSLAT,   OBSLON,   RANGE,
     .                    XPTLAT,   XPTLON,
     .                    V,        PRJANG,   OM,     VISIBL )

      IMPLICIT NONE

C$ Abstract
C
C     Find the OM matrix corresponding to a given observer location,
C     optical axis intercept point, and angular position of a
C     body-fixed vector, using an ellipsoidal target body model.
C
C$ Required_Reading
C
C     None.
C
C$ Keywords
C
C     GEOMETRY
C     MATRIX
C     TRANSFORMATION
C
C$ Declarations

      DOUBLE PRECISION      A
      DOUBLE PRECISION      B
      DOUBLE PRECISION      C
      DOUBLE PRECISION      OBSLAT
      DOUBLE PRECISION      OBSLON
      DOUBLE PRECISION      RANGE
      DOUBLE PRECISION      XPTLAT
      DOUBLE PRECISION      XPTLON
      DOUBLE PRECISION      V      ( 3 )
      DOUBLE PRECISION      PRJANG
      DOUBLE PRECISION      OM     ( 3, 3 )
      LOGICAL               VISIBL

C$ Brief_I/O
C
C     Variable  I/O  Description
C     --------  ---  --------------------------------------------------
C     A          I   Larger equatorial radius of target body (km).
C     B          I   Smaller equatorial radius of target body (km).
C     C          I   Polar radius of target body (km).
C     OBSLAT     I   Observer's planetocentric latitude (rad).
C     OBSLON     I   Observer's planetocentric longitude (rad).
C     RANGE      I   Observer's range to target body center (km).
C     XPTLAT     I   Optical axis intercept planetocentric lat. (rad).
C     XPTLAN     I   Optical axis intercept planetocentric lon. (rad).
C     V          I   A vector in body-fixed coordinates.
C     PRJANG     I   Angular position of proj of V on focal plane (rad).
C     OM         O   OM matrix.
C     VISIBL     O   Flag indicating whether intercept is visible.
C
C$ Detailed_Input
C
C     A,
C     B,
C     C              are, respectively, the larger equatorial, smaller
C                    equatorial, and polar radii of the target body.
C
C     OBSLAT,
C     OBSLON         are, respectively, the planetocentric latitude
C                    and longitude of a sub-observer point, given in
C                    radians.
C
C     RANGE          is the distance between the observer and the
C                    target body center, in units of km.
C
C     XPTLAT,
C     XPTLON         are, respectively, the planetocentric latitude
C                    and longitude of the surface intercept point of
C                    the optical axis on the target body, given in
C                    radians.
C
C     V,
C     PRJANG         are, respectively, a vector specified in body-fixed
C                    coordinates and the angular position of the
C                    vector's projection P on the M-N plane of the
C                    instrument.  If P is specified in polar coordinates
C                    as (r, theta), then PRJANG is theta.  Units are
C                    radians.
C
C$ Detailed_Output
C
C     OM             is a coordinate transformation matrix that
C                    converts vectors from camera coordinates to
C                    body-fixed coordinates by left multiplication:
C
C                       OM * V         =   V
C                             camera        body-fixed
C
C                    for any vector
C
C                       V
C                        camera
C
C                    specified relative to the camera frame.
C
C
C     VISIBL         is a logical flag indicating whether the surface
C                    location defined by XPTLAT, XPTLON, A, B, and C
C                    is visible from the observer location specified by
C                    OBSLAT, OBSLON, and RANGE.  The OM matrix is
C                    calculated whether or not the surface location is
C                    visible.
C$ Parameters
C
C     None.
C
C$ Exceptions
C
C     1)  If any of the input body radii are non-positive, the
C         error SPICE(NONPOSITIVEAXES) is signalled.
C
C     2)  If the observer location is inside the target body, the
C         error SPICE(INVALIDRANGE) is signalled.
C
C     3)  If the projection of the input vector V on the instrument
C         M-N plane is the zero vector, the error SPICE(DEGENERATECASE)
C         is signalled.
C$ Files
C
C     None.
C
C$ Particulars
C
C     None.
C
C$ Examples
C
C     1)  Find the OM matrix when the "North position angle" is known.
C
C         In this case, the vector V is the body-fixed North direction
C         vector (0,0,1).
C
C         The angle PRJANG is related to the North position angle as
C         shown in the picture below:
C
C
C                    ^
C                -N  |
C                    |.
C   line 1  +------------.----+
C           |             .North position angle
C           |             .   |
C           |   +L into page  |
C           |        +----.----> + M
C           |        |\  .   .|
C           |        | \*   .PRJANG
C           |        |  \ *   |
C  line 800 +--------|---\----+
C                    v
C                    +N
C
C     Let NPA represent the North position angle, in units of radians.
C     Then
C
C        PRJANG  =  NPA - pi/2
C
C     Presuming that we know the other inputs to GETOM_G, the call
C
C        CALL GETOM_G (  A,        B,             C,
C       .                OBSLAT,   OBSLON,        RANGE,
C       .                XPTLAT,   XPTLON,
C                        V,        NPA-HALFPI(),  OM,    VISIBL  )
C
C     will produce the desired OM matrix.
C
C$ Restrictions
C
C     For review by Lucas Kamp.
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     N.J. Bachman   (JPL)
C
C$ Version
C
C-    Beta Version 3.0.0, 20-APR-1993 (NJB)
C
C-&

C
C$ Index_Entries
C
C     get OM matrix
C
C-&

C
C     SPICELIB functions
C
      DOUBLE PRECISION      HALFPI
      DOUBLE PRECISION      VSEP

      LOGICAL               RETURN
      LOGICAL               VZERO

C
C     Local variables
C
      DOUBLE PRECISION      UVEC   ( 3 )

      DOUBLE PRECISION      LVEC   ( 3 )
      DOUBLE PRECISION      MVEC   ( 3 )
      DOUBLE PRECISION      NORMAL ( 3 )
      DOUBLE PRECISION      NVEC   ( 3 )
      DOUBLE PRECISION      OBSPOS ( 3 )
      DOUBLE PRECISION      OXVEC  ( 3 )
      DOUBLE PRECISION      VPRJ   ( 3 )
      DOUBLE PRECISION      XPOS   ( 3 )

      INTEGER               I

      LOGICAL               FOUND

C
C     Saved variables
C
      DOUBLE PRECISION      ORIGIN ( 3 )
      SAVE                  ORIGIN
C
C     Initial values
C
      DATA                  ORIGIN / 3 * 0.D0 /

C
C     Standard SPICE error handling.
C
      IF ( RETURN () ) THEN
         RETURN
      ELSE
         CALL CHKIN ( 'GETOM_G' )
      END IF

C
C     Body radii must be positive.
C
      IF (      ( A .LE. 0.D0 )
     .     .OR. ( B .LE. 0.D0 )
     .     .OR. ( C .LE. 0.D0 ) ) THEN

         CALL SETMSG ( 'A = #,  B = #,  C = #'  )
         CALL ERRDP  ( '#',  A                  )
         CALL ERRDP  ( '#',  B                  )
         CALL ERRDP  ( '#',  C                  )
         CALL SIGERR ( 'SPICE(NONPOSITIVEAXES)' )
         CALL CHKOUT ( 'GETOM_G'                )
         RETURN

      END IF

C
C     Observer's position in rectangular body-fixed coordinates:
C
      CALL LATREC ( RANGE, OBSLON, OBSLAT, OBSPOS )

C
C     Make sure the observer not inside the target body.
C
      IF (      ( OBSPOS(1)**2  /  A**2 )
     .       +  ( OBSPOS(2)**2  /  B**2 )
     .       +  ( OBSPOS(3)**2  /  C**2 )   .LT.  1  ) THEN

         CALL SETMSG ( 'observer is inside target body; range = #'  )
         CALL ERRDP  ( '#',  RANGE                                  )
         CALL SIGERR ( 'SPICE(INVALIDRANGE)'                        )
         CALL CHKOUT ( 'GETOM_G'                                    )
         RETURN

      END IF

C
C     Ok, the inputs should be valid, with the possible exception of
C     V, which we'll come back to later.  We'll now find the vector
C     from the camera to the optical axis intercept, using body-fixed
C     rectangular coordinates.
C
C
C     Optical axis intercept position in rectangular body-fixed
C     coordinates:   find the surface intercept of the unit vector
C     centered at the origin that points in the direction defined
C     by XPTLON, XPTLAT.
C
      CALL LATREC ( 1.D0,   XPTLON,  XPTLAT,    UVEC )

      CALL SURFPT ( ORIGIN, UVEC,    A, B, C,   XPOS,   FOUND )
C
C     There's no way a ray emanating from the origin can fail to
C     intersect the surface, so we won't check FOUND.
C
C
C     Observer-intercept vector in body-fixed coordinates:
C
      CALL VSUB ( XPOS, OBSPOS, OXVEC )

C
C     The L-axis in body-fixed coordinates:
C
      CALL VHAT ( OXVEC, LVEC )

C
C     The next step is to determine the M-axis in body-fixed
C     coordinates.  Since the projection of V onto the M-N plane
C     is parallel to the vector obtained by rotating M by PRJANG
C     radians about the L axis, rotating the M-N projection of V
C     by -PRJANG radians about the L axis, and then unitizing the
C     result, will give us the M vector.
C
C     Find the component of V perpendicular to L---this is the
C     projection of V onto the M-N plane:
C
      CALL VPERP ( V, LVEC, VPRJ )

C
C     One last check:  VPRJ must not be the zero vector:
C
      IF ( VZERO(VPRJ) ) THEN

         CALL SETMSG ( 'V is parallel to the optical axis; not '     //
     .                 'enough informatation available to define '   //
     .                 'OM matrix.'                                   )
         CALL SIGERR ( 'SPICE(DEGENERATECASE)'                        )
         CALL CHKOUT ( 'GETOM_G'                                      )
         RETURN

      END IF

C
C     Rotate VPRJ about the L-axis and unitize the result:
C
      CALL VROTV ( VPRJ, LVEC, -PRJANG, MVEC )
      CALL VHAT  ( MVEC,                MVEC )

C
C     Find the N vector:
C
      CALL VCRSS ( LVEC, MVEC, NVEC )

C
C     Form the OM matrix (the transpose of the body-fixed-to-camera
C     transformation matrix):
C
      DO I = 1, 3
         OM(I,1)  =  MVEC(I)
         OM(I,2)  =  NVEC(I)
         OM(I,3)  =  LVEC(I)
      END DO
C
C     Decide whether the intercept point is visible from the observer's
C     location.   The point is visible if and only if the observer is
C     visible from the surface point, which happens precisely when the
C     angular separation of the surface point--observer vector and the
C     outward normal at the surface point is less than pi/2 radians.
C     Equivalently, the angular separation of the outward normal and the
C     L-vector must be no less than pi/2 radians.
C
      CALL SURFNM ( A, B, C, XPOS, NORMAL )

      IF (  VSEP( LVEC, NORMAL )  .GE.  HALFPI()  ) THEN
          VISIBL = .TRUE.
      ELSE
          VISIBL = .FALSE.
      END IF

      CALL CHKOUT ( 'GETOM_G' )
      RETURN
      END


      SUBROUTINE ANLYTC(L3D,LN,TIME,CASE,
     $                  UICLL,VICLL,PICLL,DICLL,EICLL)
C
C THIS PROCEDURE RETURNS THE ANALYTIC SOLUTION FOR THE TEST CASES.
C IT IS CALLED FOR THE INITIALIZATION OF
C THE PROGNOSTIC AND ANALYTIC FIELDS AND DURING ERROR ANALYSIS.
C THE RESULTS ARE RETURNED IN THE ARRAYS UICLL,VICLL,PICLL,DICLL,
C AND EICLL. THE ROUTINE USES MANY VALUES FROM THE COMMON
C BLOCKS /CONST/ AND /CONST2/ WHICH WERE COMPUTED IN ROUTINES
C INPUT AND INIT.
C
C CALLED BY: ERRANL, STSWM
C CALLS: DBUBF, EVAL, GLAT, GLON, INPTP, ROTATE
C
C REVISIONS:
C 7-10-92 CHANGE TO CCM CODING CONVENTIONS (R. JAKOB)
C
C---- Model Parameters -------------------------------------------------
C
      INCLUDE 'params.i'
C
C---- Common Blocks ----------------------------------------------------
C
C Plotting Data
      INCLUDE 'complt.i'
C Constants
      INCLUDE 'consts.i'
C Initial Conditions
      INCLUDE 'finit.i'
      INCLUDE 'case4.i'
C
C------------ Arguments ------------------------------------------------
C
C     Input
C
C NUMBER OF TIMELEVELS OF DIVERGENCE,VORTICITY
C          (=1 WHEN CALLED FROM SUBROUTINE ERRANL)
C          (=LVLS WHEN CALL FROM MAIN PROGRAM)
      INTEGER L3D
C CURRENT TIMELEVEL OF DIVERGENCE,VORTICITY
      INTEGER LN
C MODEL TIME IN SECONDS
      REAL TIME
C TEST CASE NUMBER
      INTEGER CASE
C
C     Output
C
C EASTWARD WIND VELOCITY ON GRID
      REAL UICLL(NLON+2,NLAT)
C NORTHWARD WIND VELOCITY ON GRID
      REAL VICLL(NLON+2,NLAT)
C HEIGHT ON GRID
      REAL PICLL(NLON+2,NLAT)
C DIVERGENCE ON GRID
      REAL DICLL(NLON+2,NLAT,L3D)
C VORTICITY ON GRID
      REAL EICLL(NLON+2,NLAT,L3D)
C
C------ Local Parameters -----------------------------------------------
C
      REAL PI
      PARAMETER (PI=3.141592653589793)
C
C------ Local Variables ------------------------------------------------
C
      REAL DIV,ZETA,PHI,U,V
C     TEST CASE 1 TEMPORARIES
      REAL RADIUS, DIST
C     LONGITUDES
      REAL RLONA, RRLONA, RLON
      INTEGER I
C     LATITUDES
      INTEGER J
      REAL RLATA, RRLATA, RLAT
C     TEST CASE 4 TEMPORARIES
      REAL TMSHFT, AI, A2I, SNJ, CSJ, SRCSJ, TMPRY, TMPRY2, DEN,
     $     AACSJI, CORR, BIGUBR, DBUB, C, PSIB, DCDM, DCDL, D2CDM,
     $     D2CDL, TMP1, TMP2, DKDM, DKDL, D2KDM, D2KDL, DLON, SINT,
     $     COST
C
C     SPECTRAL COEFFICIENTS FROM NETCDF FILE
      COMPLEX ZETASC(NALPH),DIVSC(NALPH),PHISC(NALPH)
C
C     SPECTRAL TRUNCATION PARAMETERS OF FILE
C
      INTEGER MMH,NNH,KKH
      INTEGER LDIAG(0:MAXH,2)
C
C----- External Functions ----------------------------------------------
C
C     ZONAL FLOW FUNCTIONS
C
      EXTERNAL DBUBF
      REAL DBUBF
C
C     LAT./ LONG. GRID
C
      EXTERNAL GLAT, GLON
      REAL GLAT, GLON
C
C----- Executable Statements -------------------------------------------
C
      IF (CASE .EQ. 1) THEN
C
C-------- INITIAL CONDITION #1 ---------------------------------------
C
C     COPY DATA FOR U,V,ZETA,DIV SINCE STEADY FLOW FIELD
C     COMPUTE LOCATION OF ADVECTED HEIGHT
C
      RLATA = RLAT0
      RLONA = RLON0 + SU0*COS(RLAT0)*TIME/A
      CALL ROTATE(RLONA,RLATA,-ALPHA,RRLONA,RRLATA)
C
C     SET VIEWPOINT FOR GRAPHICS
C
      POLAT = RRLATA*180.0/PI
      POLNG = RRLONA*180.0/PI
      POROT = ALPHA*180.0/PI-90.0
C
C     SIZE OF FEATURE
C
      RADIUS = A/3.0
C
      DO 41 J=1,NLAT
         RLAT = GLAT(J)
         DO 40 I=1,NLON
            RLON = GLON(I)
C
C           LONGITUDE = RLON = GLON(I)
C           LATITUDE = RLAT = GLAT(J)
C
            DICLL(I,J,LN) = DIC12(I,J)
            EICLL(I,J,LN) = EIC12(I,J)
            UICLL(I,J)    = UIC12(I,J)
            VICLL(I,J)    = VIC12(I,J)
C
C        CONSTRUCT ADVECTED LOW
C
            DIST = A*ACOS(SIN(RRLATA)*SIN(RLAT) + COS(RRLATA)
     $          *COS(RLAT)*COS(RLON-RRLONA))
            IF (DIST .LE. RADIUS) THEN
               PICLL(I,J) = PHI0/2.0*(1.0 + COS(PI*DIST/RADIUS))
            ELSE
               PICLL(I,J) = 0.0
            ENDIF
C
   40    CONTINUE
   41 CONTINUE
C
      ELSEIF ((CASE .EQ. 2) .OR. (CASE .EQ. 3)) THEN
C
C-------- INITIAL CONDITION #2, #3 ------------------------------------
C
C     SET VIEWPOINT FOR GRAPHICS
C
      IF (CASE .EQ. 2) THEN
         POLAT = 90.0 - ALPHA/PI*180.0
         POLNG = 180.0
      ENDIF
C
C     COPY INITIAL DATA, SINCE STEADY STATE SOLUTION
C
      DO 51 J=1,NLAT
         DO 50 I=1,NLON
C
C        LONGITUDE = RLON = GLON(I)
C        LATITUDE = RLAT = GLAT(J)
C
            DICLL(I,J,LN) = DIC12(I,J)
            EICLL(I,J,LN) = EIC12(I,J)
            UICLL(I,J)    = UIC12(I,J)
            VICLL(I,J)    = VIC12(I,J)
            PICLL(I,J)    = PIC12(I,J)
   50    CONTINUE
   51 CONTINUE
C
      ELSEIF (CASE .EQ. 4) THEN
C
C-------- INITIAL CONDITION #4 ---------------------------------------
C
C     CALCULATE ANALYTIC SOLUTION TO FORCED NONLINEAR PROBLEM
C
C
C     LONGITUDINAL CHANGE OF LOW IN BASIC FLOW
C
      TMSHFT =  SU0*TIME/A
C
C     SET VIEWPOINT FOR GRAPHICS
C
      POLNG = (RLON0+TMSHFT)*180.0/PI
      POLAT = RLAT0*180.0/PI
      DO 101 J=1,NLAT
C
C        GAUSSIAN LATITUDE
C
         RLAT = GLAT(J)
C
C        TEMPORARY VARIABLES INDEPENDENT OF LONGITUDE
C
         AI     = 1.0/A
         A2I    = 1.0/(A*A)
         SNJ    = SIN(RLAT)
         CSJ    = COS(RLAT)*COS(RLAT)
         SRCSJ  = COS(RLAT)
         TMPRY  = TAN(RLAT)
         TMPRY2 = TMPRY*TMPRY
         DEN    = 1.0/COS(RLAT)
         AACSJI = 1.0/(A*A*CSJ)
         CORR   = 2.0*OMEGA*SNJ
C
C        NONLINEAR STEADY ZONAL FLOW
C
         BIGUBR = UCON(J)*SRCSJ
         DBUB   = DBUBF(RLAT)
C
         DO 100 I=1,NLON
            RLON = GLON(I)
C
C           LONGITUDE = RLON = GLON(I)
C           LATITUDE = RLAT = GLAT(J)
C
C           COMPUTE LOCATION OF TRANSLATING LOW
C
            C      = SIN(RLAT0)*SNJ + COS(RLAT0)*SRCSJ*
     $                                   COS(RLON-TMSHFT-RLON0)
            PSIB   = ALFA*EXP(-SIGMA*((1.0-C)/(1.0+C)))
C
C        COMPUTE PARTIAL DERIVATIVES OF C
C
            DCDM   = SIN(RLAT0) - COS(RLON-TMSHFT-RLON0)*
     $               COS(RLAT0)*TMPRY
            DCDL   = -COS(RLAT0)*SRCSJ*SIN(RLON-TMSHFT-RLON0)
            D2CDM  = -COS(RLAT0)*COS(RLON-TMSHFT-RLON0)*
     $                      (1.0 + TMPRY2)/SRCSJ
            D2CDL  = -COS(RLAT0)*SRCSJ*COS(RLON-TMSHFT-RLON0)
C
C        COMPUTE PARTIAL DERIVATIVES OF PSI BAR
C
            TMP1   = 2.0*SIGMA*PSIB/((1.0 + C)**2)
            TMP2   = (SIGMA - (1.0 + C))/((1.0 + C)**2)
            DKDM   = TMP1*DCDM
            DKDL   = TMP1*DCDL
            D2KDM  = TMP1*(D2CDM + 2.0*(DCDM**2)*TMP2)
            D2KDL  = TMP1*(D2CDL + 2.0*(DCDL**2)*TMP2)
C
C           ANALYTIC SOLUTIONS
C
            DICLL(I,J,LN) = 0.0
            EICLL(I,J,LN) = D2KDL*AACSJI + CORR - DBUB*AI
     $                  + (CSJ*D2KDM - 2.0*SNJ*DKDM)*A2I
            UICLL(I,J)    = BIGUBR*DEN - SRCSJ*AI*DKDM
            VICLL(I,J)    = (DKDL*AI)*DEN
            PICLL(I,J)    = PHICON(J)+CORR*PSIB/GRAV
  100    CONTINUE
  101 CONTINUE
C
      ELSEIF ((CASE .EQ. 5) .AND. (TIME .EQ. 0.0)) THEN
C
C-------- INITIAL CONDITION #5 ---------------------------------------
C
C     ZONAL FLOW OVER ISOLATED MOUNTAIN
C
C     COPY INITIAL DATA
C
      DO 121 J=1,NLAT
         DO 120 I=1,NLON
C
C           LONGITUDE = RLON = GLON(I)
C           LATITUDE = RLAT = GLAT(J)
C
            DICLL(I,J,LN) = DIC12(I,J)
            EICLL(I,J,LN) = EIC12(I,J)
            UICLL(I,J)    = UIC12(I,J)
            VICLL(I,J)    = VIC12(I,J)
            PICLL(I,J)    = PIC12(I,J)
  120    CONTINUE
  121 CONTINUE
C
      ELSEIF ((CASE .EQ. 6) .AND. (TIME .EQ. 0.0)) THEN
C
C-------- INITIAL CONDITION #6 ---------------------------------------
C
C     ROSSBY-HAURWITZ WAVE
C
C     LONGITUDINAL CHANGE OF FEATURE
C
      DLON = (R*(3+R)*OMG - 2.0*OMEGA)/((1+R)*(2+R))*TIME
C
      DO 151 J=1,NLAT
         RLAT = GLAT(J)
         DO 150 I=1,NLON
            RLON = GLON(I)
C
C           LONGITUDE = RLON = GLON(I)
C           LATITUDE = RLAT = GLAT(J)
C
            SINT = SIN(RLAT)
            COST = COS(RLAT)
            DICLL(I,J,LN) = 0.0
            EICLL(I,J,LN) = 2.0*(OMG+OMEGA)*SINT - (1+R)*(2+R)*SINT*
     $                   K*COST**R*COS(R*(RLON-DLON))
            UICLL(I,J)    = A*OMG*COST + A*K*COST**(R-1)*
     $                   (R*SINT*SINT-COST*COST)*COS(R*(RLON-DLON))
            VICLL(I,J)    = -A*K*R*COST**(R-1)*SINT
     $                    * SIN(R*(RLON-DLON))
            PICLL(I,J)    = PHI0 + (A*A*(PHIA(J)+PHIB(J)
     $                    * COS(R*(RLON-DLON))+PHIC(J)
     $                    * COS(2*R*(RLON-DLON))))/GRAV
  150    CONTINUE
  151 CONTINUE
C
      ELSEIF ((CASE .EQ. 7) .OR. (TIME .GT. 0.0)) THEN
C
C-------- INITIAL CONDITION #7 ---------------------------------------
C
C     USE HIGH RESOLUTION SOLUTION FROM FILE
C
C     READ SPECTRAL COEFFICIENTS BACK IN
C
      CALL INPTP(FNIN,TIME,MAXH,LDIAG,ZETASC,DIVSC,PHISC,
     $              MMH,NNH,KKH)
C
C     PROJECT ONTO IRREGULAR GRID
C
      DO 451 J=1,NLAT
         RLAT = GLAT(J)
         DO 450 I=1,NLON
            RLON = GLON(I)
C
C           LONGITUDE = RLON = GLON(I)
C           LATITUDE = RLAT = GLAT(J)
C
C           COMPUTE VALUES AT LOCATION
C
            CALL EVAL(DIVSC,ZETASC,PHISC,MMH,NNH,KKH,A,ALPHA,
     $             OMEGA,RLON,RLAT,DIV,ZETA,PHI,U,V)
C
            DICLL(I,J,LN) = DIV
            EICLL(I,J,LN) = ZETA
            UICLL(I,J)    = U
            VICLL(I,J)    = V
            PICLL(I,J)    = PHI/GRAV
            IF (FTOPO) THEN
               PICLL(I,J) = PICLL(I,J) + MOUNT (I,J)
            ENDIF
C
  450    CONTINUE
  451 CONTINUE
C
C--------------------LAST CASE ----------------------------------
C
      ELSE
C
         WRITE (0,300) CASE
  300    FORMAT (/,' STSWM: FATAL ERROR IN ANLYTC: ',/,
     $      ' NO ANALYTIC SOLUTION PROVIDED FOR TEST CASE ',I2,/)
         STOP
      ENDIF
C
C----------------------------------------------------------------
C
      RETURN
C
      END


      DOUBLE PRECISION FUNCTION DIGAMD(X)
C***********************************************************************
C*                                                                     *
C*  FORTRAN CODE WRITTEN FOR INCLUSION IN IBM RESEARCH REPORT RC20525, *
C*  'FORTRAN ROUTINES FOR USE WITH THE METHOD OF L-MOMENTS, VERSION 3' *
C*                                                                     *
C*  J. R. M. HOSKING                                                   *
C*  IBM RESEARCH DIVISION                                              *
C*  T. J. WATSON RESEARCH CENTER                                       *
C*  YORKTOWN HEIGHTS                                                   *
C*  NEW YORK 10598, U.S.A.                                             *
C*                                                                     *
C*  VERSION 3     AUGUST 1996                                          *
C*                                                                     *
C***********************************************************************
C
C  DIGAMMA FUNCTION (EULER'S PSI FUNCTION) - THE FIRST DERIVATIVE OF
C  LOG(GAMMA(X))
C
C  BASED ON ALGORITHM AS103, APPL. STATIST. (1976) VOL.25 NO.3
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DATA ZERO/0D0/,HALF/0.5D0/,ONE/1D0/
      DATA SMALL/1D-9/,CRIT/13D0/
C
C         C1...C7 ARE THE COEFFTS OF THE ASYMPTOTIC EXPANSION OF DIGAMD
C         D1 IS  -(EULER'S CONSTANT)
C
      DATA C1,C2,C3,C4,C5,C6,C7,D1/
     *  0.83333 33333 33333 333D-1,  -0.83333 33333 33333 333D-2,
     *  0.39682 53968 25396 825D-2,  -0.41666 66666 66666 666D-2,
     *  0.75757 57575 75757 575D-2,  -0.21092 79609 27960 928D-1,
     *  0.83333 33333 33333 333D-1,  -0.57721 56649 01532 861D 0/
      DIGAMD=ZERO
      IF(X.LE.ZERO)GOTO 1000
C
C         USE SMALL-X APPROXIMATION IF X.LE.SMALL
C
      IF(X.GT.SMALL)GOTO 10
      DIGAMD=D1-ONE/X
      RETURN
C
C         REDUCE TO DIGAMD(X+N) WHERE X+N.GE.CRIT
C
   10 Y=X
   20 IF(Y.GE.CRIT)GOTO 30
      DIGAMD=DIGAMD-ONE/Y
      Y=Y+ONE
      GOTO 20
C
C         USE ASYMPTOTIC EXPANSION IF Y.GE.CRIT
C
   30 DIGAMD=DIGAMD+DLOG(Y)-HALF/Y
      Y=ONE/(Y*Y)
      SUM=((((((C7*Y+C6)*Y+C5)*Y+C4)*Y+C3)*Y+C2)*Y+C1)*Y
      DIGAMD=DIGAMD-SUM
      RETURN
C
 1000 WRITE(6,7000)X
      RETURN
C
 7000 FORMAT(' *** ERROR *** ROUTINE DIGAMD :',
     *  ' ARGUMENT OUT OF RANGE :',D24.16)
      END


      subroutine pgen(j)

!!    ~ ~ ~ PURPOSE ~ ~ ~
!!    this subroutine generates precipitation data when the user chooses to
!!    simulate or when data is missing for particular days in the weather file

!!    ~ ~ ~ INCOMING VARIABLES ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    idist       |none          |rainfall distribution code
!!                               |  0 for skewed distribution
!!                               |  1 for mixed exponential distribution
!!    j           |none          |HRU number
!!    i_mo        |none          |month being simulated
!!    npcp(:)     |none          |prior day category
!!                               |1 dry day
!!                               |2 wet day
!!    pcf(:,:)    |none          |normalization factor for precipitation
!!                               |generated from skewed distribution
!!    pcp_stat(:,1,:)|mm/day     |average amount of precipitation falling in
!!                               |one day for the month
!!    pcp_stat(:,2,:)|mm/day     |standard deviation for the average daily
!!                               |precipitation
!!    pcp_stat(:,3,:)|none       |skew coefficient for the average daily
!!                               |precipitation
!!    pr_w(1,:,:) |none          |probability of wet day after dry day in month
!!    pr_w(2,:,:) |none          |probability of wet day after wet day in month
!!    rcor        |none          |correction coefficient for generated rainfall
!!                               |to ensure that the annual means for generated
!!                               |and observed values are comparable. (needed
!!                               |only if IDIST=1)
!!    rexp        |none          |value of exponent for mixed exponential
!!                               |rainfall distribution (needed only if
!!                               |IDIST=1)
!!    rnd3(:)     |none          |random number between 0.0 and 1.0
!!    rndseed(:,:)|none          |random number seeds
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ OUTGOING VARIABLES ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    rnd3(:)     |none          |random number between 0.0 and 1.0
!!    subp(:)     |mm H2O        |precipitation for the day in HRU
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    pcpgen      |mm H2O        |generated precipitation value for the day
!!    r6          |none          |variable to hold intermediate calculation
!!    v8          |none          |random number between 0.0 and 1.0
!!    vv          |none          |random number between 0.0 and 1.0
!!    xlv         |none          |variable to hold intermediate calculation
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~
!!    Intrinsic: Log
!!    SWAT: Aunif, Dstn1

!!    ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~

      use parm

      integer, intent (in) :: j

      real :: vv, pcpgen, v8, r6, xlv

      pcpgen = 0.
      vv = 0.
      vv = Aunif(rndseed(idg(1),j))
      if (vv > pr_w(npcp(j),i_mo,hru_sub(j))) then
        pcpgen = 0.
      else
        v8 = 0.
        v8 = Aunif(rndseed(idg(3),j))
        if (idist == 0) then
          !!skewed rainfall distribution
          r6 = 0.
          xlv = 0.
          r6 = pcp_stat(i_mo,3,hru_sub(j)) / 6.
          xlv = (Dstn1(rnd3(j),v8) - r6) * r6 + 1.
          xlv = (xlv**3 - 1.) * 2. / pcp_stat(i_mo,3,hru_sub(j))
          rnd3(j) = v8
          pcpgen = xlv * pcp_stat(i_mo,2,hru_sub(j)) +
     &                                       pcp_stat(i_mo,1,hru_sub(j))
          pcpgen = pcpgen * pcf(i_mo,hru_sub(j))
        else
          !! mixed exponential rainfall distribution
          pcpgen = ((-Log(v8))**rexp) * pcp_stat(i_mo,1,hru_sub(j)) *
     &                                                              rcor
        end if
        if (pcpgen < .1) pcpgen = .1
      end if

      subp(j) = pcpgen

      if (ievent > 0 .and. subp(j) >= 0.01 .and. pcpsim == 2) then
        call pgenhr(j)
      endif

      return
      end