wrfv2_fire/phys/module_microphysics_zero_out.F

   1 !WRF:MEDIATION_LAYER:PHYSICS
   2 !
   3 MODULE module_microphysics_zero_out
   4 CONTAINS
   5
   6 SUBROUTINE microphysics_zero_outa (                                      &
   7                        moist_new , n_moist                               &
   8                       ,config_flags                                      &
   9                       ,ids,ide, jds,jde, kds,kde                         &
  10                       ,ims,ime, jms,jme, kms,kme                         &
  11                       ,its,ite, jts,jte, kts,kte                         )
  12
  13
  14    USE module_state_description
  15    USE module_configure
  16    USE module_wrf_error
  17
  18    IMPLICIT NONE
  19    TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
  20    INTEGER,      INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
  21    INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
  22    INTEGER,      INTENT(IN   )    ::       its,ite, jts,jte, kts,kte
  23
  24    INTEGER,      INTENT(IN   )    :: n_moist
  25
  26    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: moist_new
  27
  28 ! Local
  29
  30    INTEGER i,j,k,n
  31
  32
  33    ! Zero out small condensate values  FSL-BLS-12-JUL-2004
  34
  35    IF ( config_flags%mp_zero_out .EQ. 0 ) THEN
  36       !  do nothing
  37    ELSE IF ( config_flags%mp_zero_out .EQ. 1 ) THEN
  38       !  All of the "moist" fields, except for vapor, that are below a critical
  39       !  threshold are set to zero.
  40       CALL wrf_debug ( 100 , 'zero out small condensates, vapor not included')
  41       DO n = PARAM_FIRST_SCALAR,n_moist
  42          IF ( n .NE. P_QV ) THEN
  43             DO j = jts, jte
  44             DO k = kts, kte
  45             DO i = its, ite
  46                IF ( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh )  moist_new(i,k,j,n) =0.
  47             ENDDO
  48             ENDDO
  49             ENDDO
  50          END IF
  51       ENDDO
  52    ELSE IF ( config_flags%mp_zero_out .EQ. 2 ) then
  53       !  All of the non-Qv "moist" fields that are below a critical threshold are set to
  54       !  zero.  The vapor is constrained to be non-negative.
  55       CALL wrf_debug ( 100 , 'zero out small condensates, zero out negative vapor')
  56       DO n = PARAM_FIRST_SCALAR,n_moist
  57          IF ( n .NE. P_QV ) THEN
  58             DO j = jts, jte
  59             DO k = kts, kte
  60             DO i = its, ite
  61                IF ( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh )  moist_new(i,k,j,n) =0.
  62             ENDDO
  63             ENDDO
  64             ENDDO
  65          ELSE IF ( n .EQ. P_QV ) THEN
  66             DO j = jts, jte
  67             DO k = kts, kte
  68             DO i = its, ite
  69                moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
  70             ENDDO
  71             ENDDO
  72             ENDDO
  73          END IF
  74       ENDDO
  75    END IF
  76 END SUBROUTINE microphysics_zero_outa
  77
  78 SUBROUTINE microphysics_zero_outb (                                      &
  79                        moist_new , n_moist                               &
  80                       ,config_flags                                      &
  81                       ,ids,ide, jds,jde, kds,kde                         &
  82                       ,ims,ime, jms,jme, kms,kme                         &
  83                       ,its,ite, jts,jte, kts,kte                         )
  84
  85
  86    USE module_state_description
  87    USE module_configure
  88    USE module_wrf_error
  89
  90    IMPLICIT NONE
  91    TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
  92    INTEGER,      INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
  93    INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
  94    INTEGER,      INTENT(IN   )    ::       its,ite, jts,jte, kts,kte
  95
  96    INTEGER,      INTENT(IN   )    :: n_moist
  97
  98    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: moist_new
  99
 100 ! Local
 101
 102    INTEGER i,j,k,n
 103
 104    ! Make sure that the boundary is .GE. 0 if the config_flags%mp_zero_out option is selected (1 or 2)
 105    ! Just do the outer row/col, no interior points.
 106
 107    IF ( config_flags%mp_zero_out .NE. 0 ) THEN
 108       DO n = PARAM_FIRST_SCALAR,n_moist
 109          !  bottom row
 110          j = jds
 111          IF ( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
 112             DO k = kts, kte
 113             DO i = its , MIN ( ite , ide-1 )
 114                moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
 115             ENDDO
 116             ENDDO
 117          END IF
 118          !  top row
 119          j = jde-1
 120          IF ( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
 121             DO k = kts, kte
 122             DO i = its , MIN ( ite , ide-1 )
 123                moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
 124             ENDDO
 125             ENDDO
 126          END IF
 127          !  left column
 128          i = ids
 129          IF ( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
 130             DO j = jts , MIN ( jte , jde-1 )
 131             DO k = kts, kte
 132                moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
 133             ENDDO
 134             ENDDO
 135          END IF
 136          !  right column
 137          i = ide-1
 138          IF ( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
 139             DO j = jts , MIN ( jte , jde-1 )
 140             DO k = kts, kte
 141                moist_new(i,k,j,n) = MAX ( moist_new(i,k,j,n) , 0. )
 142             ENDDO
 143             ENDDO
 144          END IF
 145       ENDDO
 146    END IF
 147
 148    RETURN
 149
 150    END SUBROUTINE microphysics_zero_outb
 151
 152 END MODULE module_microphysics_zero_out
 153
 154
 155