CALWXT_DOMINANT.f

       SUBROUTINE calwxt_dominant_post(PREC,RAIN,FREEZR,SLEET,SNOW,     &
     &                                 domr,domzr,domip,doms)
!
!     WRITTEN: 24 AUGUST 2005, G MANIKIN 
!      
!     THIS ROUTINE TAKES THE PRECIP TYPE SOLUTIONS FROM DIFFERENT
!       ALGORITHMS AND SUMS THEM UP TO GIVE A DOMINANT TYPE
!
!     use params_mod
      use ctlblk_mod, only: jsta, jend, pthresh, im, jsta_2l, jend_2u
!     use ctlblk_mod
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      implicit none
!
      integer,PARAMETER :: nalg=5
!    INPUT:
      REAL prec(im,jsta_2l:jend_2u)
      real,DIMENSION(IM,jsta:jend),     intent(inout) ::  doms,domr,domzr,domip
      real,DIMENSION(IM,jsta:jend,NALG),intent(in)    ::  rain,snow,sleet,freezr
      integer i,j,l
      real totsn,totip,totr,totzr
!--------------------------------------------------------------------------
!$omp  parallel do  private(i,j)
      DO j=jsta,jend
        DO i=1,im
          domr(i,j)  = 0.
          doms(i,j)  = 0.
          domzr(i,j) = 0.
          domip(i,j) = 0.
        ENDDO
      ENDDO
!
!$omp  parallel do private(i,j,totsn,totip,totr,totzr)
      DO j=jsta,jend
        DO i=1,im
!   SKIP THIS POINT IF NO PRECIP THIS TIME STEP
          IF (prec(i,j) <= pthresh) cycle
          totsn = 0
          totip = 0
          totr  = 0
          totzr = 0 
!   LOOP OVER THE NUMBER OF DIFFERENT ALGORITHMS THAT ARE USED
          DO l = 1, nalg
            IF (rain(i,j,l) >  0) THEN
              totr = totr + 1
              cycle
            ENDIF

            IF (snow(i,j,l) >  0) THEN
              totsn = totsn + 1
              cycle
            ENDIF

            IF (sleet(i,j,l) >  0) THEN
              totip = totip + 1
              cycle
            ENDIF

            IF (freezr(i,j,l) >  0) THEN
              totzr = totzr + 1
            ENDIF
          enddo

!   TIES ARE BROKEN TO FAVOR THE MOST DANGEROUS FORM OF PRECIP
!     FREEZING RAIN > SNOW > SLEET > RAIN 
          IF (totsn > totip) THEN
            IF (totsn > totzr) THEN
              IF (totsn  >=  totr) THEN
                doms(i,j) = 1
              ELSE
                domr(i,j) = 1 
              ENDIF
            ELSE IF (totzr  >=  totr) THEN
              domzr(i,j) = 1
            ELSE
              domr(i,j) = 1
            ENDIF 
          ELSE IF (totip  >  totzr) THEN
            IF (totip  >= totr) THEN
              domip(i,j) = 1
            ELSE
              domr(i,j) = 1
            ENDIF
          ELSE IF (totzr >= totr) THEN
            domzr(i,j) = 1
          ELSE
            domr(i,j) = 1
          ENDIF
        enddo
      enddo
!
      RETURN
      END