MODULE module_microphysics_zero_out CONTAINS SUBROUTINE microphysics_zero_outa ( & 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 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte INTEGER, INTENT(IN ) :: n_moist REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: 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 ) 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 ) 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 moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. ) ENDDO ENDDO ENDDO END IF ENDDO END IF END SUBROUTINE microphysics_zero_outa SUBROUTINE microphysics_zero_outb ( & 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 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte INTEGER, INTENT(IN ) :: n_moist REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: 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 ) 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 ) 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 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 moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. ) ENDDO ENDDO END IF ENDDO END IF RETURN END SUBROUTINE microphysics_zero_outb END MODULE module_microphysics_zero_out