      SUBROUTINE GTPDAL(P,ABSORB,T,Q,NLEV,WW,MXWLEV,WLEV,X)
C***********************************************************************
C
C   NAME- GTPDAL
C
C   LANGUAGE- FORTRAN       TYPE- SUBROUTINE
C
C   VERSION- 2.0     DATE-  2/01/96     PROGRAMMER- CARLA NEIGH (SMSRC)
C   VERSION- 2.1     DATE-  3/27/96     PROGRAMMER- ROB FELDMAN (SMSRC)
C     ATOVS- 382   ADDED ARRAY Q TO STORE ATMOSPHERIC MIXING RATIO PROF
C   VERSION- 3.0     DATE-  6/17/96     PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.1     DATE- 10/01/96     PROGRAMMER- MIKE PETTEY (HSTX)
C   VERSION- 3.2     DATE- 01/27/98     PROGRAMMER- BRIAN BARIL (RSTX)
C
C   FUNCTION- COMPUTES THE PREDICTORS FOR A GIVEN ATMOSPHERE FOR
C             A GIVEN SPECIES. THE ROUTINE MAY BE
C             CALLED WITH DIFFERENT PARAMETERS DEPENDING UPON THE
C             SPECIES (WET, DRY OR OZONE) REQUIRED.  REFER TO THE
C             PAPER BY MCMILLIN, FLEMING AND HILL (1979, APPLIED
C             OPTICS) FOR A DESCRIPTION OF THE PREDICTORS.
C
C   VERSION 3.0- DOCUMENTATION AND SYNTAX CHANGES FOR ATOVS BASELINE
C                ON THE CRAY
C
C   VERSION 3.1- CHANGES MADE DURING ATOVS OPTIMIZATION TO IMPROVE
C                PERFORMANCE. CALLS TO LININT WERE CHANGED TO INLINE
C                THE CODE. SOME REPETITIVE CALCULATIONS ARE NOW
C                CALCULATED ONCE WITH THE RESULTS BEING STORED IN
C                TEMPORARY VARIABLES. CALLS TO SRWLLN WERE REPLACED
C                WITH INLINE CODE.
C 
C   VERSION 3.2- ADDED THE CONDITION IF ABSORB EQUALS ZERO SET
C                XX() TO ZERO.  OTHERWISE A FLOATING ERROR OCCURS.
C
C   CALLING SEQUENCE PARAMETERS-
C   NAME    TYPE   I/O   DESCRIPTION
C   ----    ----   ---   -----------
C   P       REAL    I    ARRAY (DIM NLEV) OF ATMOSPHERIC PRESSURE
C                        LEVELS.
C   ABSORB  REAL    I    ARRAY (DIM NLEV) OF THE ATMOSPHERIC
C                        ABSORBER PROFILE ON THE SLANT PATH.
C   T       REAL    I    ARRAY (DIM NLEV) CONTAINING THE ATMOSPHERIC
C                        TEMPERATURE PROFILE.
C   Q       REAL    I    ARRAY (DIM NLEV) CONTAING THE ATMOSPHERIC MIXIN
C                        RATIO PROFILE.
C   NLEV    INT     I    NUMBER OF ATMOSPHERIC LEVELS.
C   WW      REAL    I    ARRAY (DIM 0:OPTPARM:NW) CONTAINING THE STANDAR
C                        ABSORBER PROFILE.
C   MXWLEV  INT     I    NUMBER OF LEVELS TO BE FILLED IN ABSORBER SPACE
C   WLEV    REAL    I    ARRAY (DIM MXWLEV) CONTAINING THE INDEX OF
C                        ABSORBER SPACE LEVELS TO BE INTERPOLATED TO.
C   X       REAL    O    ARRAY (DIM OPTPARM:NW X OPTPARM:NPOSP) OF VARIO
C                        PREDICTORS AS FOLLOWS:
C                       (NOTE IN THE FOLLOWING DESCRIPTION
C                                         'X' IS MULTIPLICATION,
C                                         '^' IS EXPONENTION
C                                         '*' IS A "STAR'D" QUANTITY)
C                                    X(1):  T	
C                                    X(2):  P	
C                                    X(3):  T^2
C                                    X(4):  P^2
C                                    X(5):  TXP
C                                    X(6):  T^2XP
C                                    X(7):  TXP^2
C                                    X(8):  T^2XP^2
C                                    X(9):  T*
C                                    X(10): P*
C                                    X(11): T**
C                                    X(12): P**
C                                    X(13): T***
C                                    X(14): P***	
C                                    X(15): Q
C
C
C   COMMON AREA PARAMETERS-
      INCLUDE 'OPTPARM'
