      SUBROUTINE OTLFT2(PBND,TBND,QBND,SLINDX)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .     
C SUBPROGRAM:    OTLFT2      COMPUTES LIFTED INDEX
C   PRGRMMR: TREADON         ORG: W/NP2      DATE: 93-03-10       
C     
C ABSTRACT:
C     THIS ROUTINE COMPUTES LIFTS A PARCEL SPECIFIED BY THE
C     PASSED PRESSURE, TEMPERATURE, AND SPECIFIC HUMIDITY TO
C     500MB AND THEN COMPUTES A LIFTED INDEX.  THIS LIFTED 
C     LIFTED INDEX IS THE DIFFERENCE BETWEEN THE LIFTED 
C     PARCEL'S TEMPERATURE AT 500MB AND THE AMBIENT 500MB
C     TEMPERATURE.
C   .     
C     
C PROGRAM HISTORY LOG:
C   93-03-10  RUSS TREADON - MODIFIED OTLIFT2 TO LIFT PARCELS
C                            SPECIFIED BY PASSED P, T, AND Q.
C   98-06-15  T BLACK      - CONVERSION FROM 1-D TO 2-D
C   00-01-04  JIM TUCCILLO - MPI VERSION
C     
C USAGE:    CALL OTLFT2(PBND,TBND,QBND,SLINDX)
C   INPUT ARGUMENT LIST:
C     PBND     - PARCEL PRESSURE.
C     TBND     - PARCEL TEMPERATURE.
C     QBND     - PARCEL SPECIFIC HUMIDITY.
C
C   OUTPUT ARGUMENT LIST: 
C     SLINDX   - LIFTED INDEX.
C     
C   OUTPUT FILES:
C     NONE
C     
C   SUBPROGRAMS CALLED:
C     UTILITIES:
C       NONE
C     LIBRARY:
C       COMMON   - CTLBLK
C                  LOOPS
C                  MASKS
C                  PHYS
C                  VRBLS
C                  EXTRA
C     
C   ATTRIBUTES:
C     LANGUAGE: FORTRAN
C     MACHINE : CRAY C-90
C$$$  
C     
C     
C     SET LOCAL PARAMETERS.
      PARAMETER
     & (D00=0.E0,H10E5=100000.E0,H5E4=5.E4,CAPA=0.28589641
     &, D8202=.820231E0)
      PARAMETER
     & (ELIVW=2.72E6,CP=1004.6E0,ELOCP=ELIVW/CP)
C     
C     INCLUDE GLOBAL PARAMETERS.
      INCLUDE "parmeta"
      INCLUDE "parm.tbl"
C     
C     SET DEPENDENT PARAMETERS.
      PARAMETER
     & (JAM=6+2*(JM-10),LP1=LM+1)
C     
C     DECLARE VARIABLES.
C
                            L O G I C A L
     & RUN,FIRST,RESTRT,SIGMA
C
                            D I M E N S I O N
     & ITTB  (IM,JM),IQTB  (IM,JM),IPTB  (IM,JM),ITHTB (IM,JM)
     &,TBT   (IM,JM),QBT   (IM,JM)
     &,APEBT (IM,JM),TTHBT (IM,JM),TTH   (IM,JM),PP    (IM,JM)
     &,BQS00 (IM,JM),SQS00 (IM,JM),BQS10 (IM,JM),SQS10 (IM,JM)
     &,BQ    (IM,JM),SQ    (IM,JM),TQ    (IM,JM),QQ    (IM,JM)
     &,P00   (IM,JM),P10   (IM,JM),P01   (IM,JM),P11   (IM,JM)
     &,TPSP  (IM,JM),APESP (IM,JM),TTHES (IM,JM)
     &,PSP   (IM,JM),THBT  (IM,JM),THESP (IM,JM)
     &,P     (IM,JM),TP    (IM,JM),BTH   (IM,JM),STH   (IM,JM)
     &,BTHE00(IM,JM),STHE00(IM,JM),BTHE10(IM,JM),STHE10(IM,JM)
     &,T00   (IM,JM),T10   (IM,JM),T01   (IM,JM),T11   (IM,JM)
     &,PARTMP(IM,JM)
     &,SLINDX(IM,JM)
     &,PBND  (IM,JM),TBND  (IM,JM),QBND  (IM,JM)
C     
C     INCLUDE COMMON BLOCKS.
      INCLUDE "CTLBLK.comm"
      INCLUDE "LOOPS.comm"
      INCLUDE "MASKS.comm"
      INCLUDE "PHYS.comm"
      INCLUDE "VRBLS.comm"
      INCLUDE "EXTRA.comm"
