CALWXT_EXPLICIT.f

      SUBROUTINE calwxt_explicit_post(LMH,THS,PMID,PREC,SR,F_RIMEF,IWX)
! 
!     FILE: CALWXT.f
!     WRITTEN: 24 AUGUST 2005, G MANIKIN and B FERRIER 
!
!     ROUTINE TO COMPUTE PRECIPITATION TYPE USING EXPLICIT FIELDS
!       FROM THE MODEL MICROPHYSICS

      use params_mod, only: p1000, capa
      use ctlblk_mod, only: jsta, jend, modelname, pthresh, im, jsta_2l,  &
                            jend_2u, lm
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      implicit none
!
!  LIST OF VARIABLES NEEDED
!    PARAMETERS:
!
!    INPUT:
      real,dimension(im,jsta_2l:jend_2u,lm),intent(in)    :: f_rimef, pmid
      REAL,dimension(im,jsta_2l:jend_2u),   intent(in)    :: lmh, prec, ths, sr
      integer,dimension(im,jsta:jend),      intent(inout) :: iwx
      integer i,j,lmhk
      real psfc,tskin,snow
!
!     ALLOCATE LOCAL STORAGE
!
!$omp  parallel do private(i,j)
      DO j=jsta,jend
        DO i=1,im
          iwx(i,j) = 0
        ENDDO
      ENDDO

!
!$omp  parallel do private(j,i,lmhk,psfc,tskin)
      DO j=jsta,jend
        DO i=1,im
          lmhk=lmh(i,j)
!
!   SKIP THIS POINT IF NO PRECIP THIS TIME STEP 
!
          IF (prec(i,j) <= pthresh) cycle
!
!  A SNOW RATIO LESS THAN 0.5 ELIMINATES SNOW AND SLEET
!   USE THE SKIN TEMPERATURE TO DISTINGUISH RAIN FROM FREEZING RAIN
!   NOTE THAT 2-M TEMPERATURE MAY BE A BETTER CHOICE IF THE MODEL
!   HAS A COLD BIAS FOR SKIN TEMPERATURE
! 
          IF (sr(i,j) < 0.5) THEN
!        SURFACE (SKIN) POTENTIAL TEMPERATURE AND TEMPERATURE.
            psfc  = pmid(i,j,lmhk)
            tskin = ths(i,j)*(psfc/p1000)**capa 

            IF (tskin < 273.15) THEN
!          FREEZING RAIN = 4
              iwx(i,j) = iwx(i,j)+4
            ELSE
!          RAIN = 8
              iwx(i,j) = iwx(i,j)+8
            ENDIF
          ELSE
!  
!  DISTINGUISH SNOW FROM SLEET WITH THE RIME FACTOR
! 
            IF(f_rimef(i,j,lmhk) >= 10) THEN
!          SLEET = 2
              iwx(i,j) = iwx(i,j)+2
            ELSE
!              SNOW = 1
              iwx(i,j) = iwx(i,j)+1 
            ENDIF
          ENDIF
        enddo
      enddo
!
      RETURN 
      END