C
C   LOCAL PARAMETERS-
C   NAME    TYPE   DESCRIPTION
C   ----    ----   -----------
C   DELA    REAL   HOLDS DIFFERENCE BETWEEN ABSORBER VALUES
C   DENOM   REAL   TEMPORARY VARIABLE (DENOMINATOR)
C   S1-S6   REAL   SUMS USED IN COMPUTATION OF STAR'D QUANTITIES
C   I,J,K   INT    DO LOOP INDICES
C   KT      INT    INDEX FOR ABSORBER SPACE LEVEL
C   M1      INT    FIRST LEVEL FOR INTERPOLATION- RETURNED BY SRWLLN
C   M1PLUS  INT    EQUAL TO (M1+1)
C   XX1-XX6 REAL   STAR'D QUANTITIES IN PRESSURE SPACE
C   TMPVAL  REAL   TEMPORARY VALUE
C
C   SUBPROGRAMS CALLED- NONE
C
C   FUNCTIONS USED- NONE
C
C   EXIT STATES-  NONE
C
C   COMMENTS-  THIS IS BASED ON THE SUBROUTINE NAMED
C              'GET_PREDICTORS_ALL' WRITTEN BY THOMAS J. KLEESPIES
C              OF THE ORA PHYSICS BRANCH.
C
C***********************************************************************
C
      INTEGER  NLEV, MXWLEV, WLEV(MXWLEV)
      REAL     X(NW,NPOSP)	
      REAL     P(NLEV), ABSORB(NLEV), T(NLEV), Q(NLEV), WW(0:NW)

      REAL     DELA, S1, S2, S3, S4, S5, S6
      REAL     XX1(NLEVEL), XX2(NLEVEL), XX3(NLEVEL), XX4(NLEVEL)
      REAL     XX5(NLEVEL), XX6(NLEVEL)
      INTEGER  I, J, K, KT, M1, M1PLUS
      REAL     DENOM, TMPVAL


C-- INITIALIZE THE ARRAY

      DO I = 1, NW
         DO J = 1, NPOSP
	   X(I,J) = 0.0
         END DO
      END DO

C-- FIRST COMPUTE STAR'D TERMS FOR THE SPECIFIED ATMOSPHERE
C   I.E. ON PRESSURE LEVELS
C   (NOTE:  IF WE TREAT T(0) = 0 AND P(0) = 0, THEN
C   ABSORB(0) = 0.)

      IF (ABSORB(1) .GT. 0.0) THEN
	 XX1(1) = T(1) / 2.
	 XX2(1) = P(1) / 2.
	 XX3(1) = T(1) / 2.
	 XX4(1) = P(1) / 2.
	 XX5(1) = T(1) / 2.
	 XX6(1) = P(1) / 2.
      ELSE
	 XX1(1) = 0.0
	 XX2(1) = 0.0
	 XX3(1) = 0.0
	 XX4(1) = 0.0
	 XX5(1) = 0.0
	 XX6(1) = 0.0
      END IF

      S1 = 0.0
      S2 = 0.0
      S3 = 0.0
      S4 = 0.0
      S5 = 0.0
      S6 = 0.0

      DO 50 K = 2, NLEV
	 DELA = ABSORB(K) - ABSORB(K-1)
	 S1 = S1 + (T(K)+T(K-1))*DELA	
	 S2 = S2 + (P(K)+P(K-1))*DELA	
	 S3 = S3 + (ABSORB(K)*T(K) + ABSORB(K-1)*T(K-1))*DELA
	 S4 = S4 + (ABSORB(K)*P(K) + ABSORB(K-1)*P(K-1))*DELA
	 S5 = S5 + (ABSORB(K)*ABSORB(K)*T(K) +
     +		    ABSORB(K-1)*ABSORB(K-1)*T(K-1))*DELA
	 S6 = S6 + (ABSORB(K)*ABSORB(K)*P(K) +
     +		    ABSORB(K-1)*ABSORB(K-1)*P(K-1))*DELA

 	 IF((S1 .EQ. 0.0).OR.(ABSORB(K).EQ.0.0)) THEN
 	   XX1(K) = 0.0
 	 ELSE
	   XX1(K) = S1/(2.0*ABSORB(K))
 	 END IF

 	 IF((S2 .EQ. 0.0).OR.(ABSORB(K).EQ.0.0)) THEN
 	   XX2(K) = 0.0
 	 ELSE
 	   XX2(K) = S2/(2.0*ABSORB(K))
 	 END IF

 	 IF((S3 .EQ. 0.0).OR.(ABSORB(K).EQ.0.0)) THEN
 	   XX3(K) = 0.0
 	 ELSE
 	   XX3(K) = S3/(ABSORB(K)*ABSORB(K))
 	 END IF

 	 IF((S4 .EQ. 0.0).OR.(ABSORB(K).EQ.0.0)) THEN
 	   XX4(K) = 0.0
 	 ELSE
 	   XX4(K) = S4/(ABSORB(K)*ABSORB(K))
 	 END IF

 	 IF((S5 .EQ. 0.0).OR.(ABSORB(K).EQ.0.0)) THEN
 	   XX5(K) = 0.0
 	 ELSE
 	   XX5(K) = 1.5*S5/(ABSORB(K)*ABSORB(K)*ABSORB(K))
 	 END IF

 	 IF((S6 .EQ. 0.0).OR.(ABSORB(K).EQ.0.0)) THEN
 	   XX6(K) = 0.0
 	 ELSE
 	   XX6(K) = 1.5*S6/(ABSORB(K)*ABSORB(K)*ABSORB(K))
 	 END IF

   50 CONTINUE


