SUBROUTINE MSTADB(H,PRESS,TIN,IT,KM,THE,TMST,QMST,KTOP,IER)
C     THIS ROUTINE ACCEPTS INPUT DATA OF
C         H=SURFACE PRESSURE DVDED BY 100 CBS
C         PRESS(K=1,--,KM) = FACTOR SUCH THAT P AT LVL K = H*PRESS(K)
C         TIN(1 + (K-1)*IT ) = INPUT TEMPS IN A COLUMN
C         KM=NUMBER OF LEVELS
C     AND RETURNS
C         THE IS EQUIV POT TEMP OF LAYER 1 (ASSUMING SATN)
C         KTOP (G.T.E 1 AND L.T.E. KM) IS HIGHEST LVL FOR WHICH
C              TIN IS COLDER THAN MOIST ADIABAT GIVEN BY THE
C              (KTOP=1 DENOTES TIN(K=2) IS ALREADY G.T.E. MOIST ADB.)
C                   ALLOWANCE IS MADE FOR PERHAPS ONE LEVEL BELOW KTOP
C                  AT WHICH TIN WAS WARMER THAN TMST.
C         TMST(K) AND QMST(K) FOR K=2,--,KTOP, ARE TEMP AND SAT SPEC
C              HUMS ON MOIST ADB THE.
C
C     OTHER SUBROUTINES USED ARE SATVAP AND SATVP1
C
C     PRESSURE IN LAYER ONE MUST LIE BETWEEN 50 AND 110 CBS.
C     TEMP IN LAYER ONE MUST LIE BETWEEN 220 AND 330 DEGREES
C     THE RESULTING THE MUST LIE BETWEEN 220 AND 500 DEGREES.
C         ( THE IS TESTED FOR THIS POSSIBILITY, AN ERROR RETURN OF
C         IER=0 DENOTING OKEH CONDITIONS, A RETURN OF IER=1 DENOTING
C         VIOLATION OF THIS RANGE.)
C
CJPB  REAL*4 T3,CP,L3,RD,RV,CL,THETAE(13,12),T,ES(13),KAPPA
      REAL   T3,CP,L3,RD,RV,CL,THETAE(13,12),T,ES(13),KAPPA
CJPB  REAL*4 TFMTHE(29,12),ESS
      REAL   TFMTHE(29,12),ESS
CJPB  REAL*4 QFMTHE(29,12)
      REAL   QFMTHE(29,12)
      DIMENSION PRESS(1),TIN(1),TMST(1),QMST(1)
CJPB
      DIMENSION TT(1),EE(1)
CJPB
      DATA T3/273.16/,CP/1005./,RD/287.05/,RV/461.5/,L3/2.501E6/,
     C  CL/4187./
      DATA ICALL /0/
      IER=0
      IF (ICALL) 1,1,100
C     SET UP TABLES OF THETA E OF P AND T, AND OF T OF THETA E AND P
    1 ICALL = 1
      KAPPA=RD/CP
      EPS=RD/RV
      T=220.
      DO 3 I=1,13
      EL=L3-(CL-CP)*(T-T3)
CJPB   CALL SATVAP(T,ES(I),1)
       TT(1)=T
       EE(1)=ES(I)
       CALL SATVAP(TT,EE,1)
       ES(I)=EE(1)
CJPB
      P=.5
          DO 2 K=1,12
          RATIO=EPS*ES(I)/(100.*P-ES(I) )
          POWER=EL*RATIO/(CP*T)
          PD=P-.01*ES(I)
          THETAE(I,K)=T*EXP(POWER)/(PD**KAPPA)
          P=P+.05
    2     CONTINUE
      T=T+10.
    3 CONTINUE
C     CONSTRUCT TABLE TO GET TEMPERATURE FROM THETAE AND P
C         THE TABLE IS TFMTHE(I,K), WHERE
C              THETAE=220,230,--,500 = 210+10*I, AND
C                  P=PRESS/100 CB = 0,.1,.2,--,1.1 =  0.1*(K-1)
C     FOR P=0, TFMTHE(I,1) IS IDENTICALLY ZERO
C
      CRIT=.01
      THEE=220.
      DO 16 I=1,29
      TFMTHE(I,1)=0.
      QFMTHE(I,1) = 0.
      P=.1
      DO 12 K=2,12
C     FIRST GUESS
      T=THEE*(P**KAPPA)
      T=310.
C     NEWTON ITERATION METHOD
          DO 10 L=1,20
CJPB      CALL SATVAP(T,ESS,1)
       TT(1)=T
       EE(1)=ESS
       CALL SATVAP(TT,EE,1)
       ESS=EE(1)
