      SUBROUTINE OPTSPE(NLEV,NCOEFF,NPRED,B,WW,P,T,Q,ABSORB,NCHNUS,CHAN,
     +                  PRDIDX,OD)
C**********************************************************************
C
C   NAME- OPTSPE
C
C   LANGUAGE- FORTRAN      TYPE- SUBROUTINE
C
C   VERSION- 2.0     DATE-  2/9/96     PROGRAMMER- CARLA NEIGH (SMSRC)
C   VERSION- 2.1     DATE-  3/27/96    PROGRAMMER- ROBERT FELDMAN (SMSRC
C     ATOVS- 383    ADDITION OF ARRAY Q WHICH CONTAINS THE ATMOSPHERIC
C                   MIXING RATIO PROFILE
C   VERSION- 3.0     DATE-  6/17/96    PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.1     DATE- 10/04/96    PROGRAMMER- MIKE PETTEY (HSTX)
C
C   FUNCTION- THIS ROUTINE WILL DETERMINE THE OPTICAL DEPTH PROFILE
C             GIVEN THE PRESSURE PROFILE, TEMPERATURE PROFILE AND
C             ABSORBER PROFILE.  THIS ROUTINE IS GENERALIZED SUCH
C             THAT IT WILL WORK WITH ANY SPECIES.
C
C   VERSION 3.0- DOCUMENTATION AND SYNTAX CHANGES FOR ATOVS BASELINE
C                ON THE CRAY
C   VERSION 3.1- CHANGES MADE DURING ATOVS OPTIMIZATION TO IMPROVE
C                EXECUTION TIME
C
C   CALLING SEQUENCE PARAMETERS-
C   NAME    TYPE   I/O   DESCRIPTION
C   ----    ----   ---   -----------
C   NLEV    INT     I    NUMBER OF LEVELS IN INPUT ATMOSPHERE.
C   NCOEFF  INT     I    NUMBER OF COEFFICIENTS.
C   NPRED   INT     I    NUMBER OF PREDICTORS.
C   B       REAL    I    ARRAY (DIM NCOEFF X OPTPARM:NW X OPTPARM:NCHAN)
C                        CONTAINING THE REGRESSION COEFFICIENTS FOR THIS
C                        SPECIES.
C   WW      REAL    I    ARRAY (DIM 0:OPTPARM:NW) CONTAINING THE ABSORBE
C                        SPACE FOR THIS SPECIES.
C   P       REAL    I    ARRAY (DIM NLEV) CONTAINING THE ATMOSPHERIC
C                        PRESSURE PROFILE.
C   T       REAL    I    ARRAY (DIM NLEV) CONTAINING THE ATMOSPHERIC
C                        TEMPERATURE PROFILE.
C   Q       REAL    I    ARRAY (DIM NLEV) CONTAING THE ATMOSPHERIC
C                        MIXING RATIO PROFILE.
C   ABSORB  REAL    I    ARRAY (DIM NLEV) CONTAINING THE SLANT PATH
C                        ABSORBER PROFILE.
C   NCHNUS  INT     I    NUMBER OF CHANNELS.
C   CHAN    INT     I    ARRAY (DIM NCHNUS) CONTAINING THE CHANNELS TO
C                        USE.
C   PRDIDX  INT     I    ARRAY (DIM 0:NPRED X OPTPARM:NCHAN) OF THE INDE
C                        OF PREDICTORS TO USE FOR EACH CHANNEL.
C   OD      REAL    O    ARRAY (DIM NLEV X NCHNUS) CONTAINING THE
C                        OPTICAL DEPTH IN PRESSURE SPACE.
C
C   COMMON AREA PARAMETERS-
      INCLUDE 'OPTPARM'
C
C   LOCAL PARAMETERS-
C   NAME    TYPE   DESCRIPTION
C   ----    ----   -----------
C   SUM     REAL   SUMMATION VARIABLE.
C   AVGABS  REAL   AVERAGE ABSORBER AMOUNT.
C   KW      REAL   PREDICTAND IN ABSORBER SPACE.
C   KP      REAL   ABSORPTION COEFFICIENTS IN PRESSURE SPACE.
C   DP      REAL   ABSORBER WITHIN LAYER.
C   FACTOR  REAL   LINEAR INTERPOLATION FACTOR.
C   I       INT    DO LOOP VARIABLE.
C   LEVEL   INT    DO LOOP VARIABLE FOR LEVEL.
C   KT      INT    INDEX INTO ABSORBER SPACE.
C   ICHAN   INT    HOLDS ACTUAL CHANNEL TO USE IN COMPUTATIONS.
C   JCHAN   INT    DO LOOP INDEX FOR CHANNEL.
C   K1      INT    HOLDS FIRST LEVEL FOR INTERPOLATION.
C   K2      INT    HOLDS SECOND LEVEL FOR INTERPOLATION.
C   IPRED   INT    DO LOOP COUNTER FOR PREDICTORS.
C   MAXWLV  INT    ACTUAL NUMBER OF LEVELS USED IN W SPACE.
C   WLEV    INT    INDEX ARRAY POINTING TO THE W SPACE LEVELS
C                  ACTUALLY USED.
C   M       INT    INDEX FOR INTERPOLATION.
C   SEARCH  LOG    USED BY SRPLLN, SET TO .TRUE. FOR FIRST CALL
C                  FOR A PROFILE AND SUBSEQUENTLY RETURNED AS
C                  .FALSE..
C   XX      REAL   ARRAY (DIM NW X 14) OF PREDICTORS RETURNED
C                  FROM GTPDAL.
C
C   SUBPROGRAMS CALLED- SRPLLN, GTPDAL
C
C   EXIT STATES- NONE
C
C   COMMENTS-  THIS ROUTINE IS BASED ON THE SUBROUTINE NAMED
C              'OPTRANS_SPECIES' WRITTEN BY THOMAS J. KLEESPIES
C              OF THE ORA PHYSICS BRANCH.
C
C***********************************************************************
C
      INTEGER NLEV, NCOEFF, NPRED, NCHNUS
      INTEGER CHAN(NCHNUS), PRDIDX(0:NPRED,NCHAN)
      REAL B(NCOEFF,NW,NCHAN)
      REAL WW(0:NW), P(NLEV), T(NLEV), Q(NLEV), ABSORB(NLEV)
      REAL OD(NLEVEL,NCHNUS)

      INTEGER I, LEVEL, KT, ICHAN, JCHAN, K2, K1, IPRED, MAXWLV	
      INTEGER WLEV(NW), M
      INTEGER START, II, JJ
      LOGICAL SEARCH	
      REAL SUM	
      REAL AVGABS, KW(NW), KP(NLEVEL), DP(NLEVEL), FACTOR(NLEVEL)
      REAL XX(NW,NPOSP)


C-- THE FOLLOWING LOOP WAS SPLIT UP TO INCLUDE THE CASE WHERE LEVEL=1
C   AND THE CASES WHERE LEVEL>1. THIS ELIMINATES THE NEED TO HAVE
C   CONDITIONALS THAT DETERMINE WHETHER OR NOT LEVEL IS 1.

C-- FIND VALUES IN W SPACE THAT BRACKET THE ABSORBER LEVELS

      KT = 1

      AVGABS = ABSORB(1) / 2.

      START = 0

      DO II = START, NW
         IF (AVGABS .LT. WW(II)) THEN
            JJ = II
            GO TO 10
         END IF
      END DO

      JJ = NW

 10   M = MAX(JJ-1,1)

      WLEV(KT) = M
      WLEV(KT+1) = M+1
      FACTOR(1) = (WW(M+1) - AVGABS)/(WW(M+1)-WW(M))
      KT = KT + 2

      DP(1) = ABSORB(1)

      DO 40 LEVEL = 2, NLEV
         AVGABS = (ABSORB(LEVEL)+ABSORB(LEVEL-1)) / 2.

         START = M

         DO II = START, NW
            IF (AVGABS .LT. WW(II)) THEN
               JJ = II
               GO TO 20
            END IF
         END DO

         JJ = NW

 20      M = MAX(JJ-1,1)

         WLEV(KT) = M
         WLEV(KT+1) = M+1
         FACTOR(LEVEL) = (WW(M+1) - AVGABS)/(WW(M+1)-WW(M))
         DP(LEVEL) = (ABSORB(LEVEL)-ABSORB(LEVEL-1))
         KT = KT + 2
   40 CONTINUE

      MAXWLV = KT - 1

C-- COMPUTE THE PREDICTORS FOR THIS ATMOSPHERE

      CALL GTPDAL(P,ABSORB,T,Q,NLEV,WW,MAXWLV,WLEV,XX)

      DO 300 JCHAN = 1 , NCHNUS

         ICHAN = CHAN(JCHAN)

         IF (PRDIDX(0,ICHAN) .LT. 1) THEN

C-- NO ABSORPTION FOR THIS CHANNEL

            DO 80 LEVEL = 1, NLEV
               OD(LEVEL,JCHAN) = 0.0
   80       CONTINUE
            GO TO 300
         ENDIF

C-- ZERO KW ARRAY

         DO 100 I = 1, NW
            KW(I) = 0.0
  100    CONTINUE

C-- COMPUTE K IN W SPACE

         DO 200 I = 1, MAXWLV

            K1 = WLEV(I)

C-- CHECK TO SEE IF THIS LEVEL HAS ALREADY BEEN DONE

            IF (KW(K1) .EQ. 0.0) THEN
               SUM = B(1,K1,ICHAN)

               DO 150 IPRED = 2, NCOEFF
                 SUM=SUM+B(IPRED,K1,ICHAN)*XX(K1,PRDIDX(IPRED-1,ICHAN))
 150           CONTINUE

               KW(K1) = SUM
            END IF
  200    CONTINUE

C-- INTERPOLATE BACK TO P SPACE

         DO 240 LEVEL = 1 , NLEV
            KT = 2*(LEVEL-1) + 1
            K1 = WLEV(KT)
            K2 = WLEV(KT+1)
            KP(LEVEL) = KW(K2) - (KW(K2)-KW(K1))*FACTOR(LEVEL)
            IF(KP(LEVEL) .LT. 0.0) KP(LEVEL) = 0.0
  240    CONTINUE

C-- COMPUTE OPTICAL DEPTH

         OD(1,JCHAN) = 0.0

         DO 280 LEVEL = 1 , NLEV
	    OD(LEVEL,JCHAN) = DP(LEVEL)*KP(LEVEL)
  280   CONTINUE

  300 CONTINUE

      RETURN
      END