C     
C     DECLARE EQUIVALENCES.
       EQUIVALENCE
     & (ITTB  (1,1),IPTB  (1,1)                           )
     &,(IQTB  (1,1),ITHTB (1,1)                           )
     &,(QQ    (1,1),APESP (1,1),TTHES (1,1)               )
     &,(TTH   (1,1),TQ    (1,1),TP    (1,1)               )
       EQUIVALENCE
     & (BQS00 (1,1),P00   (1,1),BTHE00(1,1),T00   (1,1)   )
     &,(SQS00 (1,1),P10   (1,1),STHE00(1,1),T10   (1,1)   )
     &,(BQS10 (1,1),P01   (1,1),BTHE10(1,1),T01   (1,1)   )
     &,(SQS10 (1,1),P11   (1,1),STHE10(1,1),T11   (1,1)   )
     &,(BQ    (1,1)          ,BTH   (1,1)                 )
     &,(SQ    (1,1)          ,STH   (1,1)                 )

C
C     
C********************************************************************
C     START OTLFT2 HERE.
C     
C     ZERO LIFTED INDEX ARRAY.
C
      DO J=JSTA,JEND
      DO I=1,IM
        SLINDX(I,J)=D00
      ENDDO
      ENDDO
C
C--------------FIND EXNER IN BOUNDARY LAYER-----------------------------
C
      doout130: DO J=JSTA_M2,JEND_M2
      doin130: DO I=2,IM-1
       TBT(I,J)   = TBND(I,J)
       QBT(I,J)   = QBND(I,J)
       APEBT(I,J) = PBND(I,J)
       APEBT(I,J) = (H10E5/APEBT(I,J))**CAPA
      END DO doin130
      END DO doout130
C
C--------------SCALING POTENTIAL TEMPERATURE & TABLE INDEX--------------
C
      doout140: DO J=JSTA_M2,JEND_M2
      doin140: DO I=2,IM-1
       TTHBT(I,J)=TBT(I,J)*APEBT(I,J)
       TTH(I,J)=(TTHBT(I,J)-THL)*RDTH
       QQ(I,J)=TTH(I,J)-AINT(TTH(I,J))
       ITTB(I,J)=INT(TTH(I,J))+1
      END DO doin140
      END DO doout140
C
C--------------KEEPING INDICES WITHIN THE TABLE-------------------------
C
      doout145: DO J=JSTA_M2,JEND_M2
      doin145: DO I=2,IM-1
      IF(ITTB(I,J).LT.1)THEN
        ITTB(I,J)=1
        QQ(I,J)=D00
      ENDIF
      IF(ITTB(I,J).GE.JTB)THEN
        ITTB(I,J)=JTB-1
        QQ(I,J)=D00
      ENDIF
      END DO doin145
      END DO doout145
C
C--------------BASE AND SCALING FACTOR FOR SPEC. HUMIDITY---------------
C
      doout150: DO J=JSTA_M2,JEND_M2
      doin150: DO I=2,IM-1
      ITTBK=ITTB(I,J)
      BQS00(I,J)=QS0(ITTBK)
      SQS00(I,J)=SQS(ITTBK)
      BQS10(I,J)=QS0(ITTBK+1)
      SQS10(I,J)=SQS(ITTBK+1)
      END DO doin150
      END DO doout150
C
C--------------SCALING SPEC. HUMIDITY & TABLE INDEX---------------------
C
      doout160: DO J=JSTA_M2,JEND_M2
      doin160: DO I=2,IM-1
      BQ(I,J)=(BQS10(I,J)-BQS00(I,J))*QQ(I,J)+BQS00(I,J)
      SQ(I,J)=(SQS10(I,J)-SQS00(I,J))*QQ(I,J)+SQS00(I,J)
      TQ(I,J)=(QBT(I,J)-BQ(I,J))/SQ(I,J)*RDQ
      PP(I,J)=TQ(I,J)-AINT(TQ(I,J))
      IQTB(I,J)=INT(TQ(I,J))+1
      END DO doin160
      END DO doout160
C
C--------------KEEPING INDICES WITHIN THE TABLE-------------------------
C
      doout165: DO J=JSTA_M2,JEND_M2
      doin165: DO I=2,IM-1
        IF(IQTB(I,J).LT.1)THEN
        IQTB(I,J)=1
        PP(I,J)=D00
      ENDIF
      IF(IQTB(I,J).GE.ITB)THEN
        IQTB(I,J)=ITB-1
        PP(I,J)=D00
      ENDIF
      END DO doin165
      END DO doout165
C
C--------------SATURATION PRESSURE AT FOUR SURROUNDING TABLE PTS.-------
C
      doout170: DO J=JSTA_M2,JEND_M2
      doin170: DO I=2,IM-1
      IQ=IQTB(I,J)
      IT=ITTB(I,J)
      P00(I,J)=PTBL(IQ,IT)
      P10(I,J)=PTBL(IQ+1,IT)
      P01(I,J)=PTBL(IQ,IT+1)
      P11(I,J)=PTBL(IQ+1,IT+1)
      END DO doin170
      END DO doout170