C-- NEXT COMPUTE FOR THE STANDARD ABSORBER LEVELS

      M1 = 1

      DO 200 K = 1, MXWLEV	

	  KT = WLEV(K)

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

	  IF (X(KT,1) .NE. 0) GO TO 200

C-- SEARCH THE  ATMOSPHERIC ABSORBER PROFILE FOR THE BEST BRACKETING
C   VALUES

          DO I = M1, NLEV
             IF (WW(KT) .LT. ABSORB(I)) THEN
                J = I
                GO TO 100
             END IF
          END DO

          J = NLEV

 100      IF (J .LE. 1) THEN
             M1 = 1
          ELSE IF (J .EQ. NLEV) THEN
             M1 = NLEV - 1
          ELSE
             M1 = J - 1
          END IF

C-- M1PLUS HOLDS THE VALUE OF M1+1. THIS ELIMINATES THE NEED TO
C   REPETIVELY CALCULATE THE VALUE

          M1PLUS = M1 + 1

C-- THE CALLS TO LININT WERE REMOVED. THE CODE WITHIN LININT HAS BEEN
C   MOVED HERE

          DENOM  = ABSORB(M1PLUS) - ABSORB(M1)

          IF (DENOM .EQ. 0.0) THEN
             X(KT,1) = T(M1PLUS)
             X(KT,2) = P(M1PLUS)
          ELSE
             TMPVAL = (ABSORB(M1PLUS)-WW(KT)) / DENOM
             X(KT,1) = T(M1PLUS) - (T(M1PLUS)-T(M1))*TMPVAL
             X(KT,2) = P(M1PLUS) - (P(M1PLUS)-P(M1))*TMPVAL
          END IF

	  X(KT,3) = X(KT,1)*X(KT,1)		
	  X(KT,4) = X(KT,2)*X(KT,2) 		
	  X(KT,5) = X(KT,1)*X(KT,2) 	
	  X(KT,6) = X(KT,3)*X(KT,2)
	  X(KT,7) = X(KT,1)*X(KT,4)
	  X(KT,8) = X(KT,3)*X(KT,4)

C-- THE CALLS TO LININT WERE REMOVED. THE CODE WITHIN LININT HAS BEEN
C   MOVED HERE.

          IF (DENOM .EQ. 0.0) THEN
             X(KT,9)  = XX1(M1PLUS)
             X(KT,10) = XX2(M1PLUS)
             X(KT,11) = XX3(M1PLUS)
             X(KT,12) = XX4(M1PLUS)
             X(KT,13) = XX5(M1PLUS)
             X(KT,14) = XX6(M1PLUS)
             X(KT,15) = Q(M1PLUS)
          ELSE
             X(KT,9)  = XX1(M1PLUS) - (XX1(M1PLUS)-XX1(M1))*TMPVAL
             X(KT,10) = XX2(M1PLUS) - (XX2(M1PLUS)-XX2(M1))*TMPVAL
             X(KT,11) = XX3(M1PLUS) - (XX3(M1PLUS)-XX3(M1))*TMPVAL
             X(KT,12) = XX4(M1PLUS) - (XX4(M1PLUS)-XX4(M1))*TMPVAL
             X(KT,13) = XX5(M1PLUS) - (XX5(M1PLUS)-XX5(M1))*TMPVAL
             X(KT,14) = XX6(M1PLUS) - (XX6(M1PLUS)-XX6(M1))*TMPVAL
             X(KT,15) = Q(M1PLUS)   - (Q(M1PLUS)-Q(M1))*TMPVAL
          END IF

  200 CONTINUE	

      RETURN
      END


