
! ======================================================================================
! This file was generated by the version 5.4.0 of DFT on 12/23/2010. The differentiation
! transforming system(DFT) was jointly developed and sponsored by LASG of IAP(1998-2010)
! and LSEC of ICMSEC, AMSS(2001-2003)
! The copyright of the DFT system was declared by Walls at LASG, 1998-2010
! ======================================================================================
! corrected by zzma on 01/10/2011

 MODULE g_module_microphysics_zero_out

 CONTAINS

 SUBROUTINE g_microphysics_zero_outa(moist_new,g_moist_new,n_moist,config_flags, &
 ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 USE module_state_description
 USE module_configure
 USE module_wrf_error
 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde
 INTEGER :: ims,ime,jms,jme,kms,kme
 INTEGER :: its,ite,jts,jte,kts,kte
 INTEGER :: n_moist
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist_new,g_moist_new
 INTEGER i,j,k,n

 IF( config_flags%mp_zero_out .EQ. 0 ) THEN
 ELSE IF( config_flags%mp_zero_out .EQ. 1 ) THEN
       CALL wrf_debug ( 100 , 'zero out small condensates, vapor not included')

  DO n =PARAM_FIRST_SCALAR,n_moist
   IF( n .NE. P_QV ) THEN
     DO j =jts,jte
     DO k =kts,kte
     DO i =its,ite
       IF( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh ) g_moist_new(i,k,j,n) =0.0
       IF( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh ) moist_new(i,k,j,n) =0.
     ENDDO
     ENDDO
     ENDDO
   END IF
  ENDDO
 ELSE IF( config_flags%mp_zero_out .EQ. 2 ) then
       CALL wrf_debug ( 100 , 'zero out small condensates, zero out negative vapor')

 DO n =PARAM_FIRST_SCALAR,n_moist

 IF( n .NE. P_QV ) THEN

 DO j =jts,jte
 DO k =kts,kte
 DO i =its,ite
 IF( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh ) g_moist_new(i,k,j,n) =0.0
 IF( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh ) moist_new(i,k,j,n) =0.
 ENDDO
 ENDDO
 ENDDO
 ELSE IF( n .EQ. P_QV ) THEN

 DO j =jts,jte
 DO k =kts,kte
 DO i =its,ite

 g_moist_new(i,k,j,n) =(g_moist_new(i,k,j,n) +g_moist_new(i,k,j,n)*sign(1.0, moist_new(i,k,j,n)))*0.5
 moist_new(i,k,j,n) =max(moist_new(i,k,j,n),0.)

 ENDDO
 ENDDO
 ENDDO
 END IF
 ENDDO
 END IF

 END SUBROUTINE g_microphysics_zero_outa

 SUBROUTINE g_microphysics_zero_outb(moist_new,g_moist_new,n_moist,config_flags, &
 ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 USE module_state_description
 USE module_configure
 USE module_wrf_error
 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde
 INTEGER :: ims,ime,jms,jme,kms,kme
 INTEGER :: its,ite,jts,jte,kts,kte
 INTEGER :: n_moist
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist_new,g_moist_new
 INTEGER i,j,k,n

 IF( config_flags%mp_zero_out .NE. 0 ) THEN

 DO n =PARAM_FIRST_SCALAR,n_moist
 j =jds

 IF( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN

 DO k =kts,kte
 DO i =its,min(ite,ide-1)

 g_moist_new(i,k,j,n) =(g_moist_new(i,k,j,n) +g_moist_new(i,k,j,n)*sign(1.0, moist_new(i,k,j,n) ))*0.5
 moist_new(i,k,j,n) =max(moist_new(i,k,j,n),0.)

 ENDDO
 ENDDO
 END IF

 j =jde-1

 IF( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN

 DO k =kts,kte
 DO i =its,min(ite,ide-1)

 g_moist_new(i,k,j,n) =(g_moist_new(i,k,j,n) +g_moist_new(i,k,j,n)*sign(1.0, moist_new(i,k,j,n) ))*0.5
 moist_new(i,k,j,n) =max(moist_new(i,k,j,n),0.)

 ENDDO
 ENDDO
 END IF

 i =ids

 IF( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN

 DO j =jts,min(jte,jde-1)
 DO k =kts,kte

 g_moist_new(i,k,j,n) =(g_moist_new(i,k,j,n) +g_moist_new(i,k,j,n)*sign(1.0, moist_new(i,k,j,n) ))*0.5
 moist_new(i,k,j,n) =max(moist_new(i,k,j,n),0.)

 ENDDO
 ENDDO
 END IF

 i =ide-1

 IF( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN

 DO j =jts,min(jte,jde-1)
 DO k =kts,kte

 g_moist_new(i,k,j,n) =(g_moist_new(i,k,j,n) +g_moist_new(i,k,j,n) *sign(1.0, moist_new(i,k,j,n) ))*0.5
 moist_new(i,k,j,n) =max(moist_new(i,k,j,n),0.)

 ENDDO
 ENDDO
 END IF
 ENDDO
 END IF
 RETURN

 END SUBROUTINE g_microphysics_zero_outb

 END MODULE g_module_microphysics_zero_out