CJPB
          RATIO=EPS*ESS/(100.*P-ESS)
          EL=L3-(CL-CP)*(T-T3)
          POWER=RATIO*EL/(CP*T)
          FUN=T*EXP(POWER)/((P-.01*ESS)**KAPPA)
          DFUN=(FUN/T)*(1.+(RATIO/(CP*T) )*((CP-CL)*T
     C        +(P/(P-.01*ESS))*(EL*EL/(RV*T))))
          CHG=(THEE-FUN)/DFUN
          T=T+CHG
          IF(ABS(CHG)-CRIT) 11,10,10
   10     CONTINUE
   11 TFMTHE(I,K)=T
CJPB  CALL SATVAP(T,ESS,1)
       TT(1)=T
       EE(1)=ESS
       CALL SATVAP(TT,EE,1)
       ESS=EE(1)
CJPB
      QFMTHE(I,K)=EPS*ESS/(100.*P-(1.-EPS)*ESS)
      P=P+.1
   12 CONTINUE
C
      THEE=THEE+10.
   16 CONTINUE
C
  100 CONTINUE
C     SURFACE PRESS IS H, PRESSURE AT OTHER LVLS IS H TIMES PRESS(K)
C     COMPUTE THETA E  = THE  , FOR LAYER ONE
      P=H*PRESS(1)
      TI=.1*TIN(1)-21.
      JT=TI
      X=TI-JT
      PK=20.*P-9.
      KP=PK
      Y=PK-KP
      YY=1.-Y
      XX=1.-X
      THE=XX*(YY*THETAE(JT,KP)+Y*THETAE(JT,KP+1))
     C     + X*(YY*THETAE(JT+1,KP)+Y*THETAE(JT+1,KP+1))
C
C     GET T AND Q ON MST ADIABAT FOR LAYERS WHICH ARE COLDER THAN
C         THE MST ADIABAT
      KTOP=1
      TK=.1*THE-21.
      KT=TK
      Y=TK-KT
      YY=1.-Y
      KADD=IT+1
C
C     TEST LIMITS ON THE
      IF(KT-1) 105,106,106
C     THE IS L.T. 220  OR  G.T. 500.
  104 FORMAT(1H1,4X,17HEQUIV POT TEMP = ,E14.6,23H OUT OF RANGE IN MSTAD
     CB)
C*******************************************
105   CONTINUE
C 105 WRITE(6,104)THE
C     CALL PDUMP(TIN(1),TIN(1),5,H,H,5,IT,IT,4)
C*******************************************
      IER=1
      RETURN
  106 IF(KT-28) 107,107,105
  107 CONTINUE
C
C     FIRST PUT TMST=TIN AND QMST=QSAT(TIN) FOR K=1
      TMST(1)=TIN(1)
      P=H*PRESS(1)
      PI=10.*P+1.
      IP=PI
      X=PI-IP
      QMST(1)=(1.-X)*(YY*QFMTHE(KT,IP)+Y*QFMTHE(KT+1,IP) )
     C        +X*(YY*QFMTHE(KT,IP+1)+Y*QFMTHE(KT+1,IP+1) )
C
C     WE WILL ALLOW ONE STABLE LAYER (WITH TIN G.T. TMST) TO
C         INTERRUPT A SEQUENCE OF UNSTABLE LAYERS.
      LSTB=0
      DO 102 K=2,KM
      P=H*PRESS(K)
      PI=10.*P+1.
      IP=PI
      X=PI-IP
      TMST(K)=(1.-X)*(YY*TFMTHE(KT,IP)+Y*TFMTHE(KT+1,IP))
     C          +X*(YY*TFMTHE(KT,IP+1)+Y*TFMTHE(KT+1,IP+1))
      QMST(K)=(1.-X)*(YY*QFMTHE(KT,IP)+Y*QFMTHE(KT+1,IP))
     C          +X*(YY*QFMTHE(KT,IP+1)+Y*QFMTHE(KT+1,IP+1))
      IF(TMST(K   )-TIN(KADD) ) 103,103,101
C     WE HAVE REACHED A STABLE LAYER.  IS IT THE FIRST SUCH,,,,
  103 IF(LSTB) 108,108,109
C     YES, IT IS THE FIRST TIME.  RECORD KTOP AND, IF K IS L.T. KM,
C         REJOIN THE K-LOOP
  108 LSTB=1
      KTOP1=KTOP
      IF(K-KM) 101,111,111
C
C     TIN IS L.T. T OF MST ADIAB,,CONTINUE
  101 KTOP=KTOP+1
      KADD=KADD+IT
  102 CONTINUE
C
C
C     WE HAVE GONE THRU THE LOOP WITH ALL LAYERS UNSTABLE,,WOW,,,
      GO TO 111
C
C     FOUND THE SECOND STBL LAYER.  WAS IT JUST ABOVE THE FIRST STBL LYR
  109 IF(KTOP-KTOP1-1) 110,110,111
C     SECOND STBL LYR WAS JUST ABV FIRST ONE.  RESTORE KTOP
  110 KTOP=KTOP1
C
  111 RETURN
      END