wrftladj/module_microphysics_zero_out_tl.F

   1
   2 ! ======================================================================================
   3 ! This file was generated by the version 5.4.0 of DFT on 12/23/2010. The differentiation
   4 ! transforming system(DFT) was jointly developed and sponsored by LASG of IAP(1998-2010)
   5 ! and LSEC of ICMSEC, AMSS(2001-2003)
   6 ! The copyright of the DFT system was declared by Walls at LASG, 1998-2010
   7 ! ======================================================================================
   8 ! corrected by zzma on 01/10/2011
   9
  10  MODULE g_module_microphysics_zero_out
  11
  12  CONTAINS
  13
  14  SUBROUTINE g_microphysics_zero_outa(moist_new,g_moist_new,n_moist,config_flags, &
  15  ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
  16
  17  USE module_state_description
  18  USE module_configure
  19  USE module_wrf_error
  20  IMPLICIT NONE
  21
  22  REAL :: Tmpv1,g_Tmpv1
  23  TYPE(grid_config_rec_type) :: config_flags
  24  INTEGER :: ids,ide,jds,jde,kds,kde
  25  INTEGER :: ims,ime,jms,jme,kms,kme
  26  INTEGER :: its,ite,jts,jte,kts,kte
  27  INTEGER :: n_moist
  28  REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist_new,g_moist_new
  29  INTEGER i,j,k,n
  30
  31  IF( config_flags%mp_zero_out .EQ. 0 ) THEN
  32  ELSE IF( config_flags%mp_zero_out .EQ. 1 ) THEN
  33        CALL wrf_debug ( 100 , 'zero out small condensates, vapor not included')
  34
  35   DO n =PARAM_FIRST_SCALAR,n_moist
  36    IF( n .NE. P_QV ) THEN
  37      DO j =jts,jte
  38      DO k =kts,kte
  39      DO i =its,ite
  40        IF( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh ) g_moist_new(i,k,j,n) =0.0
  41        IF( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh ) moist_new(i,k,j,n) =0.
  42      ENDDO
  43      ENDDO
  44      ENDDO
  45    END IF
  46   ENDDO
  47  ELSE IF( config_flags%mp_zero_out .EQ. 2 ) then
  48        CALL wrf_debug ( 100 , 'zero out small condensates, zero out negative vapor')
  49
  50  DO n =PARAM_FIRST_SCALAR,n_moist
  51
  52  IF( n .NE. P_QV ) THEN
  53
  54  DO j =jts,jte
  55  DO k =kts,kte
  56  DO i =its,ite
  57  IF( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh ) g_moist_new(i,k,j,n) =0.0
  58  IF( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh ) moist_new(i,k,j,n) =0.
  59  ENDDO
  60  ENDDO
  61  ENDDO
  62  ELSE IF( n .EQ. P_QV ) THEN
  63
  64  DO j =jts,jte
  65  DO k =kts,kte
  66  DO i =its,ite
  67
  68  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
  69  moist_new(i,k,j,n) =max(moist_new(i,k,j,n),0.)
  70
  71  ENDDO
  72  ENDDO
  73  ENDDO
  74  END IF
  75  ENDDO
  76  END IF
  77
  78  END SUBROUTINE g_microphysics_zero_outa
  79
  80  SUBROUTINE g_microphysics_zero_outb(moist_new,g_moist_new,n_moist,config_flags, &
  81  ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
  82
  83  USE module_state_description
  84  USE module_configure
  85  USE module_wrf_error
  86  IMPLICIT NONE
  87
  88  REAL :: Tmpv1,g_Tmpv1
  89  TYPE(grid_config_rec_type) :: config_flags
  90  INTEGER :: ids,ide,jds,jde,kds,kde
  91  INTEGER :: ims,ime,jms,jme,kms,kme
  92  INTEGER :: its,ite,jts,jte,kts,kte
  93  INTEGER :: n_moist
  94  REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist_new,g_moist_new
  95  INTEGER i,j,k,n
  96
  97  IF( config_flags%mp_zero_out .NE. 0 ) THEN
  98
  99  DO n =PARAM_FIRST_SCALAR,n_moist
 100  j =jds
 101
 102  IF( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
 103
 104  DO k =kts,kte
 105  DO i =its,min(ite,ide-1)
 106
 107  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
 108  moist_new(i,k,j,n) =max(moist_new(i,k,j,n),0.)
 109
 110  ENDDO
 111  ENDDO
 112  END IF
 113
 114  j =jde-1
 115
 116  IF( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
 117
 118  DO k =kts,kte
 119  DO i =its,min(ite,ide-1)
 120
 121  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
 122  moist_new(i,k,j,n) =max(moist_new(i,k,j,n),0.)
 123
 124  ENDDO
 125  ENDDO
 126  END IF
 127
 128  i =ids
 129
 130  IF( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
 131
 132  DO j =jts,min(jte,jde-1)
 133  DO k =kts,kte
 134
 135  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
 136  moist_new(i,k,j,n) =max(moist_new(i,k,j,n),0.)
 137
 138  ENDDO
 139  ENDDO
 140  END IF
 141
 142  i =ide-1
 143
 144  IF( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
 145
 146  DO j =jts,min(jte,jde-1)
 147  DO k =kts,kte
 148
 149  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
 150  moist_new(i,k,j,n) =max(moist_new(i,k,j,n),0.)
 151
 152  ENDDO
 153  ENDDO
 154  END IF
 155  ENDDO
 156  END IF
 157  RETURN
 158
 159  END SUBROUTINE g_microphysics_zero_outb
 160
 161  END MODULE g_module_microphysics_zero_out
 162