SUBROUTINE WETFRZLVL(TWET,ZWET)
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .     
! SUBPROGRAM:    WETFRZLVL      COMPUTES LEVEL OF 0 WET BULB	 
! PRGRMMR: MANIKIN         ORG: W/NP2      DATE: 03-11-14     
!     
! ABSTRACT:
!     THIS ROUTINE COMPUTES THE LOWEST HEIGHT WITH A WET BULB
!     TEMPERATURE OF FREEZING FOR EACH MASS POINT ON THE ETA GRID.  
!     THE COMPUTED WET BULB ZERO HEIGHT IS THE MEAN SEA LEVEL
!     HEIGHT.  AT EACH MASS POINT WE MOVE UP FROM THE SURFACE TO 
!     FIND THE FIRST ETA LAYER WHERE THE TW IS LESS THAN
!     273.16K.  VERTICAL INTERPOLATION IN TEMPERATURE TO THE FREEZING
!     TEMPERATURE GIVES THE FREEZING LEVEL HEIGHT.  PRESSURE AND 
!     SPECIFIC HUMIDITY ARE INTERPOLATED TO THIS LEVEL AND ALONG WITH
!     THE TEMPERATURE PROVIDE THE FREEZING LEVEL RELATIVE HUMIDITY.
!     IF THE SURFACE (SKIN) TEMPERATURE IS BELOW FREEZING, THE ROUTINE
!     USES SURFACE BASED FIELDS TO COMPUTE THE RELATIVE HUMIDITY.
!     
! PROGRAM HISTORY LOG:
!   03-11-14 GEOFF MANIKIN - NEW PROGRAM 
!   04-12-06  G MANIKIN    - CORRECTED COMPUTATION OF SFC TEMPERATURE
!   05-03-11  H CHUANG     - WRF VERSION
!     
! USAGE:   CALL WETFRZLVL(TWET,ZWET) 
!   INPUT ARGUMENT LIST:
!     TWET     - WET BULB TEMPERATURES 
!
!   OUTPUT ARGUMENT LIST: 
!     ZWET     - ABOVE GROUND LEVEL HEIGHT OF LEVEL WITH 0 WET BULB.
!     
!   OUTPUT FILES:
!     NONE
!     
!   SUBPROGRAMS CALLED:
!     UTILITIES:
!       REL_HUM
!     LIBRARY:
!       COMMON   - 
!                  LOOPS
!                  PVRBLS
!                  MASKS
!                  MAPOT
!                  POSTVAR
!     
!   ATTRIBUTES:
!     LANGUAGE: FORTRAN
!     MACHINE : CRAY C-90
!$$$  
!     
!     
      use vrbls3d, only: pint, zint, t
      use vrbls2d, only:  fis, thz0, ths
      use masks, only: lmh, sm
      use params_mod, only: gi, p1000, capa, tfrz, d0065, d50
      use ctlblk_mod, only: jsta, jend, im, jsta_2l, jend_2u, lm, jm
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      implicit none
!
!     DECLARE VARIABLES.
!     
      REAL,intent(in) :: TWET(IM,JSTA_2L:JEND_2U,LM)
      REAL,intent(out) :: ZWET(IM,JM)
!     
      integer I,J,LLMH,L
      real HTSFC,THSFC,PSFC,TSFC,DELZ,DELT,ZL,ZU
!*********************************************************************
!     START FRZLVL.
!
!     LOOP OVER HORIZONTAL GRID.
!     
!$omp  parallel do
!$omp& private(delt,delz,htsfc,l,llmh
!$omp&         tsfc,zl,zu)
      DO 20 J=JSTA,JEND
      DO 20 I=1,IM
         HTSFC    = FIS(I,J)*GI
         LLMH     = NINT(LMH(I,J))
         ZWET(I,J)  = HTSFC
!     
!        CHECK IF FREEZING LEVEL IS AT THE GROUND.
!        IF YES, ESTIMATE UNDERGROUND FREEZING LEVEL USING 6.5C/KM LAPSE RATE
!        AND ASSUME RH TO BE EQUAL TO RH AT SFC
!     
         THSFC = (SM(I,J)*THZ0(I,J)+(1.-SM(I,J))*THS(I,J))
         PSFC=PINT(I,J,LLMH+1)
         TSFC=THSFC*(PSFC/P1000)**CAPA

         IF (TSFC.LE.TFRZ) THEN
!            ZWET(I,J) = HTSFC
            ZWET(I,J) = HTSFC+(TSFC-TFRZ)/D0065
            GOTO 20
         ENDIF
!     
!        OTHERWISE, LOCATE THE FREEZING LEVEL ALOFT.
!
         DO 10 L = LLMH,1,-1
            IF (TWET(I,J,L).LE.TFRZ) THEN
               IF (L.LT.LLMH-1) THEN
                  DELZ = D50*(ZINT(I,J,L)-ZINT(I,J,L+2))
                  ZL   = D50*(ZINT(I,J,L+1)+ZINT(I,J,L+2))
                  DELT = TWET(I,J,L)-TWET(I,J,L+1)
                  ZWET(I,J) = ZL + (TFRZ-TWET(I,J,L+1))/DELT*DELZ
               ELSE
                  ZU      = D50*(ZINT(I,J,L)+ZINT(I,J,L+1))
                  ZL      = HTSFC
                  DELZ    = ZU-ZL
                  TSFC    = SM(I,J)*THZ0(I,J)+(1.-SM(I,J))*THS(I,J)    &
                   *(PINT(I,J,NINT(LMH(I,J))+1)/P1000)**CAPA
                  DELT    = T(I,J,L)-TSFC
		  IF(DELT .NE. 0.)THEN  
                   ZWET(I,J) = ZL + (TFRZ-TSFC)/DELT*DELZ
		  ELSE
		   ZWET(I,J) = HTSFC+(TSFC-TWET(I,J,L))/D0065
		  END IF  
                  IF (ZWET(I,J) .GT. ZU) THEN
                    ZWET(I,J)=ZU
                  ENDIF
                   IF ((-1*ZWET(I,J)) .GT. ZU) THEN
                    ZWET(I,J)=ZU
                  endif
               ENDIF
               GOTO 20
            ENDIF
 10      CONTINUE
 20   CONTINUE
!     
!     END OF ROUTINE.
!     
      RETURN
      END