wrftladj/module_microphysics_zero_out_ad.F

   1
   2 ! ======================================================================================
   3 ! This file was generated by the version 4.4.0 of ADG on 12/23/2010. The Adjoint Code
   4 ! Generator (ADG) was developed and sponsored by LASG of IAP (1999-2010)
   5 ! The Copyright of the ADG system was declared by Walls at LASG, 1999-2010
   6 ! ======================================================================================
   7 ! corrrected by zzma on 01/10/2011
   8
   9 MODULE a_module_microphysics_zero_out
  10
  11 CONTAINS
  12
  13    SUBROUTINE a_microphysics_zero_outa(moist_new,a_moist_new,n_moist,config_flags, &
  14    ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
  15
  16 !PART I: DECLARATION OF VARIABLES
  17
  18    USE module_state_description
  19    USE module_configure
  20    USE module_wrf_error
  21
  22    IMPLICIT NONE
  23
  24    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
  25    TYPE(grid_config_rec_type) :: config_flags
  26    INTEGER :: ids,ide,jds,jde,kds,kde
  27    INTEGER :: ims,ime,jms,jme,kms,kme
  28    INTEGER :: its,ite,jts,jte,kts,kte
  29    INTEGER :: n_moist
  30    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist_new,a_moist_new
  31    INTEGER i,j,k,n
  32
  33    IF( config_flags%mp_zero_out .EQ. 0 ) THEN
  34    ELSE IF( config_flags%mp_zero_out .EQ. 1 ) THEN
  35          CALL wrf_debug ( 100 , 'zero out small condensates, vapor not included')
  36      DO n =PARAM_FIRST_SCALAR, n_moist
  37        IF( n .NE. P_QV ) THEN
  38          DO j =jts, jte
  39          DO k =kts, kte
  40          DO i =its, ite
  41            IF( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh ) THEN
  42              a_moist_new(i,k,j,n) =0.
  43            END IF
  44          ENDDO
  45          ENDDO
  46          ENDDO
  47        END IF
  48      ENDDO
  49
  50    ELSE IF( config_flags%mp_zero_out .EQ. 2 ) then
  51          CALL wrf_debug ( 100 , 'zero out small condensates, zero out negative vapor')
  52    DO n =PARAM_FIRST_SCALAR, n_moist
  53      IF( n .NE. P_QV ) THEN
  54
  55        DO j =jte, jts, -1
  56        DO k =kte, kts, -1
  57        DO i =ite, its, -1
  58        IF( moist_new(i,k,j,n) .LT. config_flags%mp_zero_out_thresh ) THEN
  59        a_moist_new(i,k,j,n) =0.0
  60        END IF
  61        ENDDO
  62        ENDDO
  63        ENDDO
  64
  65      ELSE IF( n .EQ. P_QV ) THEN
  66
  67        DO j =jte, jts, -1
  68        DO k =kte, kts, -1
  69        DO i =ite, its, -1
  70        a_moist_new(i,k,j,n) =(1.0 +(1.0)*sign(1.0,moist_new(i,k,j,n)-0.))*0.5*a_moist_new(i,k,j,n)
  71        ENDDO
  72        ENDDO
  73        ENDDO
  74
  75      END IF
  76    ENDDO
  77
  78    END IF
  79
  80    END SUBROUTINE a_microphysics_zero_outa
  81
  82    SUBROUTINE a_microphysics_zero_outb(moist_new,a_moist_new,n_moist,config_flags, &
  83    ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
  84
  85 !PART I: DECLARATION OF VARIABLES
  86
  87    USE module_state_description
  88    USE module_configure
  89    USE module_wrf_error
  90
  91    IMPLICIT NONE
  92
  93    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
  94    TYPE(grid_config_rec_type) :: config_flags
  95    INTEGER :: ids,ide,jds,jde,kds,kde
  96    INTEGER :: ims,ime,jms,jme,kms,kme
  97    INTEGER :: its,ite,jts,jte,kts,kte
  98    INTEGER :: n_moist
  99    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist_new,a_moist_new
 100    INTEGER i,j,k,n
 101
 102  IF( config_flags%mp_zero_out .NE. 0 ) THEN
 103    DO n =n_moist, PARAM_FIRST_SCALAR, -1
 104
 105    i = ide-1
 106    IF( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
 107    DO j =min(jte, jde-1), jts, -1
 108    DO k =kte, kts, -1
 109    a_moist_new(i,k,j,n) =(1.0 +(1.0)*sign(1.0,moist_new(i,k,j,n)-0.))*0.5*a_moist_new(i,k,j,n)
 110    ENDDO
 111    ENDDO
 112    END IF
 113
 114    i = ids
 115    IF( ( i .GE. its ) .AND. ( i .LE. MIN( ite , ide-1) ) ) THEN
 116    DO j =min(jte, jde-1), jts, -1
 117    DO k =kte, kts, -1
 118    a_moist_new(i,k,j,n) =(1.0 +(1.0)*sign(1.0,moist_new(i,k,j,n)-0.))*0.5*a_moist_new(i,k,j,n)
 119    ENDDO
 120    ENDDO
 121    END IF
 122
 123    j = jde-1
 124    IF( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
 125    DO k =kte, kts, -1
 126    DO i =min(ite, ide-1), its, -1
 127    a_moist_new(i,k,j,n) =(1.0 +(1.0)*sign(1.0,moist_new(i,k,j,n)-0.))*0.5*a_moist_new(i,k,j,n)
 128    ENDDO
 129    ENDDO
 130    END IF
 131
 132    j = jds
 133    IF( ( j .GE. jts ) .AND. ( j .LE. MIN( jte , jde-1) ) ) THEN
 134    DO k =kte, kts, -1
 135    DO i =min(ite, ide-1), its, -1
 136    a_moist_new(i,k,j,n) =(1.0 +(1.0)*sign(1.0,moist_new(i,k,j,n)-0.))*0.5*a_moist_new(i,k,j,n)
 137    ENDDO
 138    ENDDO
 139    END IF
 140
 141   ENDDO
 142  END IF
 143
 144
 145    RETURN
 146    END SUBROUTINE a_microphysics_zero_outb
 147
 148    END MODULE a_module_microphysics_zero_out
 149