      SUBROUTINE ODABAT(J,TS,PS,ISTO,KLEV)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    ODABAT      PERFORM ADIABATIC CHECK OF TEMPS
C   PRGMMR: DIMEGO           ORG: W/NMC22    DATE: 86-03-31
C
C ABSTRACT: PERFORMS A CHECK OF TEMPERATURE PROFILES FOR LAYERS
C   WHICH ARE SUPER-ADIABATIC.  A CORRECTION IS CALCULATED AND
C   APPLIED IF THE SWITCH IS SET TO DO SO.  BASED ON RALPH JONES
C   CODE FROM THE ISENTROPIC. SAME AS ADABAT EXCEPT FOR STRIPS
C   OF FIRST-GUESS VALUES.
C
C PROGRAM HISTORY LOG:
C   86-03-31  DIMEGO
C   88-06-30  DIMEGO      HALF PRECISION / PL1 / FTN200
C
C USAGE:    CALL ODABAT(J,TS,PS,ISTO,KLEV)
C   INPUT ARGUMENT LIST:
C     J        - INDEX OF STRIP BEING CHECKED
C     TS       - ARRAY OF TEMPERATURES (GUESS STRIP)
C     PS       - ARRAY OF PRESSURES (GUESS STRIP)
C     ISTO     - SWITCH FOR STORING CORRECTED/ADJUSTED VALUE:
C              - 0 DO NOT STORE ; NON ZERO STORE NEW VALUE
C     KLEV     - NUMBER OF LAYERS IN STRIP ARRAYS
C
C   OUTPUT ARGUMENT LIST:
C     TS       - WHEN ISTO IS NON-ZERO, THE ADJUSTED VALUES
C              - ARE WRITTEN IN PLACE OF ORIGINAL VALUES.
C
C   OUTPUT FILES:
C     UNIT6    - DIAGNOSTIC PRINTOUT OF SUMMARY IS PRINTED
C              - AFTER LAST STRIP (BASED ON J) IS PROCESSED.
C
C REMARKS: LAYERS ARE SIMPLY MIXED TO RELIEVE SUPER-ADIABAT
C
C ATTRIBUTES:
C   LANGUAGE: STANDARD FORTRAN
C   MACHINE:
C
C$$$
      IMPLICIT REAL (A-H,O-Z)
      INCLUDE "parmanl"
      DIMENSION TS( IMAX , KMAX ),PS( IMAX , KMAX )
      DIMENSION PT( KMAX ),PI( KMAX ),NCOUNT( KMAX )
      DIMENSION DMEAN( KMAX ),RMSTD( KMAX ),TDMAX( KMAX )
      DIMENSION MAXI( KMAX ),MAXJ( KMAX )
      DATA NCOUNT,DMEAN/ KMAX *0, KMAX *0.0/
      DATA RMSTD,TDMAX/ KMAX *0.0, KMAX *0.0/
      DATA MAXI,MAXJ/ KMAX *0, KMAX *0/
      KLEVM1= KLEV - 1
      ROCP = 287.05 / 1005.
      XSTO = 0.0
      IF( ISTO.GT.0 )  XSTO = 1.0
      DO 7 I=1, IMAX
C  COMPUTE PI & THETA AND ADJUST ANY SUPERADIABATIC LAPSE RATES
      DO 2 L=1,KLEV
      PI(L) = (.001*PS(I,L)) ** ROCP
      PT(L) = TS(I,L)/PI(L)
    2 CONTINUE
      ITER = 0
      ITX = 50
      CMAX = 0.0
      CMEAN = 0.0
      NCNT = 0
      LEVMAX = 0
      DO 4 N=1,ITX
      NHS = 0
      DO 3 L=1,KLEVM1
      DPT = PT(L+1)-PT(L)
      IF(DPT.GT.0.0) GO TO 3
      NHS = NHS+1
      NCNT = NCNT + 1
      COR = 0.5*DPT-0.05
      TCOR = ABS(COR*0.5*(PI(L)+PI(L+1)))
      CMAX = MAX(CMAX,TCOR)
      CMEAN = CMEAN + TCOR
      IF(NCNT.EQ.1) LEVMAX = L
      PT(L+1) = PT(L+1)-COR
      PT(L) = PT(L)+COR
    3 CONTINUE
      IF(NHS.EQ.0) GO TO 5
      ITER = N
    4 CONTINUE
    5 CONTINUE
      IF(ITER.EQ.0) GO TO 7
      IF( NCNT.GT.1 )  CMEAN = CMEAN / FLOAT(NCNT)
C     IF(ITER.GT.3.OR.CMAX.GE.1.0.OR.CMEAN.GT.0.5)
C    + WRITE(6,101) I,J,ITER,NCNT,LEVMAX,CMAX,CMEAN
C 101 FORMAT('  ADIABATIC ADJUSTMENT AT POINT (',I3,',',I2,')',
C    1        ' NEEDED ',I3,' ITERATIONS',2I5,2F10.3)
C  NOW RE-COMPUTE ADJUSTED TEMPERATURES
      DO 6 L=1,KLEV
      TNEW = PT(L) * PI(L)
      TDIF = TNEW - TS(I,L)
      IF(ABS(TDIF).LE.0.01) GO TO 6
      NCOUNT(L) = NCOUNT(L) + 1
      DMEAN(L) = DMEAN(L) + TDIF
      RMSTD(L) = RMSTD(L) + TDIF*TDIF
      TS(I,L) = TS(I,L) + TDIF * XSTO
      IF(ABS(TDIF).LE.TDMAX(L)) GO TO 6
      TDMAX(L) = ABS(TDIF)
      MAXI(L) = I
      MAXJ(L) = J
    6 CONTINUE
    7 CONTINUE
      IF( J.LT.  JMAX ) RETURN
      WRITE(6,102)NCOUNT
  102 FORMAT(' CNT ',18I7)
      DO 8 L=1,KLEV
      NCOUNT(L) = MAX0(1,NCOUNT(L))
      COUNT = 1.0 / FLOAT(NCOUNT(L))
      DMEAN(L) = DMEAN(L) * COUNT
      RMSTD(L) = SQRT(RMSTD(L)*COUNT)
    8 CONTINUE
      WRITE(6,103)DMEAN
      WRITE(6,104)RMSTD
      WRITE(6,105)TDMAX
      WRITE(6,106)MAXI
      WRITE(6,107)MAXJ
  103 FORMAT(' MEAN',18F7.2)
  104 FORMAT(' RMS ',18F7.2)
  105 FORMAT(' MAX ',18F7.2)
  106 FORMAT(' MAXI',18I7)
  107 FORMAT(' MAXJ',18I7)
      DO 108 N=1,KLEV
      NCOUNT(N) = 0
      MAXI(N) = 0
      MAXJ(N) = 0
      DMEAN(N) = 0.0
      RMSTD(N) = 0.0
      TDMAX(N) = 0.0
  108 CONTINUE
      RETURN
      END
