! ====================================================================================== ! 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