C
C--------------SATURATION POINT VARIABLES AT THE BOTTOM-----------------
C
      doout180: DO J=JSTA_M2,JEND_M2
      doin180: DO I=2,IM-1
      TPSP(I,J)=P00(I,J)+(P10(I,J)-P00(I,J))*PP(I,J)
     1                  +(P01(I,J)-P00(I,J))*QQ(I,J)
     2      +(P00(I,J)-P10(I,J)-P01(I,J)+P11(I,J))*PP(I,J)*QQ(I,J)
      IF(TPSP(I,J).LE.D00)TPSP(I,J)=H10E5
      APESP(I,J)=(H10E5/TPSP(I,J))**CAPA
      TTHES(I,J)=TTHBT(I,J)*EXP(ELOCP*QBT(I,J)*APESP(I,J)/TTHBT(I,J))
      END DO doin180
      END DO doout180
C
C-----------------------------------------------------------------------
C
      DO J=JSTA_M2,JEND_M2
      DO I=2,IM-1
        PSP(I,J)=TPSP(I,J)
        THBT(I,J)=TTHBT(I,J)
        THESP(I,J)=TTHES(I,J)
      ENDDO
      ENDDO
C
C-----------------------------------------------------------------------
C
 190  CONTINUE
C
C--------------SCALING PRESSURE & TT TABLE INDEX------------------------
C
      doout210: DO J=JSTA_M2,JEND_M2
      doin210: DO I=2,IM-1
      P (I,J)=H5E4
      TP(I,J)=(P(I,J)-PL)*RDP
      QQ(I,J)=TP(I,J)-AINT(TP(I,J))
      IPTB(I,J)=INT(TP(I,J))+1
      END DO doin210
      END DO doout210
C
C--------------KEEPING INDICES WITHIN THE TABLE-------------------------
C
      doout215: DO J=JSTA_M2,JEND_M2
      doin215: DO I=2,IM-1
      IF(IPTB(I,J).LT.1)THEN
        IPTB(I,J)=1
        QQ(I,J)=D00
      ENDIF
      IF(IPTB(I,J).GE.ITB)THEN
        IPTB(I,J)=ITB-1
        QQ(I,J)=D00
      ENDIF
      END DO doin215
      END DO doout215
C
C--------------BASE AND SCALING FACTOR FOR THE--------------------------
C
      doout220: DO J=JSTA_M2,JEND_M2
      doin220: DO I=2,IM-1
      IPTBK=IPTB(I,J)
      BTHE00(I,J)=THE0(IPTBK)
      STHE00(I,J)=STHE(IPTBK)
      BTHE10(I,J)=THE0(IPTBK+1)
      STHE10(I,J)=STHE(IPTBK+1)
      END DO doin220
      END DO doout220
C
C--------------SCALING THE & TT TABLE INDEX-----------------------------
C
      doout230: DO J=JSTA_M2,JEND_M2
      doin230: DO I=2,IM-1
      BTH(I,J)=(BTHE10(I,J)-BTHE00(I,J))*QQ(I,J)+BTHE00(I,J)
      STH(I,J)=(STHE10(I,J)-STHE00(I,J))*QQ(I,J)+STHE00(I,J)
      TTH(I,J)=(THESP(I,J)-BTH(I,J))/STH(I,J)*RDTHE
      PP(I,J)=TTH(I,J)-AINT(TTH(I,J))
      ITHTB(I,J)=INT(TTH(I,J))+1
      END DO doin230
      END DO doout230
C
C--------------KEEPING INDICES WITHIN THE TABLE-------------------------
C
      doout235: DO J=JSTA_M2,JEND_M2
      doin235: DO I=2,IM-1
      IF(ITHTB(I,J).LT.1)THEN
        ITHTB(I,J)=1
        PP(I,J)=D00
      ENDIF
      IF(ITHTB(I,J).GE.JTB)THEN
        ITHTB(I,J)=JTB-1
        PP(I,J)=D00
      ENDIF
      END DO doin235
      END DO doout235
C
C--------------TEMPERATURE AT FOUR SURROUNDING TT TABLE PTS.------------
C
      doout240: DO J=JSTA_M2,JEND_M2
      doin240: DO I=2,IM-1
      ITH=ITHTB(I,J)
      IP=IPTB(I,J)
      T00(I,J)=TTBL(ITH,IP)
      T10(I,J)=TTBL(ITH+1,IP)
      T01(I,J)=TTBL(ITH,IP+1)
      T11(I,J)=TTBL(ITH+1,IP+1)
      END DO doin240
      END DO doout240
C
C--------------PARCEL TEMPERATURE AT 500MB----------------------------
C
      doout300: DO J=JSTA_M2,JEND_M2
      doin300: DO I=2,IM-1
      IF(TPSP(I,J).GE.H5E4)THEN
        PARTMP(I,J)=(T00(I,J)+(T10(I,J)-T00(I,J))*PP(I,J)
     1                       +(T01(I,J)-T00(I,J))*QQ(I,J)
     2         +(T00(I,J)-T10(I,J)-T01(I,J)+T11(I,J))*PP(I,J)*QQ(I,J))
      ELSE
        PARTMP(I,J)=TBT(I,J)*APEBT(I,J)*D8202
      ENDIF
C
C--------------LIFTED INDEX---------------------------------------------
C
      SLINDX(I,J)=T500(I,J)-PARTMP(I,J)
      END DO doin300
      END DO doout300
C     
C     END OF ROUTINE.
      RETURN
      END
