From ab96404961a9357dea4c7a2bfce19af80545297c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 18 Sep 2019 15:53:56 +0000 Subject: [PATCH 01/24] three files GFS_debug.F90, rrtmg_lw_pre.F90, and rrtmg_sw_pre.F90 are changed by commenting out print of Sfcprop%hprim and replacing replace Sfcprop%hprim variable by Sfcprop%hprime(:,1) in rrtmg routines --- physics/GFS_debug.F90 | 149 +++++++++++---------------------------- physics/rrtmg_lw_pre.F90 | 14 +++- physics/rrtmg_sw_pre.F90 | 33 ++++++--- 3 files changed, 78 insertions(+), 118 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 600936cce..30a25f93e 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -41,7 +41,23 @@ subroutine GFS_diagtoscreen_finalize () end subroutine GFS_diagtoscreen_finalize !> \section arg_table_GFS_diagtoscreen_run Argument Table -!! \htmlinclude GFS_diagtoscreen_run.html +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type in FV3 | DDT | 0 | GFS_control_type | | in | F | +!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type in FV3 | DDT | 0 | GFS_statein_type | | in | F | +!! | Stateout | GFS_stateout_type_instance | instance of derived type GFS_stateout_type | DDT | 0 | GFS_stateout_type | | in | F | +!! | Sfcprop | GFS_sfcprop_type_instance | instance of type GFS_sfcprop_type in FV3 | DDT | 0 | GFS_sfcprop_type | | in | F | +!! | Coupling | GFS_coupling_type_instance | instance of type GFS_coupling_type in FV3 | DDT | 0 | GFS_coupling_type | | in | F | +!! | Grid | GFS_grid_type_instance | instance of type GFS_grid_type in FV3 | DDT | 0 | GFS_grid_type | | in | F | +!! | Tbd | GFS_tbd_type_instance | instance of type GFS_tbd_type in FV3 | DDT | 0 | GFS_tbd_type | | in | F | +!! | Cldprop | GFS_cldprop_type_instance | instance of type GFS_cldprop_type in FV3 | DDT | 0 | GFS_cldprop_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | instance of type GFS_radtend_type in FV3 | DDT | 0 | GFS_radtend_type | | in | F | +!! | Diag | GFS_diag_type_instance | instance of type GFS_diag_type in FV3 | DDT | 0 | GFS_diag_type | | in | F | +!! | Interstitial | GFS_interstitial_type_instance | instance of type GFS_interstitial_type in FV3 | DDT | 0 | GFS_interstitial_type | | in | F | +!! | nthreads | omp_threads | number of OpenMP threads or fast physics schemes | count | 0 | integer | | in | F | +!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & @@ -130,7 +146,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Sfcprop%zorlo' , Sfcprop%zorlo) call print_var(mpirank,omprank, blkno, 'Sfcprop%zorll' , Sfcprop%zorll) call print_var(mpirank,omprank, blkno, 'Sfcprop%fice' , Sfcprop%fice) - call print_var(mpirank,omprank, blkno, 'Sfcprop%hprim' , Sfcprop%hprim) +! call print_var(mpirank,omprank, blkno, 'Sfcprop%hprim' , Sfcprop%hprim) call print_var(mpirank,omprank, blkno, 'Sfcprop%hprime' , Sfcprop%hprime) call print_var(mpirank,omprank, blkno, 'Sfcprop%sncovr' , Sfcprop%sncovr) call print_var(mpirank,omprank, blkno, 'Sfcprop%snoalb' , Sfcprop%snoalb) @@ -756,7 +772,23 @@ subroutine GFS_interstitialtoscreen_finalize () end subroutine GFS_interstitialtoscreen_finalize !> \section arg_table_GFS_interstitialtoscreen_run Argument Table -!! \htmlinclude GFS_interstitialtoscreen_run.html +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type | DDT | 0 | GFS_control_type | | in | F | +!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type | DDT | 0 | GFS_statein_type | | in | F | +!! | Stateout | GFS_stateout_type_instance | instance of derived type GFS_stateout_type | DDT | 0 | GFS_stateout_type | | in | F | +!! | Sfcprop | GFS_sfcprop_type_instance | instance of derived type GFS_sfcprop_type | DDT | 0 | GFS_sfcprop_type | | in | F | +!! | Coupling | GFS_coupling_type_instance | instance of derived type GFS_coupling_type | DDT | 0 | GFS_coupling_type | | in | F | +!! | Grid | GFS_grid_type_instance | instance of derived type GFS_grid_type | DDT | 0 | GFS_grid_type | | in | F | +!! | Tbd | GFS_tbd_type_instance | instance of derived type GFS_tbd_type | DDT | 0 | GFS_tbd_type | | in | F | +!! | Cldprop | GFS_cldprop_type_instance | instance of derived type GFS_cldprop_type | DDT | 0 | GFS_cldprop_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | instance of derived type GFS_radtend_type | DDT | 0 | GFS_radtend_type | | in | F | +!! | Diag | GFS_diag_type_instance | instance of derived type GFS_diag_type | DDT | 0 | GFS_diag_type | | in | F | +!! | Interstitial | GFS_interstitial_type_instance | instance of derived type GFS_interstitial_type | DDT | 0 | GFS_interstitial_type | | in | F | +!! | nthreads | omp_threads | number of OpenMP threads or fast physics schemes | count | 0 | integer | | in | F | +!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & @@ -868,7 +900,12 @@ subroutine GFS_abort_finalize () end subroutine GFS_abort_finalize !> \section arg_table_GFS_abort_run Argument Table -!! \htmlinclude GFS_abort_run.html +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type | DDT | 0 | GFS_control_type | | in | F | +!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine GFS_abort_run (Model, blkno, errmsg, errflg) @@ -896,107 +933,3 @@ subroutine GFS_abort_run (Model, blkno, errmsg, errflg) end subroutine GFS_abort_run end module GFS_abort - - module GFS_checkland - - private - - public GFS_checkland_init, GFS_checkland_run, GFS_checkland_finalize - - contains - - subroutine GFS_checkland_init () - end subroutine GFS_checkland_init - - subroutine GFS_checkland_finalize () - end subroutine GFS_checkland_finalize - -!> \section arg_table_GFS_checkland_run Argument Table -!! \htmlinclude GFS_checkland_run.html -!! - subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_guess, & - flag_init, flag_restart, frac_grid, isot, ivegsrc, stype, vtype, slope, & - soiltyp, vegtype, slopetyp, dry, icy, wet, lake, ocean, & - oceanfrac, landfrac, lakefrac, slmsk, islmsk, errmsg, errflg ) - - use machine, only: kind_phys - - implicit none - - ! Interface variables - integer, intent(in ) :: me - integer, intent(in ) :: master - integer, intent(in ) :: blkno - integer, intent(in ) :: im - integer, intent(in ) :: kdt - integer, intent(in ) :: iter - logical, intent(in ) :: flag_iter(im) - logical, intent(in ) :: flag_guess(im) - logical, intent(in ) :: flag_init - logical, intent(in ) :: flag_restart - logical, intent(in ) :: frac_grid - integer, intent(in ) :: isot - integer, intent(in ) :: ivegsrc - real(kind_phys), intent(in ) :: stype(im) - real(kind_phys), intent(in ) :: vtype(im) - real(kind_phys), intent(in ) :: slope(im) - integer, intent(in ) :: soiltyp(im) - integer, intent(in ) :: vegtype(im) - integer, intent(in ) :: slopetyp(im) - logical, intent(in ) :: dry(im) - logical, intent(in ) :: icy(im) - logical, intent(in ) :: wet(im) - logical, intent(in ) :: lake(im) - logical, intent(in ) :: ocean(im) - real(kind_phys), intent(in ) :: oceanfrac(im) - real(kind_phys), intent(in ) :: landfrac(im) - real(kind_phys), intent(in ) :: lakefrac(im) - real(kind_phys), intent(in ) :: slmsk(im) - integer, intent(in ) :: islmsk(im) - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - ! Local variables - integer :: i - - errflg = 0 - errmsg = '' - - write(0,'(a,i5)') 'YYY: me :', me - write(0,'(a,i5)') 'YYY: master :', master - write(0,'(a,i5)') 'YYY: blkno :', blkno - write(0,'(a,i5)') 'YYY: im :', im - write(0,'(a,i5)') 'YYY: kdt :', kdt - write(0,'(a,i5)') 'YYY: iter :', iter - write(0,'(a,1x,l)') 'YYY: flag_init :', flag_init - write(0,'(a,1x,l)') 'YYY: flag_restart :', flag_restart - write(0,'(a,1x,l)') 'YYY: frac_grid :', frac_grid - write(0,'(a,i5)') 'YYY: isot :', isot - write(0,'(a,i5)') 'YYY: ivegsrc :', ivegsrc - - do i=1,im - !if (vegtype(i)==15) then - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_iter(i) :', i, blkno, flag_iter(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_guess(i) :', i, blkno, flag_guess(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, stype(i) :', i, blkno, stype(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, vtype(i) :', i, blkno, vtype(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slope(i) :', i, blkno, slope(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, soiltyp(i) :', i, blkno, soiltyp(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, vegtype(i) :', i, blkno, vegtype(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, slopetyp(i) :', i, blkno, slopetyp(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, dry(i) :', i, blkno, dry(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, icy(i) :', i, blkno, icy(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, wet(i) :', i, blkno, wet(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, lake(i) :', i, blkno, lake(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, ocean(i) :', i, blkno, ocean(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, oceanfrac(i) :', i, blkno, oceanfrac(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, landfrac(i) :', i, blkno, landfrac(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, lakefrac(i) :', i, blkno, lakefrac(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slmsk(i) :', i, blkno, slmsk(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, islmsk(i) :', i, blkno, islmsk(i) - !end if - end do - - end subroutine GFS_checkland_run - - end module GFS_checkland diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 783d65e90..ca0bc408b 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -12,7 +12,17 @@ subroutine rrtmg_lw_pre_init () end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table -!! \htmlinclude rrtmg_lw_pre_run.html +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | +!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errmsg, errflg) @@ -43,7 +53,7 @@ subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errm !! emissivity for LW radiation. call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, IM, & + tsfg, tsfa, Sfcprop%hprime(:,1), IM, & Radtend%semis) ! --- outputs endif diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index de994ba79..41919b1a2 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -12,7 +12,24 @@ subroutine rrtmg_sw_pre_init () end subroutine rrtmg_sw_pre_init !> \section arg_table_rrtmg_sw_pre_run Argument Table -!! \htmlinclude rrtmg_sw_pre_run.html +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | +!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | +!! | idxday | daytime_points | daytime points | index | 1 | integer | | out | F | +!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb3 | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb4 | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | out | F | +!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & nday, idxday, tsfg, tsfa, sfcalb1, sfcalb2, sfcalb3, sfcalb4, & @@ -66,13 +83,13 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & !> - Call module_radiation_surface::setalb() to setup surface albedo. !! for SW radiation. - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& - tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, IM, & - alb1d, Model%pertalb, & ! mg, sfc-perts + call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, & ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, & + tsfg, tsfa, Sfcprop%hprime(:,1), Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, IM, & + alb1d, Model%pertalb, & ! mg, sfc-perts sfcalb) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. From 596c435586cd58ea8a058538098127b2ccc10e83 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 21 Oct 2019 10:47:53 +0000 Subject: [PATCH 02/24] adding ras --- physics/rascnv.F90 | 4650 +++++++++++++++++++++++++++++++++++++++++++ physics/rascnv.meta | 611 ++++++ 2 files changed, 5261 insertions(+) create mode 100644 physics/rascnv.F90 create mode 100644 physics/rascnv.meta diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 new file mode 100644 index 000000000..602e1cc94 --- /dev/null +++ b/physics/rascnv.F90 @@ -0,0 +1,4650 @@ +!> \file rascnv.F90 +!! This file contains the entire Relaxed Arakawa-Schubert convection +!! parameteriztion + +!> This module contains the CCPP-compliant scale-aware mass-flux deep +!! convection scheme. + module rascnv + + USE machine , ONLY : kind_phys + use physcons, grav => con_g, cp => con_cp, alhl => con_hvap& + &, alhf => con_hfus, rgas => con_rd, rkap => con_rocp& + &, nu => con_FVirt, pi => con_pi, t0c => con_t0c + implicit none + public :: rascnv_init, rascnv_run, rascnv_finalize + private +! + integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s + + integer, parameter :: idnmax=999 + real (kind=kind_phys), parameter :: delt_c=1800.0/3600.0 & +! Adjustment time scales in hrs for deep and shallow clouds +! &, adjts_d=3.0, adjts_s=0.5 +! &, adjts_d=2.5, adjts_s=0.5 + &, adjts_d=2.0, adjts_s=0.5 +! + logical, parameter :: fix_ncld_hr=.true. + +! + real (kind=kind_phys), parameter :: ZERO=0.0, HALF=0.5 & + &, pt25=0.25 & + &, ONE=1.0, TWO=2.0, FOUR=4.& + &, twoo3=two/3.0 & + &, FOUR_P2=4.E2, ONE_M10=1.E-10 & + &, ONE_M6=1.E-6, ONE_M5=1.E-5 & + &, ONE_M2=1.E-2, ONE_M1=1.E-1 & + &, oneolog10=one/log(10.0) & + &, deg2rad=pi/180.d0 & ! conversion factor from degree to radians + &, cmb2pa = 100.0 ! Conversion from hPa to Pa +! + real(kind=kind_phys), parameter :: & + & ONEBG = ONE / GRAV, GRAVCON = cmb2pa * ONEBG & + &, onebcp = one / cp & + &, GRAVFAC = GRAV / CMB2PA, ELOCP = ALHL * onebcp & + &, ELFOCP = (ALHL+ALHF) * onebcp & + &, oneoalhl = one/alhl & + &, CMPOR = CMB2PA / RGAS & + &, picon = half*pi*onebg & + &, zfac = 0.28888889E-4 * ONEBG +! + + real(kind=kind_phys), parameter :: frac=0.5, crtmsf=0.0 & + &, rhfacs=0.70, rhfacl=0.70 & + &, face=5.0, delx=10000.0 & + &, ddfac=face*delx*0.001 & + &, max_neg_bouy=0.15 & +! &, max_neg_bouy=pt25 & + &, dpd=0.5, rknob=1.0, eknob=1.0 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + logical, parameter :: do_aw=.true., cumfrc=.true. & + &, updret=.false., vsmooth=.false. & + &, wrkfun=.false., crtfun=.true. & + &, calkbl=.true, botop=.true. + &, advcld=.true., advups=.false.,advtvd=.true. +! &, advcld=.true., advups=.true., advtvd=.false. +! &, advcld=.true., advups=.false.,advtvd=.false. + + +! real(kind=kind_phys), parameter :: TF=160.16, TCR=160.16 & +! real(kind=kind_phys), parameter :: TF=230.16, TCR=260.16 & +! real(kind=kind_phys), parameter :: TF=233.16, TCR=263.16 & + real(kind=kind_phys), parameter :: TF=233.16, TCR=273.16 & + &, TCRF=1.0/(TCR-TF),TCL=2.0 + +! +! For pressure gradient force in momentum mixing +! real (kind=kind_phys), parameter :: pgftop=0.80, pgfbot=0.30 & +! No pressure gradient force in momentum mixing + real (kind=kind_phys), parameter :: pgftop=0.0, pgfbot=0.0 & +! real (kind=kind_phys), parameter :: pgftop=0.55, pgfbot=0.55 & + &, pgfgrad=(pgfbot-pgftop)*0.001 & + &, cfmax=0.1 +! +! For Tilting Angle Specification +! + real(kind=kind_phys) REFP(6), REFR(6), TLAC(8), PLAC(8), TLBPL(7) & + &, drdp(5) +! + DATA PLAC/100.0, 200.0, 300.0, 400.0, 500.0, 600.0, 700.0, 800.0/ + DATA TLAC/ 35.0, 25.0, 20.0, 17.5, 15.0, 12.5, 10.0, 7.5/ + DATA REFP/500.0, 300.0, 250.0, 200.0, 150.0, 100.0/ + DATA REFR/ 1.0, 2.0, 3.0, 4.0, 6.0, 8.0/ +! + real(kind=kind_phys) AC(16), AD(16) +! + integer, parameter :: nqrp=500001 + real(kind=kind_phys) C1XQRP, C2XQRP, TBQRP(NQRP), TBQRA(NQRP) & + &, TBQRB(NQRP) +! + integer, parameter :: nvtp=10001 + real(kind=kind_phys) C1XVTP, C2XVTP, TBVTP(NVTP) +! + + + contains + +! ----------------------------------------------------------------------- +! CCPP entry points for gfdl cloud microphysics +! ----------------------------------------------------------------------- + +!>\brief The subroutine initializes rascnv +!! +!> \section arg_table_rascnv_init Argument Table +!! \htmlinclude rascnv_init.html +!! + subroutine rascnv_init(me, errmsg, errflg) +! + Implicit none +! + integer, intent(in) :: me + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! + real(kind=kind_phys), parameter :: actp=1.7, facm=1.00 +! + real(kind=kind_phys) PH(15), A(15) +! + DATA PH/150.0, 200.0, 250.0, 300.0, 350.0, 400.0, 450.0, 500.0 & + &, 550.0, 600.0, 650.0, 700.0, 750.0, 800.0, 850.0/ +! + DATA A/ 1.6851, 1.1686, 0.7663, 0.5255, 0.4100, 0.3677 & + &, 0.3151, 0.2216, 0.1521, 0.1082, 0.0750, 0.0664 & + &, 0.0553, 0.0445, 0.0633/ +! + real(kind=kind_phys) tem, actop, tem1, tem2 + integer i, l + logical first + data first/.true./ +! +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + if (first) then +! set critical workfunction arrays + ACTOP = ACTP*FACM + DO L=1,15 + A(L) = A(L)*FACM + ENDDO + DO L=2,15 + TEM = one / (PH(L) - PH(L-1)) + AC(L) = (PH(L)*A(L-1) - PH(L-1)*A(L)) * TEM + AD(L) = (A(L) - A(L-1)) * TEM + ENDDO + AC(1) = ACTOP + AC(16) = A(15) + AD(1) = zero + AD(16) = zero +! + CALL SETQRP + CALL SETVTP +! + do i=1,7 + tlbpl(i) = (tlac(i)-tlac(i+1)) / (plac(i)-plac(i+1)) + enddo + do i=1,5 + drdp(i) = (REFR(i+1)-REFR(i)) / (REFP(i+1)-REFP(i)) + enddo +! +! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 +! + if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & + &, ' DETRAINING AT NORMALIZED PRESSURE ABOVE ',DPD +! + first = .false. + endif + +! + end subroutine rascnv_init +! +!! \section arg_table_rascnv_finalize Argument Table +!! \htmlinclude rascnv_finalize.html +!! + subroutine rascnv_finalize (errmsg, errflg) + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + end subroutine rascnv_finalize +! +! +! ===================================================================== ! +! rascnv_run: ! +! ! +! program history log: ! +! Oct 2019 -- shrinivas moorthi ! +! ! +! ! +! ==================== defination of variables ==================== +! ! +! ! +! inputs: size +! ! +! im - integer, horiz dimension and num of used pts 1 ! +! ix - integer, maximum horiz dimension 1 ! +! k - integer, vertical dimension 1 ! +! dt - real, time step in seconds 1 ! +! dtf - real, dynamics time step in seconds 1 ! +! rannum - real, array holding random numbers between 0 an 1 (ix,nrcm) ! +! tin - real, input temperature (K) +! qin - real, input specific humidity (kg/kg) +! uin - real, input zonal wind component +! vin - real, input meridional wind component +! ccin - real, input condensates+tracers +! fscav - real +! prsi - real, layer interface pressure +! prsl - real, layer mid pressure +! prsik - real, layer interface Exner function +! prslk - real, layer mid Exner function +! phil - real, layer mid geopotential height +! phii - real, layer interface geopotential height +! kpbl - integer pbl top index +! cdrag - real, drag coefficient +! rainc - real, convectinve rain (m/sec) +! kbot - integer, cloud bottom index +! ktop - integer, cloud top index +! knv - integer, 0 - no convvection; 1 - convection +! ddvel - downdraft induced surface wind +! flipv - logical, true if input data from bottom to top +! facmb - real, factor bewteen input pressure and hPa +! me - integer, current pe number +! garea - real, grid area +! ccwfac - real, grid area +! nrcm - integer, number of random numbers at each grid point +! rhc - real, critical relative humidity +! ud_mf - real, updraft mass flux +! dd_mf - real, downdraft mass flux +! det_mf - real, detrained mass flux +! c00 - real, auto convection coefficient for rain +! qw0 - real, min cloud water before autoconversion +! c00i - real, auto convection coefficient for snow +! qi0 - real, min cloud ice before autoconversion +! dlqfac - real,fraction of condensated detrained in layers +! lprnt - logical, true for debug print +! ipr - integer, horizontal grid point to print when lprnt=true +! kdt - integer, current teime step +! revap - logial, when true reevaporate falling rain/snow +! qlcn - real +! qicn - real +! w_upi - real +! cf_upi - real +! cnv_mfd - real +! cnv_dqldt- real +! clcn - real +! cnv_fice - real +! cnv_ndrop- real +! cnv_nice - real +! mp_phys - integer, microphysics option +! mp_phys_mg - integer, flag for MG microphysics option +! trcmin - real, floor value for tracers +! ntk - integer, index representing TKE in the tracer array +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & + &, tin, qin, uin, vin, ccin, trac, fscav& + &, prsi, prsl, prsik, prslk, phil, phii & + &, KPBL, CDRAG, RAINC, kbot, ktop, kcnv & + &, DDVEL, FLIPV, facmb, me, garea, ccwfac & + &, nrcm, rhc, ud_mf, dd_mf, det_mf & + &, c00, qw0, c00i, qi0, dlqfac & + &, lprnt, ipr, kdt, revap & + &, QLCN, QICN, w_upi, cf_upi, CNV_MFD & + &, CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE & + &, mp_phys, mp_phys_mg, trcmin, ntk & + &, errmsg, errflg) +! &, lprnt, ipr, kdt, fscav, ctei_r, ctei_rm) +! +!********************************************************************* +!********************************************************************* +!************ Relaxed Arakawa-Schubert ****************** +!************ Parameterization ****************** +!************ Plug Compatible Driver ****************** +!************ 23 May 2002 ****************** +!************ ****************** +!************ Developed By ****************** +!************ ****************** +!************ Shrinivas Moorthi ****************** +!************ ****************** +!************ EMC/NCEP ****************** +!********************************************************************* +!********************************************************************* +! +! + USE MACHINE , ONLY : kind_phys + Implicit none +! + LOGICAL FLIPV, lprnt,revap +! +! input +! +! Integer IM, IX, k, ncrnd, me, trac, ipr, nrcm, mp_phys, kdt + Integer IM, IX, k, ncrnd, me, trac, ipr, nrcm, mp_phys, kdt,ntk + integer, dimension(im) :: kbot, ktop, kcnv, kpbl, mg_phys_mg +! + real(kind=kind_phys), dimension(ix,k) :: tin, qin, uin, vin & + &, prsl, prslk, phil + real(kind=kind_phys), dimension(ix,k+1) :: prsi, prsik, phii + real(kind=kind_phys), dimension(im,k) :: ud_mf, dd_mf, det_mf & + &, rhc, qlcn, qicn, w_upi & + &, cnv_mfd & +! &, cnv_mfd, cnv_prc3 & + &, cnv_dqldt, clcn & + &, cnv_fice, cnv_ndrop & + &, cnv_nice, cf_upi + real(kind=kind_phys), dimension(im) :: ccwfac, rainc, cdrag & + &, ddvel, garea & + &, c00, c00i, dlqfac + real(kind=kind_phys), dimension(ix,nrcm):: rannum + real(kind=kind_phys) ccin(ix,k,trac+2) + real(kind=kind_phys) trcmin(trac+2) + + real(kind=kind_phys) DT, facmb, dtf, qw0, qi0 +! +! Added for aerosol scavenging for GOCART +! + real(kind=kind_phys), intent(in) :: fscav(trac) + +! &, ctei_r(im), ctei_rm + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! locals +! + real(kind=kind_phys), dimension(k) :: toi, qoi, tcu, qcu & + &, pcu, clw, cli, qii, qli& + &, phi_l, prsm,psjm & + &, alfinq, alfind, rhc_l + &, qoi_l, qli_l, qii_l + real(kind=kind_phys), dimension(k+1) :: prs, psj, phi_h, flx, flxd + + + integer, dimension(100) :: ic + real(kind=kind_phys), parameter :: clwmin=1.0e-10 +! + real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) + &, trcfac(:,:), rcu(:,:) + real(kind=kind_phys) dtvd(2,4) +! &, DPI(K) + real(kind=kind_phys) CFAC, TEM, sgc, ccwf, tem1, tem2, rain & + &, wfnc,tla,pl,qiid,qlid, c0, c0i, dlq_fac, sumq& + &, rainp, facdt +! + Integer KCR, KFX, NCMX, NC, KTEM, I, L, lm1 & + &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & + &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & + &, kblmn, ksfc + real(kind=kind_phys) sgcs(k,im) +! + LOGICAL lprint +! LOGICAL lprint, ctei +! +! Scavenging related parameters +! + real fscav_(trac+2) ! Fraction scavenged per km +! + fscav_ = zero ! By default no scavenging + if (trac > 0) then + do i=1,trac + fscav_(i) = fscav(i) + enddo + endif + +!> - Initialize CCPP error handling variables + + errmsg = '' + errflg = 0 + +! if (me == 0) write(0,*)' rann=',rannum(1,:),' kdt=',kdt +! if (lprnt) write(0,*)' in RAS fscav=',fscav_,' ccwfac=', +! & ccwfac(ipr),' mp_phys=',mp_phys +! &, ' fscav=',fscav,' trac=',trac +! + km1 = k - 1 + kp1 = k + 1 + if (flipv) then + ksfc = 1 + else + ksfc = kp1 + endif +! + ntrc = trac + IF (CUMFRC) THEN + ntrc = ntrc + 2 + ENDIF + if (ntrc > 0) then + if (.not. allocated(trcfac)) allocate (trcfac(k,ntrc)) + if (.not. allocated(uvi)) allocate (uvi(k,ntrc)) + if (.not. allocated(rcu)) allocate (rcu(k,ntrc)) + do n=1, ntrc + do l=1,k + trcfac(l,n) = one ! For other tracers + rcu(l,n) = zero + enddo + enddo + endif +! +!!!!! initialization for microphysics ACheng + if(mp_phys == 10) then + do l=1,K + do i=1,im + QLCN(i,l) = zero + QICN(i,l) = zero + w_upi(i,l) = zero + cf_upi(i,l) = zero + CNV_MFD(i,l) = zero +! CNV_PRC3(i,l) = zero + CNV_DQLDT(i,l) = zero + CLCN(i,l) = zero + CNV_FICE(i,l) = zero + CNV_NDROP(i,l) = zero + CNV_NICE(i,l) = zero + enddo + enddo + endif +! + if (.not. allocated(alfint)) allocate(alfint(k,ntrc+4)) +! +! call set_ras_afc(dt) +! AFC = -(1.04E-4*DT)*(3600./DT)**0.578 + AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 +! + do l=1,k + do i=1,im + ud_mf(i,l) = zero + dd_mf(i,l) = zero + det_mf(i,l) = zero + enddo + enddo + DO IPT=1,IM + + ccwf = half + if (ccwfac(ipt) >= zero) ccwf = ccwfac(ipt) + + dlq_fac = dlqfac(ipt) + tem = one + dlq_fac + c0 = c00(IPT) * tem + c0i = c00i(IPT) * tem +! +! ctei = .false. +! if (ctei_r(ipt) > ctei_rm) ctei = .true. +! +! Compute NCRND : +! if flipv is true, then input variables are from bottom +! to top while RAS goes top to bottom +! + tem = one / prsi(ipt,ksfc) + + KRMIN = 1 + KRMAX = km1 + KFMAX = KRMAX + kblmx = 1 + kblmn = 1 + DO L=1,KM1 + ll = l + if (flipv) ll = kp1 -l ! Input variables are bottom to top! + SGC = prsl(ipt,ll) * tem + sgcs(l,ipt) = sgc + IF (SGC <= 0.050) KRMIN = L +! IF (SGC <= 0.700) KRMAX = L +! IF (SGC <= 0.800) KRMAX = L + IF (SGC <= 0.760) KRMAX = L +! IF (SGC <= 0.930) KFMAX = L + IF (SGC <= 0.970) KFMAX = L ! Commented on 20060202 +! IF (SGC <= 0.700) kblmx = L ! Commented on 20101015 + IF (SGC <= 0.600) kblmx = L ! +! IF (SGC <= 0.650) kblmx = L ! Commented on 20060202 + IF (SGC <= 0.980) kblmn = L ! + ENDDO + krmin = max(krmin,2) + +! if (kdt == 1 .and. ipt == 1) write(0,*)' kblmn=',kblmn,kblmx +! if (lprnt .and. ipt == ipr) write(0,*)' krmin=',krmin,' krmax=', +! &krmax,' kfmax=',kfmax,' tem=',tem +! + if (fix_ncld_hr) then +!!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 + NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.10001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/900) + 0.50001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/600) + 0.50001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/360) + 0.50001 +! & + 0.50001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * min(1.0,DTF/360) + 0.1 + facdt = delt_c / dt + else + NCRND = min(nrcmax, (KRMAX-KRMIN+1)) + facdt = one / 3600.0 + endif + NCRND = min(nrcm,max(NCRND, 1)) +! + KCR = MIN(K,KRMAX) + KTEM = MIN(K,KFMAX) + KFX = KTEM - KCR + +! if(lprnt)write(0,*)' enter RASCNV k=',k,' ktem=',ktem +! &, ' krmax=',krmax,' kfmax=',kfmax +! &, ' kcr=',kcr, ' cdrag=',cdrag(ipr) + + IF (KFX > 0) THEN + IF (BOTOP) THEN + DO NC=1,KFX + IC(NC) = KTEM + 1 - NC + ENDDO + ELSE + DO NC=KFX,1,-1 + IC(NC) = KTEM + 1 - NC + ENDDO + ENDIF + ENDIF +! + NCMX = KFX + NCRND + IF (NCRND > 0) THEN + DO I=1,NCRND + IRND = (RANNUM(ipt,I)-0.0005)*(KCR-KRMIN+1) + IC(KFX+I) = IRND + KRMIN + ENDDO + ENDIF +! +! ia = 1 +! +! write(0,*)' in rascnv: k=',k,'lat=',lat,' lprnt=',lprnt +! if (lprnt) then +! if (me == 0) then +! write(0,*)' tin',(tin(ia,l),l=k,1,-1) +! write(0,*)' qin',(qin(ia,l),l=k,1,-1) +! endif +! +! + lprint = lprnt .and. ipt == ipr + + do l=1,k + CLW(l) = zero + CLI(l) = zero + ! to be zero i.e. no environmental condensate!!! + QII(l) = zero + QLI(l) = zero +! Initialize heating, drying, cloudiness etc. + tcu(l) = zero + qcu(l) = zero + pcu(l) = zero + flx(l) = zero + flxd(l) = zero + do n=1,ntrc + rcu(l,n) = zero + enddo + enddo + flx(kp1) = zero + flxd(kp1) = zero + rain = zero +! + if (flipv) then ! Input variables are bottom to top! + do l=1,k + ll = kp1 - l + ! Transfer input prognostic data into local variable + toi(l) = tin(ipt,ll) + qoi(l) = qin(ipt,ll) + + PRSM(L) = prsl(ipt,ll) * facmb ! facmb is for conversion to MB + PSJM(L) = prslk(ipt,ll) + phi_l(L) = phil(ipt,ll) + rhc_l(L) = rhc(ipt,ll) +! + if (ntrc > trac) then ! CUMFRC is true + uvi(l,trac+1) = uin(ipt,ll) + uvi(l,trac+2) = vin(ipt,ll) + endif +! + if (trac > 0) then ! tracers such as O3, dust etc + do n=1,trac + uvi(l,n) = ccin(ipt,ll,n+2) + if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero + enddo + endif + enddo + do l=1,kp1 + ll = kp1 + 1 - l ! Input variables are bottom to top! + PRS(LL) = prsi(ipt,L) * facmb ! facmb is for conversion to MB + PSJ(LL) = prsik(ipt,L) + phi_h(LL) = phii(ipt,L) + enddo +! + if (ccin(ipt,1,2) <= -999.0) then ! input ice/water are together + do l=1,k + ll = kp1 -l + tem = ccin(ipt,ll,1) & + & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) + ccin(ipt,ll,2) = ccin(ipt,ll,1) - tem + ccin(ipt,ll,1) = tem + enddo + endif + if (advcld) then + do l=1,k + ll = kp1 -l ! Input variables are bottom to top! + QII(L) = ccin(ipt,ll,1) + QLI(L) = ccin(ipt,ll,2) + enddo + endif + KBL = MAX(MIN(k, kp1-KPBL(ipt)), k/2) +! + else ! Input variables are top to bottom! + + do l=1,k + ! Transfer input prognostic data into local variable + toi(l) = tin(ipt,l) + qoi(l) = qin(ipt,l) + + PRSM(L) = prsl(ipt, L) * facmb ! facmb is for conversion to MB + PSJM(L) = prslk(ipt,L) + phi_l(L) = phil(ipt,L) + rhc_l(L) = rhc(ipt,L) +! + if (ntrc > trac) then ! CUMFRC is true + uvi(l,trac+1) = uin(ipt,l) + uvi(l,trac+2) = vin(ipt,l) + endif +! + if (trac > 0) then ! tracers such as O3, dust etc + do n=1,trac + uvi(l,n) = ccin(ipt,l,n+2) + if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero + enddo + endif + enddo + DO L=1,kp1 + PRS(L) = prsi(ipt,L) * facmb ! facmb is for conversion to MB + PSJ(L) = prsik(ipt,L) + phi_h(L) = phii(ipt,L) + ENDDO +! + if (ccin(ipt,1,2) <= -999.0) then ! input ice/water are together + do l=1,k + tem = ccin(ipt,l,1) & + & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) + ccin(ipt,l,2) = ccin(ipt,l,1) - tem + ccin(ipt,l,1) = tem + enddo + endif + if (advcld) then + do l=1,k + QII(L) = ccin(ipt,l,1) + QLI(L) = ccin(ipt,l,2) + enddo + endif +! + KBL = KPBL(ipt) +! + endif ! end of if (flipv) then +! +! if (lprnt .and. ipt == ipr) write(0,*)' phi_h=',phi_h(:) +! if(lprint) write(0,*)' PRS=',PRS +! if(lprint) write(0,*)' PRSM=',PRSM +! if (lprint) then +! write(0,*)' qns=',qns(ia),' qoi=',qn0(ia,k),'qin=',qin(ia,1) +! if (me == 0) then +! write(0,*)' toi',(tn0(ia,l),l=1,k) +! write(0,*)' qoi',(qn0(ia,l),l=1,k),' kbl=',kbl +! endif +! +! +! do l=k,kctop(1),-1 +!! DPI(L) = 1.0 / (PRS(L+1) - PRS(L)) +! enddo +! +! print *,' ipt=',ipt + + if (advups) then ! For first order upstream for updraft + alfint(:,:) = one + elseif (advtvd) then ! TVD flux limiter scheme for updraft + alfint(:,:) = one + l = krmin + lm1 = l - 1 + dtvd(1,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) & + & + alhl*(qoi(l)-qoi(lm1)) + dtvd(1,2) = qoi(l) - qoi(lm1) + dtvd(1,3) = qli(l) - qli(lm1) + dtvd(1,4) = qii(l) - qii(lm1) + do l=krmin+1,k + lm1 = l - 1 + +! write(0,*)' toi=',toi(l),toi(lm1),' phi_l=',phi_l(l),phi_l(lm1) +! &,' qoi=',qoi(l),qoi(lm1),' cp=',cp,' alhl=',alhl + + dtvd(2,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) & + & + alhl*(qoi(l)-qoi(lm1)) + +! write(0,*)' l=',l,' dtvd=',dtvd(:,1) + + if (abs(dtvd(2,1)) > 1.0e-10) then + tem1 = dtvd(1,1) / dtvd(2,1) + tem2 = abs(tem1) + alfint(l,1) = one - half*(tem1 + tem2)/(one + tem2) ! for h + endif + +! write(0,*)' alfint=',alfint(l,1),' l=',l,' ipt=',ipt + + dtvd(1,1) = dtvd(2,1) +! + dtvd(2,2) = qoi(l) - qoi(lm1) + +! write(0,*)' l=',l,' dtvd2=',dtvd(:,2) + + if (abs(dtvd(2,2)) > 1.0e-10) then + tem1 = dtvd(1,2) / dtvd(2,2) + tem2 = abs(tem1) + alfint(l,2) = one - half*(tem1 + tem2)/(one + tem2) ! for q + endif + dtvd(1,2) = dtvd(2,2) +! + dtvd(2,3) = qli(l) - qli(lm1) + +! write(0,*)' l=',l,' dtvd3=',dtvd(:,3) + + if (abs(dtvd(2,3)) > 1.0e-10) then + tem1 = dtvd(1,3) / dtvd(2,3) + tem2 = abs(tem1) + alfint(l,3) = one - half*(tem1 + tem2)/(one + tem2) ! for ql + endif + dtvd(1,3) = dtvd(2,3) +! + dtvd(2,4) = qii(l) - qii(lm1) + +! write(0,*)' l=',l,' dtvd4=',dtvd(:,4) + + if (abs(dtvd(2,4)) > 1.0e-10) then + tem1 = dtvd(1,4) / dtvd(2,4) + tem2 = abs(tem1) + alfint(l,4) = one - half*(tem1 + tem2)/(one + tem2) ! for qi + endif + dtvd(1,4) = dtvd(2,4) + enddo +! + if (ntrc > 0) then + do n=1,ntrc + l = krmin + dtvd(1,1) = uvi(l,n) - uvi(l-1,n) + do l=krmin+1,k + dtvd(2,1) = uvi(l,n) - uvi(l-1,n) + +! write(0,*)' l=',l,' dtvdn=',dtvd(:,1),' n=',n,' l=',l + + if (abs(dtvd(2,1)) > 1.0e-10) then + tem1 = dtvd(1,1) / dtvd(2,1) + tem2 = abs(tem1) + alfint(l,n+4) = one - half*(tem1 + tem2)/(one + tem2) ! for tracers + endif + dtvd(1,1) = dtvd(2,1) + enddo + enddo + endif + else + alfint(:,:) = half ! For second order scheme + endif + alfind(:) = half +! +! write(0,*)' after alfint for ipt=',ipt + +! Resolution dependent press grad correction momentum mixing + + if (CUMFRC) then + do l=krmin,k + tem = one - max(pgfbot, min(pgftop, pgftop+pgfgrad*prsm(l))) + trcfac(l,trac+1) = tem + trcfac(l,trac+2) = tem + enddo + endif +! +! lprint = lprnt .and. ipt == ipr + +! if (lprint) then +! write(0,*)' trcfac=',trcfac(krmin:k,1+trac) +! write(0,*)' alfint=',alfint(krmin:k,1) +! write(0,*)' alfinq=',alfint(krmin:k,2) +! write(0,*)' alfini=',alfint(krmin:k,4) +! write(0,*)' alfinu=',alfint(krmin:k,5) +! endif +! +! if (calkbl) kbl = k + + if (calkbl) then + kbl = kblmn + else + kbl = min(kbl, kblmn) + endif +! + DO NC=1,NCMX ! multi cloud loop +! + IB = IC(NC) ! cloud top level index + if (ib > kbl-1) cycle + +! lprint = lprnt .and. ipt == ipr .and. ib == 57 +! +! if (lprint) write(0,*)' calling cloud type ib=',ib,' kbl=',kbl +! *, ' kpbl=',kpbl,' alfint=',alfint,' frac=',frac +! *, ' ntrc=',ntrc,' ipt=',ipt +! +!**************************************************************************** +! if (advtvd) then ! TVD flux limiter scheme for updraft +! l = ib +! lm1 = l - 1 +! dtvd(1,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) +! & + alhl*(qoi(l)-qoi(lm1)) +! dtvd(1,2) = qoi(l) - qoi(lm1) +! dtvd(1,3) = qli(l) - qli(lm1) +! dtvd(1,4) = qii(l) - qii(lm1) +! do l=ib+1,k +! lm1 = l - 1 +! dtvd(2,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) +! & + alhl*(qoi(l)-qoi(lm1)) +! if (abs(dtvd(2,1)) > 1.0e-10) then +! tem1 = dtvd(1,1) / dtvd(2,1) +! tem2 = abs(tem1) +! alfint(l,1) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for h +! endif +! dtvd(1,1) = dtvd(2,1) +! +! dtvd(2,2) = qoi(l) - qoi(lm1) +! if (abs(dtvd(2,2)) > 1.0e-10) then +! tem1 = dtvd(1,2) / dtvd(2,2) +! tem2 = abs(tem1) +! alfint(l,2) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for q +! endif +! dtvd(1,2) = dtvd(2,2) +! +! dtvd(2,3) = qli(l) - qli(lm1) +! if (abs(dtvd(2,3)) > 1.0e-10) then +! tem1 = dtvd(1,3) / dtvd(2,3) +! tem2 = abs(tem1) +! alfint(l,3) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for ql +! endif +! dtvd(1,3) = dtvd(2,3) +! +! dtvd(2,4) = qii(l) - qii(lm1) +! if (abs(dtvd(2,4)) > 1.0e-10) then +! tem1 = dtvd(1,4) / dtvd(2,4) +! tem2 = abs(tem1) +! alfint(l,4) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for qi +! endif +! dtvd(1,4) = dtvd(2,4) +! enddo +! +! if (ntrc > 0) then +! do n=1,ntrc +! l = ib +! dtvd(1,1) = uvi(l,n) - uvi(l-1,n) +! do l=ib+1,k +! dtvd(2,1) = uvi(l,n) - uvi(l-1,n) +! if (abs(dtvd(2,1)) > 1.0e-10) then +! tem1 = dtvd(1,1) / dtvd(2,1) +! tem2 = abs(tem1) +! alfint(l,n+4) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for tracers +! endif +! dtvd(1,1) = dtvd(2,1) +! enddo +! enddo +! endif +! endif +!**************************************************************************** +! +! if (lprint) then +! ia = ipt +! write(0,*)' toi=',(toi(ia,l),l=1,K) +! write(0,*)' qoi=',(qoi(ia,l),l=1,K),' kbl=',kbl +! write(0,*)' toi=',(toi(l),l=1,K) +! write(0,*)' qoi=',(qoi(l),l=1,K),' kbl=',kbl +! write(0,*)' prs=',(prs(l),l=1,K) +! endif +! + WFNC = zero + do L=IB,KP1 + FLX(L) = zero + FLXD(L) = zero + enddo +! +! if(lprint)then +! write(0,*) ' CALLING CLOUD TYPE IB= ', IB,' DT=',DT,' K=',K +! &, 'ipt=',ipt +! write(0,*) ' TOI=',(TOI(L),L=IB,K) +! write(0,*) ' QOI=',(QOI(L),L=IB,K) +! write(0,*) ' qliin=',qli +! write(0,*) ' qiiin=',qii +! endif +! + TLA = -10.0 +! + qiid = qii(ib) ! cloud top level ice before convection + qlid = qli(ib) ! cloud top level water before convection +! +! if(lprint) write(0,*)' uvitke=',uvi(ib:k,ntk-2), ' ib=',ib +! &,' trcmin=',trcmin(ntk-2) +! if (lprnt) then +! qoi_l(ib:k) = qoi(ib:k) +! qli_l(ib:k) = qli(ib:k) +! qii_l(ib:k) = qii(ib:k) +! endif +! rainp = rain + + CALL CLOUD(K, KP1, IB, ntrc, kblmx, kblmn & + &, FRAC, MAX_NEG_BOUY, vsmooth, do_aw & + &, REVAP, WRKFUN, CALKBL, CRTFUN, lprint & + &, DT, KDT, TLA, DPD & + &, ALFINT, rhfacl, rhfacs, garea(ipt) & + &, ccwf, CDRAG(ipt), trcfac & + &, alfind, rhc_l, phi_l, phi_h, PRS, PRSM,sgcs(1,ipt) & + &, TOI, QOI, UVI, QLI, QII, KBL, DDVEL(ipt) & + &, TCU, QCU, RCU, PCU, FLX, FLXD, RAIN, WFNC, fscav_ & +! &, trcmin) + &, trcmin, ntk-2, c0, qw0, c0i, qi0, dlq_fac, afc) +! &, ctei) + +! if(lprint) write(0,*)' uvitkea=',uvi(ib:k,ntk-2),' ib=',ib +! if (lprint) then +! write(0,*) ' rain=',rain,' ipt=',ipt +! write(0,*) ' after calling CLOUD TYPE IB= ', IB & +! &,' rain=',rain,' prskd=',prs(ib),' qli=',qli(ib),' qii=',qii(ib) +! &,' rainp=',rainp +! write(0,*) ' phi_h=',phi_h(K-5:KP1) +! write(0,*) ' TOI=',(TOI(L),L=1,K),' me=',me,' ib=',ib +! write(0,*) ' QOI=',(QOI(L),L=1,K) +! write(0,*) ' qliou=',qli +! write(0,*) ' qiiou=',qii +! sumq = 0.0 +! do l=ib,k +! sumq = sumq+(qoi(l)+qli(l)+qii(l)-qoi_l(l)-qli_l(l)-qii_l(l)) +! & * (prs(l+1)-prs(l)) * (100.0/grav) +! enddo +! write(0,*)' sumq=',sumq,' rainib=',rain-rainp,' ib=',ib + +! endif +! + if (flipv) then + do L=IB,K + ll = kp1 -l ! Input variables are bottom to top! + ud_mf(ipt,ll) = ud_mf(ipt,ll) + flx(l+1) + dd_mf(ipt,ll) = dd_mf(ipt,ll) + flxd(l+1) + enddo + ll = kp1 - ib + det_mf(ipt,ll) = det_mf(ipt,ll) + flx(ib) + + if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 + +! if (lprint) write(0,*)' ib=',ib,' flx=',flx(ib),' ll=',ll +! &,' ud_mf=',ud_mf(ipt,:) + + CNV_MFD(ipt,ll) = CNV_MFD(ipt,ll) + flx(ib)/dt + +! if (lprint) write(0,*)' ib=',ib,' CNV_MFD=',CNV_MFD(ipt,ll) +! &,' ll=',ll,' kp1=',kp1 + +! CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) +! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt + CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) + flx(ib)* + & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt +! & max(0.,(QLI(ib)+QII(ib)))/dt/3. + if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) + & ,ipt,ll + endif + + else + + do L=IB,K + ud_mf(ipt,l) = ud_mf(ipt,l) + flx(l+1) + dd_mf(ipt,l) = dd_mf(ipt,l) + flxd(l+1) + enddo + det_mf(ipt,ib) = det_mf(ipt,ib) + flx(ib) + + if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 +! if (lprint) write(0,*)' ib=',ib,' flx=',flx(ib),' ib=',ib +! &,' ud_mf=',ud_mf(ipt,:) + CNV_MFD(ipt,ib) = CNV_MFD(ipt,ib) + flx(ib)/dt +! if (lprint) write(0,*)' ib=',ib,' CNV_MFD=',CNV_MFD(ipt,ib) +! &,' ib=',ib,' kp1=',kp1 +! CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) +! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt + CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* + & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt +! & max(0.,(QLI(ib)+QII(ib)))/dt/3. + if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) + & ,ipt,ib + endif + endif +! +! +! Warining!!!! +! ------------ +! By doing the following, CLOUD does not contain environmental +! condensate! +! + if (.not. advcld) then + do l=1,K + clw(l) = clw(l) + QLI(L) + cli(l) = cli(l) + QII(L) + QLI(L) = zero + QII(L) = zero + enddo + endif +! + ENDDO ! End of the NC loop! +! + RAINC(ipt) = rain * 0.001 ! Output rain is in meters + +! if (lprint) then +! write(0,*) ' convective precip=',rain*86400/dt,' mm/day' +! 1, ' ipt=',ipt +! write(0,*) ' toi',(tn0(imax,l),l=1,k) +! write(0,*) ' qoi',(qn0(imax,l),l=1,k) +! endif +! + +! + ktop(ipt) = kp1 + kbot(ipt) = 0 + + kcnv(ipt) = 0 + + + do l=k,1,-1 +! qli(l) = max(qli(l), zero) +! qii(l) = max(qii(l), zero) +! clw(i) = max(clw(i), zero) +! cli(i) = max(cli(i), zero) + + if (sgcs(l,ipt) < 0.93 .and. abs(tcu(l)) > one_m10) then +! if (sgcs(l,ipt) < 0.90 .and. tcu(l) .ne. 0.0) then +! if (sgcs(l,ipt) < 0.85 .and. tcu(l) .ne. 0.0) then + kcnv(ipt) = 1 + endif +! New test for convective clouds ! added in 08/21/96 + if (clw(l)+cli(l) > zero .OR. & + & qli(l)+qii(l) > clwmin) ktop(ipt) = l + enddo + do l=1,km1 + if (clw(l)+cli(l) > zero .OR. & + & qli(l)+qii(l) > clwmin) kbot(ipt) = l + enddo +! + if (flipv) then + do l=1,k + ll = kp1 - l + tin(ipt,ll) = toi(l) ! Temperature + qin(ipt,ll) = qoi(l) ! Specific humidity + uin(ipt,ll) = uvi(l,trac+1) ! U momentum + vin(ipt,ll) = uvi(l,trac+2) ! V momentum + +!! for 2M microphysics, always output these variables + if (mp_phys == 10) then + if (advcld) then + QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) + QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) + CNV_FICE(ipt,ll) = QICN(ipt,ll) + & / max(1.e-10,QLCN(ipt,ll)+QICN(ipt,ll)) + else + QLCN(ipt,ll) = qli(l) + QICN(ipt,ll) = qii(l) + CNV_FICE(ipt,ll) = qii(l)/max(1.e-10,qii(l)+qli(l)) + endif +!! CNV_PRC3(ipt,ll) = PCU(l)/dt +! CNV_PRC3(ipt,ll) = zero +! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,ll + cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ + & 500*ud_mf(ipt,ll)/dt), cfmax)) +! & 500*ud_mf(ipt,ll)/dt), 0.60)) +! if (lprint) write(0,*)' ll=',ll,' cf_upi=',cf_upi(ipt,ll) +! &,' ud_mf=',ud_mf(ipt,ll),' dt=',dt,' cfmax=',cfmax + CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft + w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / + & (dt*max(cf_upi(ipt,ll),1.e-12)*prsl(ipt,ll)) + endif + + if (trac > 0) then + do n=1,trac + ccin(ipt,ll,n+2) = uvi(l,n) ! Tracers + enddo + endif + enddo + if (advcld) then + do l=1,k + ll = kp1 - l + ccin(ipt,ll,1) = qii(l) ! Cloud ice + ccin(ipt,ll,2) = qli(l) ! Cloud water + enddo + else + do l=1,k + ll = kp1 - l + ccin(ipt,ll,1) = ccin(ipt,ll,1) + cli(l) + ccin(ipt,ll,2) = ccin(ipt,ll,2) + clw(l) + enddo + endif +! + ktop(ipt) = kp1 - ktop(ipt) + kbot(ipt) = kp1 - kbot(ipt) +! +! if (lprint) then +! write(0,*) ' tin',(tin(ia,l),l=k,1,-1) +! write(0,*) ' qin',(qin(ia,l),l=k,1,-1) +! endif +! + else + + do l=1,k + tin(ipt,l) = toi(l) ! Temperature + qin(ipt,l) = qoi(l) ! Specific humidity + uin(ipt,l) = uvi(l,trac+1) ! U momentum + vin(ipt,l) = uvi(l,trac+2) ! V momentum + +!! for 2M microphysics, always output these variables + if (mp_phys == 10) then + if (advcld) then + QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) + QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) + CNV_FICE(ipt,l) = QICN(ipt,l) + & / max(1.e-10,QLCN(ipt,l)+QICN(ipt,l)) + else + QLCN(ipt,l) = qli(l) + QICN(ipt,l) = qii(l) + CNV_FICE(ipt,l) = qii(l)/max(1.e-10,qii(l)+qli(l)) + endif +!! CNV_PRC3(ipt,l) = PCU(l)/dt +! CNV_PRC3(ipt,l) = zero +! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,l + cf_upi(ipt,l) = max(zero,min(0.02*log(one+ + & 500*ud_mf(ipt,l)/dt), cfmax)) +! & 500*ud_mf(ipt,l)/dt), 0.60)) + CLCN(ipt,l) = cf_upi(ipt,l) !downdraft is below updraft + w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / + & (dt*max(cf_upi(ipt,l),1.e-12)*prsl(ipt,l)) + endif + + if (trac > 0) then + do n=1,trac + ccin(ipt,l,n+2) = uvi(l,n) ! Tracers + enddo + endif + enddo + if (advcld) then + do l=1,k + ccin(ipt,l,1) = qii(l) ! Cloud ice + ccin(ipt,l,2) = qli(l) ! Cloud water + enddo + else + do l=1,k + ccin(ipt,l,1) = ccin(ipt,l,1) + cli(l) + ccin(ipt,l,2) = ccin(ipt,l,2) + clw(l) + enddo + endif +! +! if (lprint) then +! write(0,*) ' tin',(tin(ia,l),l=k,1,-1) +! write(0,*) ' qin',(qin(ia,l),l=k,1,-1) +! endif +! + endif +! +! Velocity scale from the downdraft! +! + DDVEL(ipt) = DDVEL(ipt) * DDFAC * GRAV / (prs(KP1)-prs(K)) +! + ENDDO ! End of the IPT Loop! + + deallocate (alfint, uvi, trcfac, rcu) +! + RETURN + end subroutine rascnv_run + SUBROUTINE CLOUD( & + & K, KP1, KD, NTRC, KBLMX, kblmn & + &, FRACBL, MAX_NEG_BOUY, vsmooth, do_aw & + &, REVAP, WRKFUN, CALKBL, CRTFUN, lprnt & + &, DT, KDT, TLA, DPD & + &, ALFINT, RHFACL, RHFACS, garea, ccwf, cd, trcfac & + &, alfind, rhc_ls, phil, phih, prs, prsm, sgcs & + &, TOI, QOI, ROI, QLI, QII, KPBL, DSFC & + &, TCU, QCU, RCU, PCU, FLX, FLXD, CUP, WFNC,fscav_ & + &, trcmin, ntk, c0, qw0, c0i, qi0, dlq_fac, afc) +! &, ctei) + +! +!*********************************************************************** +!******************** Relaxed Arakawa-Schubert ************************ +!****************** Plug Compatible Scalar Version ********************* +!************************ SUBROUTINE CLOUD **************************** +!************************ October 2004 **************************** +!******************** VERSION 2.0 (modified) ************************* +!************* Shrinivas.Moorthi@noaa.gov (301) 683-3718 ***** ******** +!*********************************************************************** +!*References: +!----------- +! NOAA Technical Report NWS/NCEP 99-01: +! Documentation of Version 2 of Relaxed-Arakawa-Schubert +! Cumulus Parameterization with Convective Downdrafts, June 1999. +! by S. Moorthi and M. J. Suarez. +! +! Relaxed Arakawa-Schubert Cumulus Parameterization (Version 2) +! with Convective Downdrafts - Unpublished Manuscript (2002) +! by Shrinivas Moorthi and Max J. Suarez. +! +!*********************************************************************** +! +!===> UPDATES CLOUD TENDENCIES DUE TO A SINGLE CLOUD +!===> DETRAINING AT LEVEL KD. +! +!*********************************************************************** +! +!===> TOI(K) INOUT TEMPERATURE KELVIN +!===> QOI(K) INOUT SPECIFIC HUMIDITY NON-DIMENSIONAL +!===> ROI(K,NTRC)INOUT TRACER ARBITRARY +!===> QLI(K) INOUT LIQUID WATER NON-DIMENSIONAL +!===> QII(K) INOUT ICE NON-DIMENSIONAL + +!===> PRS(KP1) INPUT PRESSURE @ EDGES MB +!===> PRSM(K) INPUT PRESSURE @ LAYERS MB +!===> SGCS(K) INPUT Local sigma +!===> PHIH(KP1) INPUT GEOPOTENTIAL @ EDGES IN MKS units +!===> PHIL(K) INPUT GEOPOTENTIAL @ LAYERS IN MKS units +!===> PRJ(KP1) INPUT (P/P0)^KAPPA @ EDGES NON-DIMENSIONAL +!===> PRJM(K) INPUT (P/P0)^KAPPA @ LAYERS NON-DIMENSIONAL + +!===> K INPUT THE RISE & THE INDEX OF THE SUBCLOUD LAYER +!===> KD INPUT DETRAINMENT LEVEL ( 1<= KD < K ) +!===> NTRC INPUT NUMBER OF TRACERS. MAY BE ZERO. +!===> kblmx INPUT highest level the pbl can take +!===> kblmn INPUT lowest level the pbl can take +!===> DPD INPUT Critical normalized pressure (i.e. sigma) at the cloud top +! No downdraft calculation if the cloud top pressure is higher +! than DPD*PRS(KP1) +! +!===> TCU(K ) UPDATE TEMPERATURE TENDENCY DEG +!===> QCU(K ) UPDATE WATER VAPOR TENDENCY (G/G) +!===> RCU(K,NTRC)UPDATE TRACER TENDENCIES ND +!===> PCU(K) UPDATE PRECIP @ BASE OF LAYER KG/M^2 +!===> FLX(K ) UPDATE MASS FLUX @ TOP OF LAYER KG/M^2 +!===> CUP UPDATE PRECIPITATION AT THE SURFACE KG/M^2 +! + USE MACHINE , ONLY : kind_phys +! use module_ras + IMPLICIT NONE +! + real (kind=kind_phys) :: RHMAX=1.0 ! MAX RELATIVE HUMIDITY + &, QUAD_LAM=1.0 ! MASK FOR QUADRATIC LAMBDA + &, RHRAM=0.05 ! PBL RELATIVE HUMIDITY RAMP +! &, RHRAM=0.15 ! PBL RELATIVE HUMIDITY RAMP + &, HCRITD=4000.0 ! Critical Moist Static Energy for Deep clouds + &, HCRITS=2000.0 ! Critical Moist Static Energy for Shallow clouds + &, pcrit_lcl=250.0 ! Critical pressure difference between boundary layer top + ! layer top and lifting condensation level (hPa) +! &, hpert_fac=1.01 ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.005 ! Perturbation on hbl when ctei=.true. + &, qudfac=quad_lam*half, shalfac=3.0 +! &, qudfac=quad_lam*pt25, shalfac=3.0 ! Yogesh's + &, testmb=0.1, testmbi=one/testmb + &, testmboalhl=testmb/alhl + &, c0ifac=0.07 ! following Han et al, 2016 MWR + &, dpnegcr = 150.0 +! &, dpnegcr = 100.0 +! &, dpnegcr = 200.0 +! + real(kind=kind_phys), parameter :: ERRMIN=0.0001 & + &, ERRMI2=0.1*ERRMIN & +! &, rainmin=1.0e-9 ! & + &, rainmin=1.0e-8 & + &, oneopt9=1.0/0.09 & + &, oneopt4=1.0/0.04 + real(kind=kind_phys), parameter :: almax=1.0e-2 + &, almin1=0.0, almin2=0.0 + real(kind=kind_phys), parameter :: bldmax = 300.0, bldmin=25.0 +! +! INPUT ARGUMENTS + +! LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP, ctei + LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP + logical vsmooth, do_aw, lprnt + INTEGER K, KP1, KD, NTRC, kblmx, kblmn, ntk + + + real(kind=kind_phys), dimension(K) :: TOI, QOI, PRSM, QLI, QII& + &, PHIL, SGCS, rhc_ls & + &, alfind + real(kind=kind_phys), dimension(KP1) :: PRS, PHIH + real(kind=kind_phys), dimension(K,NTRC) :: ROI, trcfac + real(kind=kind_phys), dimension(ntrc) :: trcmin + real(kind=kind_phys) :: CD, DSFC + INTEGER :: KPBL, KBL, KB1, kdt + + real(kind=kind_phys) ALFINT(K,NTRC+4) + real(kind=kind_phys) FRACBL, MAX_NEG_BOUY, DPD & + &, RHFACL, RHFACS, garea, ccwf & + &, c0, qw0, c0i, qi0, dlq_fac, afc + +! UPDATE ARGUMENTS + + real(kind=kind_phys), dimension(K) :: TCU, QCU, TCD, QCD, PCU + real(kind=kind_phys), dimension(KP1) :: FLX, FLXD + real(kind=kind_phys), dimension(K,NTRC) :: RCU + real(kind=kind_phys) :: CUP +! +! TEMPORARY WORK SPACE + + real(kind=kind_phys), dimension(KD:K) :: HOL, QOL, HST, QST & + &, TOL, GMH, AKT, AKC, BKC, LTL, RNN & + &, FCO, PRI, QIL, QLL, ZET, XI, RNS & + &, Q0U, Q0D, vtf, CIL, CLL, ETAI, dlq & + &, wrk1, wrk2, dhdp, qrb, qrt, evp & + &, ghd, gsd, etz, cldfr, sigf, rho + + real(kind=kind_phys), dimension(KD:KP1) :: GAF, GMS, GAM, DLB & + &, DLT, ETA, PRL, BUY, ETD, HOD, QOD, wvl + real(kind=kind_phys), dimension(KD:K-1) :: etzi + + real(kind=kind_phys) fscav_(ntrc) + + LOGICAL ep_wfn, cnvflg, LOWEST, DDFT, UPDRET + + real(kind=kind_phys) ALM, DET, HCC, CLP & + &, HSU, HSD, QTL, QTV & + &, AKM, WFN, HOS, QOS & + &, AMB, TX1, TX2, TX3 & + &, TX4, TX5, QIS, QLS & + &, HBL, QBL, RBL(NTRC), wcbase & + &, QLB, QIB, PRIS & + &, WFNC, TX6, ACR & + &, TX7, TX8, TX9, RHC & + &, hstkd, qstkd, ltlkd, q0ukd, q0dkd, dlbkd & + &, qtp, qw00, qi00, qrbkd & + &, hstold, rel_fac, prism & + &, TL, PL, QL, QS, DQS, ST1, SGN, TAU, & + & QTVP, HB, QB, TB, QQQ, & + & HCCP, DS, DH, AMBMAX, X00, EPP, QTLP, & + & DPI, DPHIB, DPHIT, DEL_ETA, DETP, & + & TEM, TEM1, TEM2, TEM3, TEM4, & + & ST2, ST3, ST4, ST5, & + & ERRH, ERRW, ERRE, TEM5, & + & TEM6, HBD, QBD, st1s, shal_fac, hmax, hmin, & + & dhdpmn, avt, avq, avr, avh & + &, TRAIN, DOF, CLDFRD, tla, gmf & + &, FAC, RSUM1, RSUM2, RSUM3, dpneg, hcrit & + &, ACTEVAP,AREARAT,DELTAQ,MASS,MASSINV,POTEVAP & + &, TEQ,QSTEQ,DQDT,QEQ & + &, CLFRAC, DT, clf, clvfr, delzkm, fnoscav, delp +! &, almin1, almin2 + + INTEGER I, L, N, KD1, II, idh, lcon & + &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1, kbls, kmxh + &, kblh, kblm, kblpmn, kmax, kmaxm1, kmaxp1, klcl, kmin, kmxb +! +!*********************************************************************** +! +! almin2 = 0.2 * sqrt(pi/garea) +! almin1 = almin2 + + KM1 = K - 1 + KD1 = KD + 1 + + do l=1,K + tcd(L) = zero + qcd(L) = zero + enddo +! +! if (lprnt) then +! write(0,*) ' IN CLOUD for KD=',kd +! write(0,*) ' prs=',prs(Kd:KP1) +! write(0,*) ' phil=',phil(KD:K) +!! write(0,*) ' phih=',phih(kd:KP1),' kdt=',kdt +! write(0,*) ' phih=',phih(KD:KP1) +! write(0,*) ' toi=',toi +! write(0,*) ' qoi=',qoi +! endif +! + CLDFRD = zero + DOF = zero + PRL(KP1) = PRS(KP1) +! + DO L=KD,K + RNN(L) = zero + ZET(L) = zero + XI(L) = zero +! + TOL(L) = TOI(L) + QOL(L) = QOI(L) + PRL(L) = PRS(L) + CLL(L) = QLI(L) + CIL(L) = QII(L) + BUY(L) = zero + + wvl(l) = zero + ENDDO + wvl(kp1) = zero +! + if (vsmooth) then + do l=kd,k + wrk1(l) = tol(l) + wrk2(l) = qol(l) + enddo + do l=kd1,km1 + tol(l) = pt25*wrk1(l-1) + half*wrk1(l) + pt25*wrk1(l+1) + qol(l) = pt25*wrk2(l-1) + half*wrk2(l) + pt25*wrk2(l+1) + enddo + endif +! + DO L=KD, K + DPI = ONE / (PRL(L+1) - PRL(L)) + PRI(L) = GRAVFAC * DPI +! + PL = PRSM(L) + TL = TOL(L) + + rho(l) = cmb2pa * pl / (rgas*tl*(one+nu*qol(l))) + + AKT(L) = (PRL(L+1) - PL) * DPI +! + CALL QSATCN(TL, PL, QS, DQS) +! CALL QSATCN(TL, PL, QS, DQS,lprnt) +! + QST(L) = QS + GAM(L) = DQS * ELOCP + ST1 = ONE + GAM(L) + GAF(L) = ONEOALHL * GAM(L) / ST1 + + QL = MAX(MIN(QS*RHMAX,QOL(L)), ONE_M10) + QOL(L) = QL + + TEM = CP * TL + LTL(L) = TEM * ST1 / (ONE+NU*(QST(L)+TL*DQS)) + vtf(L) = one + NU * QL + ETA(L) = ONE / (LTL(L) * VTF(L)) + + HOL(L) = TEM + QL * ALHL + HST(L) = TEM + QS * ALHL +! + ENDDO +! + ETA(KP1) = ZERO + GMS(K) = ZERO +! + AKT(KD) = HALF + GMS(KD) = ZERO +! + CLP = ZERO +! + GAM(KP1) = GAM(K) + GAF(KP1) = GAF(K) +! + DO L=K,KD1,-1 + DPHIB = PHIL(L) - PHIH(L+1) + DPHIT = PHIH(L) - PHIL(L) +! + DLB(L) = DPHIB * ETA(L) ! here eta contains 1/(L*(1+nu*q)) + DLT(L) = DPHIT * ETA(L) +! + QRB(L) = DPHIB + QRT(L) = DPHIT +! + ETA(L) = ETA(L+1) + DPHIB + + HOL(L) = HOL(L) + ETA(L) + hstold = hst(l) + HST(L) = HST(L) + ETA(L) +! + ETA(L) = ETA(L) + DPHIT + ENDDO +! +! For the cloud top layer +! + L = KD + + DPHIB = PHIL(L) - PHIH(L+1) +! + DLB(L) = DPHIB * ETA(L) +! + QRB(L) = DPHIB + QRT(L) = DPHIB +! + ETA(L) = ETA(L+1) + DPHIB + + HOL(L) = HOL(L) + ETA(L) + HST(L) = HST(L) + ETA(L) +! +! if (kd == 12) then +! if (lprnt) then +! write(0,*) ' IN CLOUD for KD=',KD,' K=',K +! write(0,*) ' l=',l,' hol=',hol(l),' hst=',hst(l) +! write(0,*) ' TOL=',tol +! write(0,*) ' qol=',qol +! write(0,*) ' hol=',hol +! write(0,*) ' hst=',hst +! endif +! endif +! +! To determine KBL internally -- If KBL is defined externally +! the following two loop should be skipped +! +! if (lprnt) write(0,*) ' calkbl=',calkbl + + hcrit = hcritd + if (sgcs(kd) > 0.65) hcrit = hcrits + IF (CALKBL) THEN + KTEM = MAX(KD+1, KBLMX) + hmin = hol(k) + kmin = k + do l=km1,kd,-1 + if (hmin > hol(l)) then + hmin = hol(l) + kmin = l + endif + enddo + if (kmin == k) return + hmax = hol(k) + kmax = k + do l=km1,ktem,-1 + if (hmax < hol(l)) then + hmax = hol(l) + kmax = l + endif + enddo + kmxb = kmax + if (kmax < kmin) then + kmax = k + kmxb = k + hmax = hol(kmax) + elseif (kmax < k) then + do l=kmax+1,k + if (abs(hol(kmax)-hol(l)) > half * hcrit) then + kmxb = l - 1 + exit + endif + enddo + endif + kmaxm1 = kmax - 1 + kmaxp1 = kmax + 1 + kblpmn = kmax +! + dhdp(kmax:k) = zero + dhdpmn = dhdp(kmax) + do l=kmaxm1,ktem,-1 + dhdp(l) = (HOL(L)-HOL(L+1)) / (PRL(L+2)-PRL(L)) + if (dhdp(l) < dhdpmn) then + dhdpmn = dhdp(l) + kblpmn = l + 1 + elseif (dhdp(l) > zero .and. l <= kmin) then + exit + endif + enddo + kbl = kmax + if (kblpmn < kmax) then + do l=kblpmn,kmaxm1 + if (hmax-hol(l) < half*hcrit) then + kbl = l + exit + endif + enddo + endif + +! if(lprnt) write(0,*)' kbl=',kbl,' kbls=',kbls,' kmax=',kmax +! + klcl = kd1 + if (kmax > kd1) then + do l=kmaxm1,kd1,-1 + if (hmax > hst(l)) then + klcl = l+1 + exit + endif + enddo + endif +! if(lprnt) write(0,*)' klcl=',klcl,' ii=',ii +! if (klcl == kd .or. klcl < ktem) return + +! This is to handle mid-level convection from quasi-uniform h + + if (kmax < kmxb) then + kmax = max(kd1, min(kmxb,k)) + kmaxm1 = kmax - 1 + kmaxp1 = kmax + 1 + endif + + +! if (prl(Kmaxp1) - prl(klcl) > 250.0 ) return + + ii = max(kbl,kd1) + kbl = max(klcl,kd1) + tem = min(50.0,max(10.0,(prl(kmaxp1)-prl(kd))*0.10)) + if (prl(kmaxp1) - prl(ii) > tem .and. ii > kbl) kbl = ii + +! if(lprnt) write(0,*)' kbl2=',kbl,' ii=',ii + + if (kbl .ne. ii) then + if (PRL(kmaxp1)-PRL(KBL) > bldmax) kbl = max(kbl,ii) + endif + if (kbl < ii) then + if (hol(ii)-hol(ii-1) > half*hcrit) kbl = ii + endif + + if (prl(kbl) - prl(klcl) > pcrit_lcl) return +! +! KBL = min(kmax, MAX(KBL,KBLMX)) + KBL = min(kblmn, MAX(KBL,KBLMX)) +! kbl = min(kblh,kbl) +!!! +! tem1 = max(prl(kP1)-prl(k), & +! & min((prl(kbl) - prl(kd))*0.05, 10.0)) +!! & min((prl(kbl) - prl(kd))*0.05, 20.0)) +!! & min((prl(kbl) - prl(kd))*0.05, 30.0)) +! if (prl(kp1)-prl(kbl) < tem1) then +! KTEM = MAX(KD+1, KBLMX) +! do l=k,KTEM,-1 +! tem = prl(kp1) - prl(l) +! if (tem > tem1) then +! kbl = min(kbl,l) +! exit +! endif +! enddo +! endif +! if (kbl == kblmx .and. kmax >= km1) kbl = k - 1 +!!! + + KPBL = KBL + +! if(lprnt)write(0,*)' 1st kbl=',kbl,' kblmx=',kblmx,' kd=',kd +! if(lprnt)write(0,*)' tx3=',tx3,' tx1=',tx1,' tem=',tem +! 1, ' hcrit=',hcrit + + ELSE + KBL = KPBL +! if(lprnt)write(0,*)' 2nd kbl=',kbl + ENDIF + +! if(lprnt)write(0,*)' after CALKBL l=',l,' hol=',hol(l) +! 1, ' hst=',hst(l) +! + KBL = min(kmax,MAX(KBL,KD+2)) + KB1 = KBL - 1 +!! +! if (lprnt) write(0,*)' kbl=',kbl,' prlkbl=',prl(kbl),prl(kp1) + + if (PRL(Kmaxp1)-PRL(KBL) > bldmax .or. kb1 <= kd ) then +! & .or. PRL(Kmaxp1)-PRL(KBL) < bldmin) then + return + endif +! +! if (lprnt) write(0,*)' kbl=',kbl +! write(0,*)' kbl=',kbl,' kmax=',kmax,' kmaxp1=',kmaxp1,' k=',k +! + PRIS = ONE / (PRL(KP1)-PRL(KBL)) + PRISM = ONE / (PRL(Kmaxp1)-PRL(KBL)) + TX1 = ETA(KBL) ! geopotential height at KBL +! + GMS(KBL) = zero + XI(KBL) = zero + ZET(KBL) = zero +! + shal_fac = one +! if (prl(kbl)-prl(kd) < 300.0 .and. kmax == k) shal_fac = shalfac + if (prl(kbl)-prl(kd) < 350.0 .and. kmax == k) shal_fac = shalfac + DO L=Kmax,KD,-1 + IF (L >= KBL) THEN + ETA(L) = (PRL(Kmaxp1)-PRL(L)) * PRISM + ELSE + ZET(L) = (ETA(L) - TX1) * ONEBG + XI(L) = ZET(L) * ZET(L) * (QUDFAC*shal_fac) + ETA(L) = ZET(L) - ZET(L+1) + GMS(L) = XI(L) - XI(L+1) + ENDIF +! if (lprnt) write(0,*)' l=',l,' eta=',eta(l),' kbl=',kbl + ENDDO + if (kmax < k) then + do l=kmaxp1,kp1 + eta(l) = zero + enddo + endif +! + HBL = HOL(Kmax) * ETA(Kmax) + QBL = QOL(Kmax) * ETA(Kmax) + QLB = CLL(Kmax) * ETA(Kmax) + QIB = CIL(Kmax) * ETA(Kmax) + TX1 = QST(Kmax) * ETA(Kmax) +! + DO L=Kmaxm1,KBL,-1 + TEM = ETA(L) - ETA(L+1) + HBL = HBL + HOL(L) * TEM + QBL = QBL + QOL(L) * TEM + QLB = QLB + CLL(L) * TEM + QIB = QIB + CIL(L) * TEM + TX1 = TX1 + QST(L) * TEM + ENDDO + +! if (ctei .and. sgcs(kd) > 0.65) then +! hbl = hbl * hpert_fac +! qbl = qbl * hpert_fac +! endif + +! if (lprnt) write(0,*)' hbl=',hbl,' qbl=',qbl +! Find Min value of HOL in TX2 + TX2 = HOL(KD) + IDH = KD1 + DO L=KD1,KB1 + IF (HOL(L) < TX2) THEN + TX2 = HOL(L) + IDH = L ! Level of minimum moist static energy! + ENDIF + ENDDO + IDH = 1 +! IDH = MAX(KD1, IDH) + IDH = MAX(KD, IDH) ! Moorthi May, 31, 2019 +! + TEM1 = HBL - HOL(KD) + TEM = HBL - HST(KD1) - LTL(KD1) * NU *(QOL(KD1)-QST(KD1)) + LOWEST = KD == KB1 + + lcon = kd + do l=kb1,kd1,-1 + if (hbl >= hst(l)) then + lcon = l + exit + endif + enddo +! + if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0) & + & return +! + TX1 = RHFACS - QBL / TX1 ! Average RH + + cnvflg = (TEM > ZERO .OR. (LOWEST .AND. TEM1 >= ZERO)) & + & .AND. TX1 < RHRAM + +! if(lprnt) write(0,*)' cnvflg=',cnvflg,' tem=',tem,' tem1=',tem1 +! &,' tx1=',tx1,' rhram=',rhram,' kbl=',kbl,' kd=',kd,' lowest=' +! &,lowest,' rhfacs=',rhfacs,' ltl=',ltl(kd1),' qol=',qol(kd1) +! &,' qst=',qst(kd1),' hst=',hst(kd1),' nu=',nu +! if(lprnt .and. (.not. cnvflg)) write(0,*)' tx1=',tx1,' rhfacs=' +! &,rhfacs, ' tem=',tem,' hst=',hst(kd1) + + IF (.NOT. cnvflg) RETURN +! + RHC = MAX(ZERO, MIN(ONE, EXP(-20.0*TX1) )) +! + wcbase = 0.1 + if (ntrc > 0) then + DO N=1,NTRC + RBL(N) = ROI(Kmax,N) * ETA(Kmax) + ENDDO + DO N=1,NTRC + DO L=KmaxM1,KBL,-1 + RBL(N) = RBL(N) + ROI(L,N)*(ETA(L)-ETA(L+1)) + ENDDO + ENDDO +! +! if (ntk > 0 .and. do_aw) then + if (ntk > 0) then + wcbase = min(2.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) +! wcbase = min(1.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) + endif + +! if (lprnt) write(0,*)' wcbase=',wcbase,' rbl=', +! & rbl(ntk),' ntk=',ntk + + endif +! + TX4 = zero + TX5 = zero +! + TX3 = QST(KBL) - GAF(KBL) * HST(KBL) + DO L=KBL,K + QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) + ENDDO +! + DO L=KB1,KD1,-1 + lp1 = l + 1 + TEM = QST(L) - GAF(L) * HST(L) + TEM1 = (TX3 + TEM) * half + ST2 = (GAF(L)+GAF(LP1)) * half +! + FCO(LP1) = TEM1 + ST2 * HBL + +! if(lprnt) write(0,*)' fco=',fco(l+1),' tem1=',tem1,' st2=',st2 +! &,' hbl=',hbl,' tx3=',tx3,' tem=',tem,' gaf=',gaf(l),' l=',l + + RNN(LP1) = ZET(LP1) * TEM1 + ST2 * TX4 + GMH(LP1) = XI(LP1) * TEM1 + ST2 * TX5 +! + TX3 = TEM + TX4 = TX4 + ETA(L) * HOL(L) + TX5 = TX5 + GMS(L) * HOL(L) +! + QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) + QLL(LP1) = (half*ALHF) * ST2 * (QIL(L)+QIL(LP1)) + ONE + ENDDO +! +! FOR THE CLOUD TOP -- L=KD +! + L = KD +! + lp1 = l + 1 + TEM = QST(L) - GAF(L) * HST(L) + TEM1 = (TX3 + TEM) * half + ST2 = (GAF(L)+GAF(LP1)) * half +! + FCO(LP1) = TEM1 + ST2 * HBL + RNN(LP1) = ZET(LP1) * TEM1 + ST2 * TX4 + GMH(LP1) = XI(LP1) * TEM1 + ST2 * TX5 +! + FCO(L) = TEM + GAF(L) * HBL + RNN(L) = TEM * ZET(L) + (TX4 + ETA(L)*HOL(L)) * GAF(L) + GMH(L) = TEM * XI(L) + (TX5 + GMS(L)*HOL(L)) * GAF(L) +! +! Replace FCO for the Bottom +! + FCO(KBL) = QBL + RNN(KBL) = zero + GMH(KBL) = zero +! + QIL(KD) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(KD))*TCRF)) + QLL(KD1) = (half*ALHF) * ST2 * (QIL(KD) + QIL(KD1)) + ONE + QLL(KD ) = ALHF * GAF(KD) * QIL(KD) + ONE +! +! if (lprnt) then +! write(0,*)' fco=',fco(kd:kbl) +! write(0,*)' qil=',qil(kd:kbl) +! write(0,*)' qll=',qll(kd:kbl) +! endif +! + st1 = qil(kd) + st2 = c0i * st1 * exp(c0ifac*min(tol(kd)-t0c,0.0)) + tem = c0 * (one-st1) + tem2 = st2*qi0 + tem*qw0 +! + DO L=KD,KB1 + lp1 = l + 1 + tx2 = akt(l) * eta(l) + tx1 = tx2 * tem2 + q0u(l) = tx1 + FCO(L) = FCO(LP1) - FCO(L) + tx1 + RNN(L) = RNN(LP1) - RNN(L) & + & + ETA(L)*(QOL(L)+CLL(L)+CIL(L)) + tx1*zet(l) + GMH(L) = GMH(LP1) - GMH(L) & + & + GMS(L)*(QOL(L)+CLL(L)+CIL(L)) + tx1*xi(l) +! + tem1 = (one-akt(l)) * eta(l) + +! if(lprnt) write(0,*)' qll=',qll(l),' st2=',st2,' tem=',tem +! &,' tx2=',tx2,' akt=',akt(l),' eta=',eta(l) + + AKT(L) = QLL(L) + (st2 + tem) * tx2 + +! if(lprnt) write(0,*)' akt==',akt(l),' l==',l + + AKC(L) = one / AKT(L) +! + st1 = half * (qil(l)+qil(lp1)) + st2 = c0i * st1 * exp(c0ifac*min(tol(lp1)-t0c,0.0)) + tem = c0 * (one-st1) + tem2 = st2*qi0 + tem*qw0 +! + BKC(L) = QLL(LP1) - (st2 + tem) * tem1 +! + tx1 = tem1*tem2 + q0d(l) = tx1 + FCO(L) = FCO(L) + tx1 + RNN(L) = RNN(L) + tx1*zet(lp1) + GMH(L) = GMH(L) + tx1*xi(lp1) + ENDDO + +! if(lprnt) write(0,*)' akt=',akt(kd:kb1) +! if(lprnt) write(0,*)' akc=',akc(kd:kb1) + + qw00 = qw0 + qi00 = qi0 + ii = 0 + 777 continue +! +! if (lprnt) write(0,*)' after 777 ii=',ii,' ep_wfn=',ep_wfn +! + ep_wfn = .false. + RNN(KBL) = zero + TX3 = bkc(kb1) * (QIB + QLB) + TX4 = zero + TX5 = zero + DO L=KB1,KD1,-1 + TEM = BKC(L-1) * AKC(L) +! if (lprnt) write(0,*)' tx3=',tx3,' fco=',fco(l),' akc=',akc(l) +! &,' bkc=',bkc(l-1), ' l=',l + TX3 = (TX3 + FCO(L)) * TEM + TX4 = (TX4 + RNN(L)) * TEM + TX5 = (TX5 + GMH(L)) * TEM + ENDDO + IF (KD < KB1) THEN + HSD = HST(KD1) + LTL(KD1) * NU *(QOL(KD1)-QST(KD1)) + ELSE + HSD = HBL + ENDIF +! +! if (lprnt) write(0,*)' tx3=',tx3,' fco=',fco(kd),' akc=',akc(kd) + + TX3 = (TX3 + FCO(KD)) * AKC(KD) + TX4 = (TX4 + RNN(KD)) * AKC(KD) + TX5 = (TX5 + GMH(KD)) * AKC(KD) + ALM = ALHF*QIL(KD) - LTL(KD) * VTF(KD) +! + HSU = HST(KD) + LTL(KD) * NU * (QOL(KD)-QST(KD)) + +! if (lprnt) write(0,*)' hsu=',hsu,' hst=',hst(kd), +! &' ltl=',ltl(kd),' qol=',qol(kd),' qst=',qst(kd) +! +!===> VERTICAL INTEGRALS NEEDED TO COMPUTE THE ENTRAINMENT PARAMETER +! + TX1 = ALM * TX4 + TX2 = ALM * TX5 + + DO L=KD,KB1 + TAU = HOL(L) - HSU + TX1 = TX1 + TAU * ETA(L) + TX2 = TX2 + TAU * GMS(L) + ENDDO +! +! MODIFY HSU TO INCLUDE CLOUD LIQUID WATER AND ICE TERMS +! +! if (lprnt) write(0,*)' hsu=',hsu,' alm=',alm,' tx3=',tx3 + + HSU = HSU - ALM * TX3 +! + CLP = ZERO + ALM = -100.0 + HOS = HOL(KD) + QOS = QOL(KD) + QIS = CIL(KD) + QLS = CLL(KD) + + cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4 + +! if (lprnt) write(0,*)' ii=',ii,' cnvflg=',cnvflg,' hsu=',hsu +! &,' hbl=',hbl,' tx1=',tx1,' hsd=',hsd + +!*********************************************************************** + + ST1 = HALF*(HSU + HSD) + + IF (cnvflg) THEN +! +! STANDARD CASE: +! CLOUD CAN BE NEUTRALLY BOUYANT AT MIDDLE OF LEVEL KD W/ +VE LAMBDA. +! EPP < .25 IS REQUIRED TO HAVE REAL ROOTS. +! + clp = one + st2 = hbl - hsu + +! if(lprnt) write(0,*)' tx2=',tx2,' tx1=',tx1,' st2=',st2 +! + if (tx2 == zero) then + alm = - st2 / tx1 + if (alm > almax) alm = -100.0 + else + x00 = tx2 + tx2 + epp = tx1 * tx1 - (x00+x00)*st2 + if (epp > zero) then + x00 = one / x00 + tem = sqrt(epp) + tem1 = (-tx1-tem)*x00 + tem2 = (-tx1+tem)*x00 + if (tem1 > almax) tem1 = -100.0 + if (tem2 > almax) tem2 = -100.0 + alm = max(tem1,tem2) + +! if (lprnt) write(0,*) ' tem1=',tem1,' tem2=',tem2,' alm=',alm +! &,' tx1=',tx1,' tem=',tem,' epp=',epp,' x00=',x00,' st2=',st2 + + endif + endif + +! if (lprnt) write(0,*)' almF=',alm,' ii=',ii,' qw00=',qw00 +! &,' qi00=',qi00 +! +! CLIP CASE: +! NON-ENTRAINIG CLOUD DETRAINS IN LOWER HALF OF TOP LAYER. +! NO CLOUDS ARE ALLOWED TO DETRAIN BELOW THE TOP LAYER. +! + ELSEIF (HBL <= HSU .AND. HBL > ST1) THEN + ALM = ZERO +! CLP = (HBL-ST1) / (HSU-ST1) ! commented on Jan 16, 2010 + ENDIF +! + cnvflg = .TRUE. + IF (ALMIN1 > zero) THEN + IF (ALM >= ALMIN1) cnvflg = .FALSE. + ELSE + LOWEST = KD == KB1 + IF ( (ALM > ZERO) .OR. & + & (.NOT. LOWEST .AND. ALM == ZERO) ) cnvflg = .FALSE. + ENDIF +! +!===> IF NO SOUNDING MEETS SECOND CONDITION, RETURN +! + IF (cnvflg) THEN + IF (ii > 0 .or. (qw00 == zero .and. qi00 == zero)) RETURN + CLP = one + ep_wfn = .true. + GO TO 888 + ENDIF +! +! if (lprnt) write(0,*)' hstkd=',hst(kd),' qstkd=',qst(kd) +! &,' ii=',ii,' clp=',clp + + st1s = ONE + IF(CLP > ZERO .AND. CLP < ONE) THEN + ST1 = HALF*(ONE+CLP) + ST2 = ONE - ST1 + st1s = st1 + hstkd = hst(kd) + qstkd = qst(kd) + ltlkd = ltl(kd) + q0ukd = q0u(kd) + q0dkd = q0d(kd) + dlbkd = dlb(kd) + qrbkd = qrb(kd) +! + HST(KD) = HST(KD)*ST1 + HST(KD1)*ST2 + HOS = HOL(KD)*ST1 + HOL(KD1)*ST2 + QST(KD) = QST(KD)*ST1 + QST(KD1)*ST2 + QOS = QOL(KD)*ST1 + QOL(KD1)*ST2 + QLS = CLL(KD)*ST1 + CLL(KD1)*ST2 + QIS = CIL(KD)*ST1 + CIL(KD1)*ST2 + LTL(KD) = LTL(KD)*ST1 + LTL(KD1)*ST2 +! + DLB(KD) = DLB(KD)*CLP + qrb(KD) = qrb(KD)*CLP + ETA(KD) = ETA(KD)*CLP + GMS(KD) = GMS(KD)*CLP + Q0U(KD) = Q0U(KD)*CLP + Q0D(KD) = Q0D(KD)*CLP + ENDIF +! +! +!*********************************************************************** +! +! Critical workfunction is included in this version +! + ACR = zero + TEM = PRL(KD1) - (PRL(KD1)-PRL(KD)) * CLP * HALF + tx1 = PRL(KBL) - TEM + tx2 = min(900.0, max(tx1,100.0)) + tem1 = log(tx2*0.01) * oneolog10 + tem2 = one - tem1 + if ( kdt == 1 ) then +! rel_fac = (dt * facdt) / (tem1*12.0 + tem2*3.0) + rel_fac = (dt * facdt) / (tem1*6.0 + tem2*adjts_s) + else + rel_fac = (dt * facdt) / (tem1*adjts_d + tem2*adjts_s) + endif +! +! rel_fac = max(zero, min(one,rel_fac)) + rel_fac = max(zero, min(half,rel_fac)) + + IF (CRTFUN) THEN + II = MAX(1, MIN(tem*0.02-0.999999999, 16)) + ACR = tx1 * (AC(II) + tem * AD(II)) * CCWF + ENDIF +! +!===> NORMALIZED MASSFLUX +! +! ETA IS THE THICKNESS COMING IN AND normalized MASS FLUX GOING OUT. +! GMS IS THE THICKNESS SQUARE ; IT IS LATER REUSED FOR GAMMA_S +! +! ETA(K) = ONE + + DO L=KB1,KD,-1 + ETA(L) = ETA(L+1) + ALM * (ETA(L) + ALM * GMS(L)) + ETAI(L) = one / ETA(L) + ENDDO + ETAI(KBL) = one + +! if (lprnt) write(0,*)' eta=',eta,' ii=',ii,' alm=',alm +! +!===> CLOUD WORKFUNCTION +! + WFN = ZERO + AKM = ZERO + DET = ZERO + HCC = HBL + cnvflg = .FALSE. + QTL = QST(KB1) - GAF(KB1)*HST(KB1) + TX1 = HBL +! + qtv = qbl + det = qlb + qib +! + tx2 = zero + dpneg = zero +! + DO L=KB1,KD1,-1 + lm1 = l - 1 + lp1 = l + 1 + DEL_ETA = ETA(L) - ETA(LP1) + HCCP = HCC + DEL_ETA*HOL(L) +! + QTLP = QST(LM1) - GAF(LM1)*HST(LM1) + QTVP = half * ((QTLP+QTL)*ETA(L) & + & + (GAF(L)+GAF(LM1))*HCCP) + ST1 = ETA(L)*Q0U(L) + ETA(LP1)*Q0D(L) + DETP = (BKC(L)*DET - (QTVP-QTV) & + & + DEL_ETA*(QOL(L)+CLL(L)+CIL(L)) + ST1) * AKC(L) + +! if(lprnt) write(0,*)' detp=',detp,' bkc=',bkc(l),' det=',det +! if (lprnt .and. kd == 15) +! & write(0,*)' detp=',detp,' bkc=',bkc(l),' det=',det +! &,' qtvp=',qtvp,' qtv=',qtv,' del_eta=',del_eta,' qol=' +! &,qol(l),' st1=',st1,' akc=',akc(l) +! + TEM1 = AKT(L) - QLL(L) + TEM2 = QLL(LP1) - BKC(L) + RNS(L) = TEM1*DETP + TEM2*DET - ST1 + + qtp = half * (qil(L)+qil(LM1)) + tem2 = min(qtp*(detp-eta(l)*qw00), & + & (one-qtp)*(detp-eta(l)*qi00)) + st1 = min(tx2,tem2) + tx2 = tem2 +! + IF (rns(l) < zero .or. st1 < zero) ep_wfn = .TRUE. + IF (DETP <= ZERO) cnvflg = .TRUE. + + ST1 = HST(L) - LTL(L)*NU*(QST(L)-QOL(L)) + + + TEM2 = HCCP + DETP * QTP * ALHF +! +! if(lprnt) write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu +! if (lprnt .and. kd == 15) +! & write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu +! &,' qst=',qst(l),' qol=',qol(l),' hccp=',hccp,' detp=',detp +! *,' qtp=',qtp,' alhf=',alhf,' vtf=',vtf(l) + + ST2 = LTL(L) * VTF(L) + TEM5 = CLL(L) + CIL(L) + TEM3 = (TX1 - ETA(LP1)*ST1 - ST2*(DET-TEM5*eta(lp1))) * DLB(L) + TEM4 = (TEM2 - ETA(L )*ST1 - ST2*(DETP-TEM5*eta(l))) * DLT(L) +! +! if (lprnt) then +! if (lprnt .and. kd == 12) then +! write(0,*)' tem3=',tem3,' tx1=',tx1,' st1=',st1,' eta1=',eta(l+1) +! &, ' st2=',st2,' det=',det,' tem5=',tem5,' dlb=',dlb(l) +! write(0,*)' tem4=',tem4,' tem2=',tem2,' detp=',detp +! &, ' eta=',eta(l),' dlt=',dlt(l),' rns=',rns(l),' l=',l +! write(0,*)' bt1=',tem3/(eta(l+1)*qrb(l)) +! &, ' bt2=',tem4/(eta(l)*qrt(l)) +! endif + + ST1 = TEM3 + TEM4 + +! if (lprnt) write(0,*)' wfn=',wfn,' st1=',st1,' l=',l,' ep_wfn=', +! &ep_wfn,' akm=',akm + + WFN = WFN + ST1 + AKM = AKM - min(ST1,ZERO) + +! if (lprnt) write(0,*)' wfn=',wfn,' akm=',akm + + if (st1 < zero .and. wfn < zero) then + dpneg = dpneg + prl(lp1) - prl(l) + endif + + BUY(L) = half * (tem3/(eta(lp1)*qrb(l)) + tem4/(eta(l)*qrt(l))) +! + HCC = HCCP + DET = DETP + QTL = QTLP + QTV = QTVP + TX1 = TEM2 + + ENDDO + + DEL_ETA = ETA(KD) - ETA(KD1) + HCCP = HCC + DEL_ETA*HOS +! + QTLP = QST(KD) - GAF(KD)*HST(KD) + QTVP = QTLP*ETA(KD) + GAF(KD)*HCCP + ST1 = ETA(KD)*Q0U(KD) + ETA(KD1)*Q0D(KD) + DETP = (BKC(KD)*DET - (QTVP-QTV) & + & + DEL_ETA*(QOS+QLS+QIS) + ST1) * AKC(KD) +! + TEM1 = AKT(KD) - QLL(KD) + TEM2 = QLL(KD1) - BKC(KD) + RNS(KD) = TEM1*DETP + TEM2*DET - ST1 +! + IF (rns(kd) < zero) ep_wfn = .TRUE. + IF (DETP <= ZERO) cnvflg = .TRUE. +! + 888 continue + +! if (lprnt) write(0,*)' ep_wfn=',ep_wfn,' ii=',ii,' rns=',rns(kd) +! &,' clp=',clp,' hst(kd)=',hst(kd) + + if (ep_wfn) then + IF ((qw00 == zero .and. qi00 == zero)) RETURN + if (ii == 0) then + ii = 1 + if (clp > zero .and. clp < one) then + hst(kd) = hstkd + qst(kd) = qstkd + ltl(kd) = ltlkd + q0u(kd) = q0ukd + q0d(kd) = q0dkd + dlb(kd) = dlbkd + qrb(kd) = qrbkd + endif + do l=kd,kb1 + lp1 = l + 1 + FCO(L) = FCO(L) - q0u(l) - q0d(l) + RNN(L) = RNN(L) - q0u(l)*zet(l) - q0d(l)*zet(lp1) + GMH(L) = GMH(L) - q0u(l)*xi(l) - q0d(l)*zet(lp1) + ETA(L) = ZET(L) - ZET(LP1) + GMS(L) = XI(L) - XI(LP1) + Q0U(L) = zero + Q0D(L) = zero + ENDDO + qw00 = zero + qi00 = zero + +! if (lprnt) write(0,*)' returning to 777 : ii=',ii,' qw00=',qw00,qi00 +! &,' clp=',clp,' hst(kd)=',hst(kd) + + go to 777 + else + cnvflg = .true. + endif + endif +! +! +! ST1 = 0.5 * (HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) +! & + HST(KD1) - LTL(KD1)*NU*(QST(KD1)-QOL(KD1))) +! + ST1 = HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) + ST2 = LTL(KD) * VTF(KD) + TEM5 = (QLS + QIS) * eta(kd1) + ST1 = HALF * (TX1-ETA(KD1)*ST1-ST2*(DET-TEM5))*DLB(KD) +! +! if (lprnt) write(0,*)' st1=',st1,' st2=',st2,' ltl=',ltl(kd) +! *,ltl(kd1),' qos=',qos,qol(kd1) + + WFN = WFN + ST1 + AKM = AKM - min(ST1,ZERO) ! Commented on 08/26/02 - does not include top +! + + BUY(KD) = ST1 / (ETA(KD1)*qrb(kd)) +! +! if (lprnt) write(0,*)' wfn=',wfn,' akm=',akm,' st1=',st1 +! &,' dpneg=',dpneg + + DET = DETP + HCC = HCCP + AKM = AKM / WFN + + +!*********************************************************************** +! + IF (WRKFUN) THEN ! If only to calculate workfunction save it and return + IF (WFN >= zero) WFNC = WFN + RETURN + ELSEIF (.NOT. CRTFUN) THEN + ACR = WFNC + ENDIF +! +!===> THIRD CHECK BASED ON CLOUD WORKFUNCTION +! + CALCUP = .FALSE. + + TEM = max(0.05, MIN(CD*200.0, MAX_NEG_BOUY)) + IF (.not. cnvflg .and. WFN > ACR .and. & + & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. + +! if (lprnt) write(0,*)' calcup=',calcup,' akm=',akm,' tem=',tem +! *,' cnvflg=',cnvflg,' clp=',clp,' rhc=',rhc,' cd=',cd,' acr=',acr +! +!===> IF NO SOUNDING MEETS THIRD CONDITION, RETURN +! + IF (.NOT. CALCUP) RETURN +! +! This is for not LL - 20050601 +! IF (ALMIN2 .NE. zero) THEN +! IF (ALMIN1 .NE. ALMIN2) ST1 = one / max(ONE_M10,(ALMIN2-ALMIN1)) +! IF (ALM < ALMIN2) THEN +! CLP = CLP * max(zero, min(one,(0.3 + 0.7*(ALM-ALMIN1)*ST1))) +!! CLP = CLP * max(0.0, min(1.0,(0.2 + 0.8*(ALM-ALMIN1)*ST1))) +!! CLP = CLP * max(0.0, min(1.0,(0.1 + 0.9*(ALM-ALMIN1)*ST1))) +! ENDIF +! ENDIF +! +! if (lprnt) write(0,*)' clp=',clp +! + CLP = CLP * RHC + dlq = zero + tem = one / (one + dlq_fac) + do l=kd,kb1 + rnn(l) = rns(l) * tem + dlq(l) = rns(l) * tem * dlq_fac + enddo + DO L=KBL,K + RNN(L) = zero + ENDDO +! if (lprnt) write(0,*)' rnn=',rnn +! +! If downdraft is to be invoked, do preliminary check to see +! if enough rain is available and then call DDRFT. +! + DDFT = .FALSE. + IF (dpd > zero) THEN + TRAIN = zero + IF (CLP > zero) THEN + DO L=KD,KB1 + TRAIN = TRAIN + RNN(L) + ENDDO + ENDIF + + PL = (PRL(KD1) + PRL(KD))*HALF + IF (TRAIN > 1.0E-4 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. + ENDIF +! +! if (lprnt) then +! write(0,*)' BEFORE CALLING DDRFT KD=',kd,' DDFT=',DDFT +! &, ' PL=',PL,' TRAIN=',TRAIN +! write(0,*)' buy=',(buy(l),l=kd,kb1) +! endif + + IF (DDFT) THEN ! Downdraft scheme based on (Cheng and Arakawa, 1997) + CALL DDRFT( & + & K, KP1, KD & + &, TLA, ALFIND, wcbase & + &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF & +! &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF, HBL, QBL & + &, QRB, QRT, BUY, KBL, IDH, ETA, RNN, ETAI & + &, ALM, WFN, TRAIN, DDFT & + &, ETD, HOD, QOD, EVP, DOF, CLDFR, ETZ & + &, GMS, GSD, GHD, wvl, lprnt) + + ENDIF +! +! No Downdraft case (including case with no downdraft solution) +! --------------------------------------------------------- +! + IF (.NOT. DDFT) THEN + DO L=KD,KP1 + ETD(L) = zero + HOD(L) = zero + QOD(L) = zero + wvl(l) = zero + ENDDO + DO L=KD,K + EVP(L) = zero + ETZ(L) = zero + ENDDO + + ENDIF + +! if (lprnt) write(0,*) ' hod=',hod +! if (lprnt) write(0,*) ' etd=',etd +! if (lprnt) write(0,*) ' aft dd wvl=',wvl +! +! +!===> CALCULATE GAMMAS i.e. TENDENCIES PER UNIT CLOUD BASE MASSFLUX +! Includes downdraft terms! + + avh = zero + +! +! Fraction of detrained condensate evaporated +! +! tem1 = max(ZERO, min(HALF, (prl(kd)-FOUR_P2)*ONE_M2)) +! tem1 = max(ZERO, min(HALF, (prl(kd)-300.0)*0.005)) + tem1 = zero +! tem1 = 1.0 +! if (kd1 == kbl) tem1 = 0.0 +! + tem2 = one - tem1 + TEM = DET * QIL(KD) + + + st1 = (HCC+ALHF*TEM-ETA(KD)*HST(KD)) / (one+gam(KD)) + DS = ETA(KD1) * (HOS- HOL(KD)) - ALHL*(QOS - QOL(KD)) + DH = ETA(KD1) * (HOS- HOL(KD)) + + + GMS(KD) = (DS + st1 - tem1*det*alhl-tem*alhf) * PRI(KD) + GMH(KD) = PRI(KD) * (HCC-ETA(KD)*HOS + DH) + + +! if (lprnt) write(0,*)' gmhkd=',gmh(kd),' gmskd=',gms(kd) +! &,' det=',det,' tem=',tem,' tem1=',tem1,' tem2=',tem2 +! +! TENDENCY FOR SUSPENDED ENVIRONMENTAL ICE AND/OR LIQUID WATER +! + QLL(KD) = (tem2*(DET-TEM) + ETA(KD1)*(QLS-CLL(KD)) & + & + (one-QIL(KD))*dlq(kd) - ETA(KD)*QLS ) * PRI(KD) + + QIL(KD) = (tem2*TEM + ETA(KD1)*(QIS-CIL(KD)) & + & + QIL(KD)*dlq(kd) - ETA(KD)*QIS ) * PRI(KD) +! + GHD(KD) = zero + GSD(KD) = zero +! + DO L=KD1,K + lm1 = l - 1 + ST1 = ONE - ALFINT(L,1) + ST2 = ONE - ALFINT(L,2) + ST3 = ONE - ALFINT(L,3) + ST4 = ONE - ALFINT(L,4) + ST5 = ONE - ALFIND(L) + HB = ALFINT(L,1)*HOL(LM1) + ST1*HOL(L) + QB = ALFINT(L,2)*QOL(LM1) + ST2*QOL(L) + + TEM = ALFINT(L,4)*CIL(LM1) + ST4*CIL(L) + TEM2 = ALFINT(L,3)*CLL(LM1) + ST3*CLL(L) + + TEM1 = ETA(L) * (TEM - CIL(L)) + TEM3 = ETA(L) * (TEM2 - CLL(L)) + + HBD = ALFIND(L)*HOL(LM1) + ST5*HOL(L) + QBD = ALFIND(L)*QOL(LM1) + ST5*QOL(L) + + TEM5 = ETD(L) * (HOD(L) - HBD) + TEM6 = ETD(L) * (QOD(L) - QBD) +! + DH = ETA(L) * (HB - HOL(L)) + TEM5 + DS = DH - ALHL * (ETA(L) * (QB - QOL(L)) + TEM6) + + GMH(L) = DH * PRI(L) + GMS(L) = DS * PRI(L) + +! if (lprnt) write(0,*)' gmh=',gmh(l),' gms=',gms(l) +! &,' dh=',dh,' ds=',ds,' qb=',qb,' qol=',qol(l),' eta=',eta(l) +! &,' hb=',hb,' hol=',hol(l),' l=',l,' hod=',hod(l) +! &,' etd=',etd(l),' qod=',qod(l),' tem5=',tem5,' tem6=',tem6 +! + GHD(L) = TEM5 * PRI(L) + GSD(L) = (TEM5 - ALHL * TEM6) * PRI(L) +! + QLL(L) = (TEM3 + (one-QIL(L))*dlq(l)) * PRI(L) + QIL(L) = (TEM1 + QIL(L)*dlq(l)) * PRI(L) + + TEM1 = ETA(L) * (CIL(LM1) - TEM) + TEM3 = ETA(L) * (CLL(LM1) - TEM2) + + DH = ETA(L) * (HOL(LM1) - HB) - TEM5 + DS = DH - ALHL * ETA(L) * (QOL(LM1) - QB) & + & + ALHL * (TEM6 - EVP(LM1)) + + GMH(LM1) = GMH(LM1) + DH * PRI(LM1) + GMS(LM1) = GMS(LM1) + DS * PRI(LM1) +! +! if (lprnt) write(0,*)' gmh1=',gmh(l-1),' gms1=',gms(l-1) +! &,' dh=',dh,' ds=',ds,' qb=',qb,' qol=',qol(l-1) +! &,' hb=',hb,' hol=',hol(l-1),' evp=',evp(l-1) +! + GHD(LM1) = GHD(LM1) - TEM5 * PRI(LM1) + GSD(LM1) = GSD(LM1) - (TEM5-ALHL*(TEM6-EVP(LM1))) * PRI(LM1) + + QIL(LM1) = QIL(LM1) + TEM1 * PRI(LM1) + QLL(LM1) = QLL(LM1) + TEM3 * PRI(LM1) + + +! if (lprnt) write(0,*)' gmh=',gmh(l),' gms=',gms(l) +! &,' dh=',dh,' ds=',ds,' qb=',qb,' qol=',qol(l),' eta=',eta(l) +! &,' hb=',hb,' hol=',hol(l),' l=',l +! + avh = avh + gmh(lm1)*(prs(l)-prs(lm1)) + + ENDDO +! + HBD = HOL(K) + QBD = QOL(K) + TEM5 = ETD(KP1) * (HOD(KP1) - HBD) + TEM6 = ETD(KP1) * (QOD(KP1) - QBD) + DH = - TEM5 + DS = DH + ALHL * TEM6 + TEM1 = DH * PRI(K) + TEM2 = (DS - ALHL * EVP(K)) * PRI(K) + GMH(K) = GMH(K) + TEM1 + GMS(K) = GMS(K) + TEM2 + GHD(K) = GHD(K) + TEM1 + GSD(K) = GSD(K) + TEM2 + +! if (lprnt) write(0,*)' gmhk=',gmh(k),' gmsk=',gms(k) +! &,' tem1=',tem1,' tem2=',tem2,' dh=',dh,' ds=',ds +! + avh = avh + gmh(K)*(prs(KP1)-prs(K)) +! + tem4 = - GRAVFAC * pris + TX1 = DH * tem4 + TX2 = DS * tem4 +! + DO L=KBL,K + GMH(L) = GMH(L) + TX1 + GMS(L) = GMS(L) + TX2 + GHD(L) = GHD(L) + TX1 + GSD(L) = GSD(L) + TX2 +! + avh = avh + tx1*(prs(l+1)-prs(l)) + ENDDO + +! +! if (lprnt) then +! write(0,*)' gmh=',gmh +! write(0,*)' gms=',gms(KD:K) +! endif +! +!*********************************************************************** +!*********************************************************************** + +!===> KERNEL (AKM) CALCULATION BEGINS + +!===> MODIFY SOUNDING WITH UNIT MASS FLUX +! + DO L=KD,K + + TEM1 = GMH(L) + TEM2 = GMS(L) + HOL(L) = HOL(L) + TEM1*TESTMB + QOL(L) = QOL(L) + (TEM1-TEM2) * TESTMBOALHL + HST(L) = HST(L) + TEM2*(ONE+GAM(L))*TESTMB + QST(L) = QST(L) + TEM2*GAM(L) * TESTMBOALHL + CLL(L) = CLL(L) + QLL(L) * TESTMB + CIL(L) = CIL(L) + QIL(L) * TESTMB + ENDDO +! + if (alm > zero) then + HOS = HOS + GMH(KD) * TESTMB + QOS = QOS + (GMH(KD)-GMS(KD)) * TESTMBOALHL + QLS = QLS + QLL(KD) * TESTMB + QIS = QIS + QIL(KD) * TESTMB + else + st2 = one - st1s + HOS = HOS + (st1s*GMH(KD)+st2*GMH(KD1)) * TESTMB + QOS = QOS + (st1s * (GMH(KD)-GMS(KD)) & + & + st2 * (GMH(KD1)-GMS(KD1))) * TESTMBOALHL + HST(kd) = HST(kd) + (st1s*GMS(kd)*(ONE+GAM(kd)) & + & + st2*gms(kd1)*(ONE+GAM(kd1))) * TESTMB + QST(kd) = QST(kd) + (st1s*GMS(kd)*GAM(kd) & + & + st2*gms(kd1)*gam(kd1)) * TESTMBOALHL + + QLS = QLS + (st1s*QLL(KD)+st2*QLL(KD1)) * TESTMB + QIS = QIS + (st1s*QIL(KD)+st2*QIL(KD1)) * TESTMB + endif + +! + TEM = PRL(Kmaxp1) - PRL(Kmax) + HBL = HOL(Kmax) * TEM + QBL = QOL(Kmax) * TEM + QLB = CLL(Kmax) * TEM + QIB = CIL(Kmax) * TEM + DO L=KmaxM1,KBL,-1 + TEM = PRL(L+1) - PRL(L) + HBL = HBL + HOL(L) * TEM + QBL = QBL + QOL(L) * TEM + QLB = QLB + CLL(L) * TEM + QIB = QIB + CIL(L) * TEM + ENDDO + HBL = HBL * PRISM + QBL = QBL * PRISM + QLB = QLB * PRISM + QIB = QIB * PRISM + +! if (ctei .and. sgcs(kd) > 0.65) then +! hbl = hbl * hpert_fac +! qbl = qbl * hpert_fac +! endif + +! if (lprnt) write(0,*)' hbla=',hbl,' qbla=',qbl + +!*********************************************************************** + +!===> CLOUD WORKFUNCTION FOR MODIFIED SOUNDING, THEN KERNEL (AKM) +! + AKM = ZERO + TX1 = ZERO + QTL = QST(KB1) - GAF(KB1)*HST(KB1) + QTV = QBL + HCC = HBL + TX2 = HCC + TX4 = (ALHF*half)*MAX(ZERO,MIN(ONE,(TCR-TCL-TOL(KB1))*TCRF)) +! + qtv = qbl + tx1 = qib + qlb +! + + DO L=KB1,KD1,-1 + lm1 = l - 1 + lp1 = l + 1 + DEL_ETA = ETA(L) - ETA(LP1) + HCCP = HCC + DEL_ETA*HOL(L) +! + QTLP = QST(LM1) - GAF(LM1)*HST(LM1) + QTVP = half * ((QTLP+QTL)*ETA(L) + (GAF(L)+GAF(LM1))*HCCP) + + DETP = (BKC(L)*TX1 - (QTVP-QTV) & + & + DEL_ETA*(QOL(L)+CLL(L)+CIL(L)) & + & + ETA(L)*Q0U(L) + ETA(LP1)*Q0D(L)) * AKC(L) + IF (DETP <= ZERO) cnvflg = .TRUE. + + ST1 = HST(L) - LTL(L)*NU*(QST(L)-QOL(L)) + + TEM2 = (ALHF*half)*MAX(ZERO,MIN(ONE,(TCR-TCL-TOL(LM1))*TCRF)) + TEM1 = HCCP + DETP * (TEM2+TX4) + + ST2 = LTL(L) * VTF(L) + TEM5 = CLL(L) + CIL(L) + AKM = AKM + & + & ( (TX2 -ETA(LP1)*ST1-ST2*(TX1-TEM5*eta(lp1))) * DLB(L) & + & + (TEM1 -ETA(L )*ST1-ST2*(DETP-TEM5*eta(l))) * DLT(L) ) +! + HCC = HCCP + TX1 = DETP + TX2 = TEM1 + QTL = QTLP + QTV = QTVP + TX4 = TEM2 + ENDDO +! + if (cnvflg) return +! +! Eventhough we ignore the change in lambda, we still assume +! that the cLoud-top contribution is zero; as though we still +! had non-bouyancy there. +! +! + ST1 = HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) + ST2 = LTL(KD) * VTF(KD) + TEM5 = (QLS + QIS) * eta(kd1) + AKM = AKM + HALF * (TX2-ETA(KD1)*ST1-ST2*(TX1-TEM5)) * DLB(KD) +! + AKM = (AKM - WFN) * TESTMBI + + +!*********************************************************************** + +!===> MASS FLUX +! + AMB = - (WFN-ACR) / AKM +! +! if(lprnt) write(0,*)' wfn=',wfn,' acr=',acr,' akm=',akm & +! &,' amb=',amb,' KD=',kd,' cldfrd=',cldfrd & +! &,' rel_fac=',rel_fac,' prskd=',prs(kd) + +!===> RELAXATION AND CLIPPING FACTORS +! + AMB = AMB * CLP * rel_fac + +!!! if (DDFT) AMB = MIN(AMB, ONE/CLDFRD) + +!===> SUB-CLOUD LAYER DEPTH LIMIT ON MASS FLUX + + AMBMAX = (PRL(KMAXP1)-PRL(KBL))*(FRACBL*GRAVCON) + AMB = MAX(MIN(AMB, AMBMAX),ZERO) + + +! if(lprnt) write(0,*)' AMB=',amb,' clp=',clp,' ambmax=',ambmax +!*********************************************************************** +!*************************RESULTS*************************************** +!*********************************************************************** + +!===> PRECIPITATION AND CLW DETRAINMENT +! + if (amb > zero) then + +! +! if (wvl(kd) > zero) then +! tx1 = one - amb * eta(kd) / (rho(kd)*wvl(kd)) +! sigf(kd) = max(zero, min(one, tx1 * tx1)) +! endif + if (do_aw) then + tx1 = (0.2 / max(alm, 1.0e-5)) + tx2 = one - min(one, pi * tx1 * tx1 / garea) +! if(lprnt) write(0,*)' kd=',kd,' alm=',alm,' tx1=',tx1 +! &,' garea=',garea,' pi=',pi,' tx2=',tx2 + tx2 = tx2 * tx2 +! if(lprnt) write(0,*)' kd=',kd,' wvl=',wvl(kd:k+1) +! if(lprnt) write(0,*)' kd=',kd,' eta=',eta(kd:k+1) +! if(lprnt) write(0,*)' kd=',kd,' rho=',rho(kd:k) +! comnet out the following for now - 07/23/18 +! do l=kd1,kbl +! lp1 = min(K, l+1) +! if (wvl(l) > zero .and. wvl(lp1) > zero) then +! tx1 = one - amb * (eta(l)+eta(lp1)) +! & / ((wvl(l)+wvl(lp1))*rho(l)*grav) +! sigf(l) = max(zero, min(one, tx1 * tx1)) +! else +! sigf(l) = min(one,tx2) +! endif +! sigf(l) = max(sigf(l), tx2) +! enddo +! sigf(kd) = sigf(kd1) +! if (kbl < k) then +! sigf(kbl+1:k) = sigf(kbl) +! endif + sigf(kd:k) = tx2 + else + sigf(kd:k) = one + endif +! if(lprnt) write(0,*)' for kd=',kd,'sigf=',sigf(kd:k) +! + avt = zero + avq = zero + avr = dof * sigf(kbl) +! + DSFC = DSFC + AMB * ETD(K) * (one/DT) * sigf(kbl) +! +! DO L=KBL,KD,-1 + DO L=K,KD,-1 + PCU(L) = PCU(L) + AMB*RNN(L)*sigf(l) ! (A40) + avr = avr + rnn(l) * sigf(l) +! if(lprnt) write(0,*)' avr=',avr,' rnn=',rnn(l),' l=',l + ENDDO + pcu(k) = pcu(k) + amb * dof * sigf(kbl) +! +!===> TEMPARATURE AND Q CHANGE AND CLOUD MASS FLUX DUE TO CLOUD TYPE KD +! + TX1 = AMB * ONEBCP + TX2 = AMB * ONEOALHL + DO L=KD,K + delp = prs(l+1) - prs(l) + tx3 = amb * sigf(l) + ST1 = GMS(L) * TX1 * sigf(l) + TOI(L) = TOI(L) + ST1 + TCU(L) = TCU(L) + ST1 + TCD(L) = TCD(L) + GSD(L) * TX1 * sigf(l) +! + st1 = st1 - ELOCP * (QIL(L) + QLL(L)) * tx3 + + avt = avt + st1 * delp + + FLX(L) = FLX(L) + ETA(L) * tx3 + FLXD(L) = FLXD(L) + ETD(L) * tx3 +! + QII(L) = QII(L) + QIL(L) * tx3 + TEM = zero + + QLI(L) = QLI(L) + QLL(L) * tx3 + TEM + + ST1 = (GMH(L)-GMS(L)) * TX2 * sigf(l) + + QOI(L) = QOI(L) + ST1 + QCU(L) = QCU(L) + ST1 + QCD(L) = QCD(L) + (GHD(L)-GSD(L)) * TX2 * sigf(l) +! + avq = avq + (st1 + (QLL(L)+QIL(L))*tx3) * delp +! avq = avq + st1 * (prs(l+1)-prs(l)) +! avr = avr + (QLL(L) + QIL(L)*(1+alhf/alhl)) + avr = avr + (QLL(L) + QIL(L)) * delp * sigf(l) * gravcon + +! if(lprnt) write(0,*)' avr=',avr,' qll=',qll(l),' l=',l +! &, ' qil=',qil(l) + +! Correction for negative condensate! + if (qii(l) < zero) then + tem = qii(l) * elfocp + QOI(L) = QOI(L) + qii(l) + qcu(l) = qcu(l) + qii(l) + toi(l) = toi(l) - tem + tcu(l) = tcu(l) - tem + qii(l) = zero + endif + if (qli(l) < zero) then + tem = qli(l) * elocp + QOI(L) = QOI(L) + qli(l) + qcu(l) = qcu(l) + qli(l) + toi(l) = toi(l) - tem + tcu(l) = tcu(l) - tem + qli(l) = zero + endif + + ENDDO + avr = avr * amb +! +! Correction for negative condensate! +! if (advcld) then +! do l=kd,k +! if (qli(l) < zero) then +! qoi(l) = qoi(l) + qli(l) +! toi(l) = toi(l) - (alhl/cp) * qli(l) +! qli(l) = zero +! endif +! if (qii(l) < zero) then +! qoi(l) = qoi(l) + qii(l) +! toi(l) = toi(l) - ((alhl+alhf)/cp) * qii(l) +! qii(l) = zero +! endif +! enddo +! endif + +! +! +! if (lprnt) then +! write(0,*)' For KD=',KD +! avt = avt * cp * 100.0*86400.0 / (alhl*DT*grav) +! avq = avq * 100.0*86400.0 / (DT*grav) +! avr = avr * 86400.0 / DT +! write(0,*) ' avt=',avt,' avq=',avq,' avr=',avr,' avh=' +! * ,avh,' alm=',alm,' DDFT=',DDFT,' KD=',KD +! &,' TOIK-',toi(k),' TOIK-1=',toi(k-1),' TOIK-2=',toi(k-2) +! if (kd == 12 .and. .not. ddft) stop +! if (avh > 0.1 .or. abs(avt+avq) > 1.0e-5 .or. +! & abs(avt-avr) > 1.0e-5 .or. abs(avr+avq) > 1.0e-5) stop +! +! if (lprnt) then +! write(0,*) ' in CLOUD For KD=',KD +! write(0,*) ' TCU=',(tcu(l),l=kd,k) +! write(0,*) ' QCU=',(Qcu(l),l=kd,k) +! endif +! + TX1 = zero + TX2 = zero +! + IF (REVAP) THEN ! REEVAPORATION OF FALLING CONVECTIVE RAIN +! + tem = zero + do l=kd,kbl + IF (L < IDH .or. (.not. DDFT)) THEN + tem = tem + amb * rnn(l) * sigf(l) + endif + enddo + tem = tem + amb * dof * sigf(kbl) + tem = tem * (3600.0/dt) +!!!! tem1 = max(1.0, min(100.0,sqrt((5.0E10/max(garea,one))))) +! tem1 = max(1.0, min(100.0,(7.5E10/max(garea,one)))) +! tem1 = max(1.0, min(100.0,(5.0E10/max(garea,one)))) +! tem1 = max(1.0, min(100.0,(4.0E10/max(garea,one)))) +!! tem1 = sqrt(max(1.0, min(100.0,(4.0E10/max(garea,one))))) ! 20100902 + tem1 = sqrt(max(one, min(100.0,(6.25E10/max(garea,one))))) ! 20110530 + +! if (lprnt) write(0,*)' clfr0=',clf(tem),' tem=',tem,' tem1=',tem1 + +! clfrac = max(ZERO, min(ONE, rknob*clf(tem)*tem1)) +! clfrac = max(ZERO, min(0.25, rknob*clf(tem)*tem1)) + clfrac = max(ZERO, min(half, rknob*clf(tem)*tem1)) + +! if (lprnt) then +! write(0,*) ' cldfrd=',cldfrd,' amb=',amb,' clfrac=',clfrac +! write(0,*) ' tx3=',tx3,' etakd=',eta(kd),' pri=',pri(kd) +! write(0,*) ' RNN=',RNN(kd:k) +! endif +! +!cnt DO L=KD,K + DO L=KD,KBL ! Testing on 20070926 +! for L=KD,K + IF (L >= IDH .AND. DDFT) THEN + tem = amb * sigf(l) + TX2 = TX2 + tem * RNN(L) + CLDFRD = MIN(tem*CLDFR(L), clfrac) + ELSE + TX1 = TX1 + AMB * RNN(L) * sigf(l) + ENDIF + tx4 = zfac * phil(l) + tx4 = (one - tx4 * (one - half*tx4)) * afc +! + IF (TX1 > zero .OR. TX2 > zero) THEN + TEQ = TOI(L) + QEQ = QOI(L) + PL = half * (PRL(L+1)+PRL(L)) + + ST1 = MAX(ZERO, MIN(ONE, (TCR-TEQ)*TCRF)) + ST2 = ST1*ELFOCP + (one-ST1)*ELOCP + + CALL QSATCN ( TEQ,PL,QSTEQ,DQDT) +! CALL QSATCN ( TEQ,PL,QSTEQ,DQDT,.false.) +! + DELTAQ = half * (QSTEQ*rhc_ls(l)-QEQ) / (one+ST2*DQDT) +! + QEQ = QEQ + DELTAQ + TEQ = TEQ - DELTAQ*ST2 +! + TEM1 = MAX(ZERO, MIN(ONE, (TCR-TEQ)*TCRF)) + TEM2 = TEM1*ELFOCP + (one-TEM1)*ELOCP + + CALL QSATCN ( TEQ,PL,QSTEQ,DQDT) +! CALL QSATCN ( TEQ,PL,QSTEQ,DQDT,.false.) +! + DELTAQ = (QSTEQ*rhc_ls(l)-QEQ) / (one+TEM2*DQDT) +! + QEQ = QEQ + DELTAQ + TEQ = TEQ - DELTAQ*TEM2 + + IF (QEQ > QOI(L)) THEN + POTEVAP = (QEQ-QOI(L))*(PRL(L+1)-PRL(L))*GRAVCON + + tem4 = zero + if (tx1 > zero) & + & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778 ) ) +! & TEM4 = POTEVAP * (1. - EXP( AFC*tx4*SQRT(TX1) ) ) + ACTEVAP = MIN(TX1, TEM4*CLFRAC) + +! if(lprnt) write(0,*)' L=',L,' actevap=',actevap,' tem4=',tem4, +! &' clfrac=' +! &,clfrac,' potevap=',potevap,'efac=',AFC*SQRT(TX1*TEM3) +! &,' tx1=',tx1 + + if (tx1 < rainmin*dt) actevap = min(tx1, potevap) +! + tem4 = zero + if (tx2 > zero) & + & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778 ) ) +! & TEM4 = POTEVAP * (1. - EXP( AFC*tx4*SQRT(TX2) ) ) + TEM4 = min(MIN(TX2, TEM4*CLDFRD), potevap-actevap) + if (tx2 < rainmin*dt) tem4 = min(tx2, potevap-actevap) +! + TX1 = TX1 - ACTEVAP + TX2 = TX2 - TEM4 + ST1 = (ACTEVAP+TEM4) * PRI(L) + QOI(L) = QOI(L) + ST1 + QCU(L) = QCU(L) + ST1 +! + + ST1 = ST1 * ELOCP + TOI(L) = TOI(L) - ST1 + TCU(L) = TCU(L) - ST1 + ENDIF + ENDIF + ENDDO +! + CUP = CUP + TX1 + TX2 + DOF * AMB * sigf(kbl) + ELSE + DO L=KD,K + TX1 = TX1 + AMB * RNN(L) * sigf(l) + ENDDO + CUP = CUP + TX1 + DOF * AMB * sigf(kbl) + ENDIF + +! if (lprnt) write(0,*)' tx1=',tx1,' tx2=',tx2,' dof=',dof +! &,' cup=',cup*86400/dt,' amb=',amb +! &,' amb=',amb,' cup=',cup,' clfrac=',clfrac,' cldfrd=',cldfrd +! &,' ddft=',ddft,' kd=',kd,' kbl=',kbl,' k=',k +! +! Convective transport (mixing) of passive tracers +! + if (NTRC > 0) then + do l=kd,km1 + if (etz(l) /= zero) etzi(l) = one / etz(l) + enddo + DO N=1,NTRC ! Tracer loop ; first two are u and v + + DO L=KD,K + HOL(L) = ROI(L,N) + ENDDO +! + HCC = RBL(N) + HOD(KD) = HOL(KD) +! Compute downdraft properties for the tracer + DO L=KD1,K + lm1 = l - 1 + ST1 = ONE - ALFIND(L) + HB = ALFIND(L) * HOL(LM1) + ST1 * HOL(L) + IF (ETZ(LM1) /= ZERO) THEN + TEM = ETZI(LM1) + IF (ETD(L) > ETD(LM1)) THEN + HOD(L) = (ETD(LM1)*(HOD(LM1)-HOL(LM1)) & + & + ETD(L) *(HOL(LM1)-HB) + ETZ(LM1)*HB) * TEM + ELSE + HOD(L) = (ETD(LM1)*(HOD(LM1)-HB) + ETZ(LM1)*HB) * TEM + ENDIF + ELSE + HOD(L) = HB + ENDIF + ENDDO + + DO L=KB1,KD,-1 + HCC = HCC + (ETA(L)-ETA(L+1))*HOL(L) + ENDDO +! +! Scavenging -- fscav - fraction scavenged [km-1] +! delz - distance from the entrainment to detrainment layer [km] +! fnoscav - the fraction not scavenged +! following Liu et al. [JGR,2001] Eq 1 + + if (FSCAV_(N) > zero) then + DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001) + FNOSCAV = exp(- FSCAV_(N) * DELZKM) + else + FNOSCAV = one + endif + + GMH(KD) = PRI(KD) * (HCC-ETA(KD)*HOL(KD)) * trcfac(kd,n) & + & * FNOSCAV + DO L=KD1,K + if (FSCAV_(N) > zero) then + DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001) + FNOSCAV = exp(- FSCAV_(N) * DELZKM) + endif + lm1 = l - 1 + ST1 = ONE - ALFINT(L,N+4) + ST2 = ONE - ALFIND(L) + HB = ALFINT(L,N+4) * HOL(LM1) + ST1 * HOL(L) + HBD = ALFIND(L) * HOL(LM1) + ST2 * HOL(L) + TEM5 = ETD(L) * (HOD(L) - HBD) + DH = ETA(L) * (HB - HOL(L)) * FNOSCAV + TEM5 + GMH(L ) = DH * PRI(L) * trcfac(l,n) + DH = ETA(L) * (HOL(LM1) - HB) * FNOSCAV - TEM5 + GMH(LM1) = GMH(LM1) + DH * PRI(LM1) * trcfac(l,n) + ENDDO +! + st2 = zero + DO L=KD,K + ST1 = GMH(L)*AMB*sigf(l) + st2 + st3 = HOL(L) + st1 + st2 = st3 - trcmin(n) ! if trcmin is defined limit change + if (st2 < zero) then + ROI(L,N) = trcmin(n) + RCU(L,N) = RCU(L,N) + ST1 + if (l < k) + & st2 = st2 * (prl(l+1)-prl(l))*pri(l+1) * (cmb2pa/grav) + else + ROI(L,N) = ST3 + RCU(L,N) = RCU(L,N) + ST1 + st2 = zero + endif + +! ROI(L,N) = HOL(L) + ST1 +! RCU(L,N) = RCU(L,N) + ST1 + +! if (l < k) then +! if (lprnt .and. n == ntk) write(0,*)' in ras roifin=',roi(l,n), +! &' hol=',hol(l),' gmh=',GMH(L),' amb=',amb,' l=',l +! &,' st2=',st2,' st3=',st3,' trcmin=',trcmin(n) +! &,' roi=',roi(l,n),' n=',n,' prl=',prl(l+1),prl(l),' pri=', +! & pri(l+1) +! else +! if (lprnt .and. n == ntk) write(0,*)' in ras roifin=',roi(l,n), +! &' hol=',hol(l),' gmh=',GMH(L),' amb=',amb,' l=',l +! &,' st2=',st2,' st3=',st3,' trcmin=',trcmin(n) +! &,' roi=',roi(l,n),' n=',n +! endif + + ENDDO + ENDDO ! Tracer loop NTRC + endif + endif ! amb > zero + +! if (lprnt) write(0,*)' toio=',toi +! if (lprnt) write(0,*)' qoio=',qoi + + RETURN + END + + SUBROUTINE DDRFT( & + & K, KP1, KD & + &, TLA, ALFIND, wcbase & + &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF & +! &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF, HBL, QBL& + &, QRB, QRT, BUY, KBL, IDH, ETA, RNN, ETAI & + &, ALM, WFN, TRAIN, DDFT & + &, ETD, HOD, QOD, EVP, DOF, CLDFRD, WCB & + &, GMS, GSD, GHD, wvlu, lprnt) + +! +!*********************************************************************** +!******************** Cumulus Downdraft Subroutine ********************* +!****************** Based on Cheng and Arakawa (1997) ****** ********** +!************************ SUBROUTINE DDRFT **************************** +!************************* October 2004 ****************************** +!*********************************************************************** +!*********************************************************************** +!************* Shrinivas.Moorthi@noaa.gov (301) 683-3718 *************** +!*********************************************************************** +!*********************************************************************** +!23456789012345678901234567890123456789012345678901234567890123456789012 +! +!===> TOL(K) INPUT TEMPERATURE KELVIN +!===> QOL(K) INPUT SPECIFIC HUMIDITY NON-DIMENSIONAL + +!===> PRL(KP1) INPUT PRESSURE @ EDGES MB + +!===> K INPUT THE RISE & THE INDEX OF THE SUBCLOUD LAYER +!===> KD INPUT DETRAINMENT LEVEL ( 1<= KD < K ) +! + USE MACHINE , ONLY : kind_phys +! use module_ras + IMPLICIT NONE +! +! INPUT ARGUMENTS +! + INTEGER K, KP1, KD, KBL + real(kind=kind_phys) ALFIND(K), wcbase + + real(kind=kind_phys), dimension(kd:k) :: HOL, QOL, HST, QST & + &, TOL, QRB, QRT, RNN & + &, RNS, ETAI + real(kind=kind_phys), dimension(kd:kp1) :: GAF, BUY, GAM, ETA & + &, PRL +! +! real(kind=kind_phys) HBL, QBL, PRIS & +! &, TRAIN, WFN, ALM +! +! TEMPORARY WORK SPACE +! + real(kind=kind_phys), dimension(KD:K) :: RNF, WCB, EVP, STLT & + &, GHD, GSD, CLDFRD & + &, GQW, QRPI, QRPS, BUD + + real(kind=kind_phys), dimension(KD:KP1) :: QRP, WVL, WVLU, ETD & + &, HOD, QOD, ROR, GMS + + real(kind=kind_phys) TL, PL, QL, QS, DQS, ST1 & + &, QQQ, DEL_ETA, HB, QB, TB & + &, TEM, TEM1, TEM2, TEM3, TEM4, ST2 & + &, ERRMIN, ERRMI2, ERRH, ERRW, ERRE, TEM5 & + &, TEM6, HBD, QBD, TX1, TX2, TX3 & + &, TX4, TX5, TX6, TX7, TX8, TX9 & + &, WFN, ALM, AL2 & + &, TRAIN, GMF, ONPG, CTLA, VTRM & + &, RPART, QRMIN, AA1, BB1, CC1, DD1 & +! &, WC2MIN, WCMIN, WCBASE, F2, F3, F5 & + &, WC2MIN, WCMIN, F2, F3, F5 & + &, GMF1, GMF5, QRAF, QRBF, del_tla & + &, TLA, STLA, CTL2, CTL3 & +! &, TLA, STLA, CTL2, CTL3, ASIN & + &, RNT, RNB, ERRQ, RNTP, QRPF, VTPF & + &, EDZ, DDZ, CE, QHS, FAC, FACG & + &, RSUM1, RSUM2, RSUM3, CEE, DOF, DOFW +! &, sialf + + INTEGER I, L, N, IX, KD1, II, kb1, IP1, JJ, ntla & + &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1 & + &, IDW, IDH, IDN(K), idnm, itr +! + parameter (ERRMIN=0.0001, ERRMI2=0.1*ERRMIN) +! parameter (ERRMIN=0.00001, ERRMI2=0.1*ERRMIN) +! + real (kind=kind_phys), parameter :: PIINV=one/PI +! real (kind=kind_phys), parameter :: PIINV=one/PI, pio2=half*pi +! + parameter (ONPG=one+half, GMF=one/ONPG, RPART=zero) +! parameter (ONPG=1.0+0.5, GMF=1.0/ONPG, RPART=1.0) +! parameter (ONPG=1.0+0.5, GMF=1.0/ONPG, RPART=0.5) +! PARAMETER (AA1=1.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) +! PARAMETER (AA1=2.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) + PARAMETER (AA1=1.0, BB1=1.0, CC1=1.0, DD1=1.0, F3=CC1, F5=1.0) + parameter (QRMIN=1.0E-6, WC2MIN=0.01, GMF1=GMF/AA1, GMF5=GMF/F5) +! parameter (QRMIN=1.0E-6, WC2MIN=1.00, GMF1=GMF/AA1, GMF5=GMF/F5) + parameter (WCMIN=sqrt(wc2min)) +! parameter (sialf=0.5) +! + integer, parameter :: itrmu=25, itrmd=25 + &, itrmin=15, itrmnd=12, numtla=2 + +! uncentering for vvel in dd + real(kind=kind_phys), parameter :: ddunc1=0.25, ddunc2=one-ddunc1 +! &, ddunc1=0.4, ddunc2=one-ddunc1 +! &, ddunc1=0.3, ddunc2=one-ddunc1 + &, VTPEXP=-0.3636 + & VTP=36.34*SQRT(1.2)*(0.001)**0.1364 +! +! real(kind=kind_phys) EM(K*K), ELM(K) + real(kind=kind_phys) ELM(K), AA(KD:K,KD:KP1), QW(KD:K,KD:K) & + &, VT(2), VRW(2), TRW(2), QA(3), WA(3) + + LOGICAL SKPUP, cnvflg, DDFT, UPDRET, DDLGK, lprnt + +!*********************************************************************** + +! if(lprnt) write(0,*)' K=',K,' KD=',KD,' In Downdrft' + + KD1 = KD + 1 + KM1 = K - 1 + KB1 = KBL - 1 +! +! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 +! VTPEXP = -0.3636 +! PIINV = 1.0 / PI +! PICON = PIO2 * ONEBG +! +! Compute Rain Water Budget of the Updraft (Cheng and Arakawa, 1997) +! + CLDFRD = zero + RNTP = zero + DOF = zero + ERRQ = 10.0 + RNB = zero + RNT = zero + TX2 = PRL(KBL) +! + TX1 = (PRL(KD) + PRL(KD1)) * half + ROR(KD) = CMPOR*TX1 / (TOL(KD)*(one+NU*QOL(KD))) +! GMS(KD) = VTP * ROR(KD) ** VTPEXP + GMS(KD) = VTP * VTPF(ROR(KD)) +! + QRP(KD) = QRMIN +! + TEM = TOL(K) * (one + NU * QOL(K)) + ROR(KP1) = half * CMPOR * (PRL(KP1)+PRL(K)) / TEM + GMS(KP1) = VTP * VTPF(ROR(KP1)) + QRP(KP1) = QRMIN +! + kk = kbl + DO L=KD1,K + TEM = half * (TOL(L)+TOL(L-1)) & + & * (one + (half*NU) * (QOL(L)+QOL(L-1))) + ROR(L) = CMPOR * PRL(L) / TEM +! GMS(L) = VTP * ROR(L) ** VTPEXP + GMS(L) = VTP * VTPF(ROR(L)) + QRP(L) = QRMIN + if (buy(l) <= zero .and. kk == KBL) then + kk = l + endif + ENDDO + if (kk /= kbl) then + do l=kk,kbl + buy(l) = 0.9 * buy(l-1) + enddo + endif +! + do l=kd,k + qrpi(l) = buy(l) + enddo + do l=kd1,kb1 + buy(l) = 0.25 * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) + enddo + +! +! CALL ANGRAD(TX1, ALM, STLA, CTL2, AL2, PI, TLA, TX2, WFN, TX3) + tx1 = 1000.0 + tx1 - prl(kp1) +! CALL ANGRAD(TX1, ALM, AL2, TLA, TX2, WFN, TX3) + CALL ANGRAD(TX1, ALM, AL2, TLA) +! +! Following Ucla approach for rain profile +! + F2 = (BB1+BB1)*ONEBG/(PI*0.2) +! WCMIN = SQRT(WC2MIN) +! WCBASE = WCMIN +! +! del_tla = TLA * 0.2 +! del_tla = TLA * 0.25 + del_tla = TLA * 0.3 + TLA = TLA - DEL_TLA +! + DO L=KD,K + RNF(L) = zero + RNS(L) = zero + STLT(L) = zero + GQW(L) = zero + QRP(L) = QRMIN + DO N=KD,K + QW(N,L) = zero + ENDDO + ENDDO +! DO L=KD,KP1 +! WVL(L) = zero +! ENDDO +! +!-----QW(N,L) = D(W(N)*W(N))/DQR(L) +! + KK = KBL + QW(KD,KD) = -QRB(KD) * GMF1 + GHD(KD) = ETA(KD) * ETA(KD) + GQW(KD) = QW(KD,KD) * GHD(KD) + GSD(KD) = ETAI(KD) * ETAI(KD) +! + GQW(KK) = - QRB(KK-1) * (GMF1+GMF1) +! + WCB(KK) = WCBASE * WCBASE + + TX1 = WCB(KK) + GSD(KK) = one + GHD(KK) = one +! + TEM = GMF1 + GMF1 + DO L=KB1,KD1,-1 + GHD(L) = ETA(L) * ETA(L) + GSD(L) = ETAI(L) * ETAI(L) + GQW(L) = - GHD(L) * (QRB(L-1)+QRT(L)) * TEM + QW(L,L) = - QRT(L) * TEM +! + st1 = half * (eta(l) + eta(l+1)) + TX1 = TX1 + BUY(L) * TEM * (qrb(l)+qrt(l)) * st1 * st1 + WCB(L) = TX1 * GSD(L) + ENDDO +! + TEM1 = (QRB(KD) + QRT(KD1) + QRT(KD1)) * GMF1 + GQW(KD1) = - GHD(KD1) * TEM1 + QW(KD1,KD1) = - QRT(KD1) * TEM + st1 = half * (eta(kd) + eta(kd1)) + WCB(KD) = (TX1 + BUY(KD)*TEM*qrb(kd)*st1*st1) * GSD(KD) +! + DO L=KD1,KBL + DO N=KD,L-1 + QW(N,L) = GQW(L) * GSD(N) + ENDDO + ENDDO + QW(KBL,KBL) = zero +! + do ntla=1,numtla ! numtla is the the maximimu number of tilting angle tries + ! ------ +! if (errq < 1.0 .or. tla > 45.0) cycle + if (errq < 0.1 .or. tla > 45.0) cycle +! + tla = tla + del_tla + STLA = SIN(TLA*deg2rad) ! sine of tilting angle + CTL2 = one - STLA * STLA ! cosine square of tilting angle +! +! if (lprnt) write(0,*)' tla=',tla,' al2=',al2,' ptop=' +! &,0.5*(prl(kd)+prl(kd1)),' ntla=',ntla,' f2=',f2,' stla=',stla +! if (lprnt) write(0,*)' buy=',(buy(l),l=kd,kbl) +! + STLA = F2 * STLA * AL2 + CTL2 = DD1 * CTL2 + CTL3 = 0.1364 * CTL2 +! + DO L=KD,K + RNF(L) = zero + STLT(L) = zero + QRP(L) = QRMIN + ENDDO + DO L=KD,KP1 + WVL(L) = zero + ENDDO + WVL(KBL) = WCBASE + STLT(KBL) = one / WCBASE +! + DO L=KD,KP1 + DO N=KD,K + AA(N,L) = zero + ENDDO + ENDDO +! + SKPUP = .FALSE. +! + DO ITR=1,ITRMU ! Rain Profile Iteration starts! + IF (.NOT. SKPUP) THEN +! wvlu = wvl +! +!-----CALCULATING THE VERTICAL VELOCITY +! + TX1 = zero + QRPI(KBL) = one / QRP(KBL) + DO L=KB1,KD,-1 + TX1 = TX1 + QRP(L+1)*GQW(L+1) + ST1 = WCB(L) + QW(L,L)*QRP(L) + TX1*GSD(L) +! if (st1 > wc2min) then + if (st1 > zero) then +! if (lprnt) write(0,*)' l=',l,' st1=',st1,' wvl=',wvl(l) + WVL(L) = max(ddunc1*SQRT(ST1) + ddunc2*WVL(L), wcmin) +! WVL(L) = SQRT(ST1) +! WVL(L) = max(half * (SQRT(ST1) + WVL(L)), wcmin) +! qrp(l) = half*((wvl(l)*wvl(l)-wcb(l)-tx1*gsd(l))/qw(l,l)& +! & + qrp(l)) + else + +! if (lprnt) write(0,*)' l=',l,' st1=',st1,' wcb=',wcb(l),' qw=' +! &,qw(l,l),' qrp=',qrp(l),' tx1=',tx1,' gsd=',gsd(l),' itr=',itr +! &,' wvl=',wvl(l) + +! wvl(l) = 0.5*(wcmin+wvl(l)) +! wvl(l) = max(half*(wvl(l) + wvl(l+1)), wcmin) + wvl(l) = max(wvl(l),wcmin) + qrp(l) = (wvl(l)*wvl(l) - wcb(l) - tx1*gsd(l))/qw(l,l) +! qrp(l) = half*((wvl(l)*wvl(l)-wcb(l)-tx1*gsd(l))/qw(l,l)& +! & + qrp(l)) + endif + qrp(l) = max(qrp(l), qrmin) + + STLT(L) = one / WVL(L) + QRPI(L) = one / QRP(L) + ENDDO +! +! if (lprnt) then +! write(0,*) ' ITR=',ITR,' ITRMU=',ITRMU,' kd=',kd,' kbl=',kbl +! write(0,*) ' WVL=',(WVL(L),L=KD,KBL) +! write(0,*) ' qrp=',(qrp(L),L=KD,KBL) +! write(0,*) ' qrpi=',(qrpi(L),L=KD,KBL) +! write(0,*) ' rnf=',(rnf(L),L=KD,KBL) +! endif +! +!-----CALCULATING TRW, VRW AND OF +! +! VT(1) = GMS(KD) * QRP(KD)**0.1364 + VT(1) = GMS(KD) * QRPF(QRP(KD)) + TRW(1) = ETA(KD) * QRP(KD) * STLT(KD) + TX6 = TRW(1) * VT(1) + VRW(1) = F3*WVL(KD) - CTL2*VT(1) + BUD(KD) = STLA * TX6 * QRB(KD) * half + RNF(KD) = BUD(KD) + DOF = 1.1364 * BUD(KD) * QRPI(KD) + DOFW = -BUD(KD) * STLT(KD) +! + RNT = TRW(1) * VRW(1) + TX2 = zero + TX4 = zero + RNB = RNT + TX1 = half + TX8 = zero +! + IF (RNT >= zero) THEN + TX3 = (RNT-CTL3*TX6) * QRPI(KD) + TX5 = CTL2 * TX6 * STLT(KD) + ELSE + TX3 = zero + TX5 = zero + RNT = zero + RNB = zero + ENDIF +! + DO L=KD1,KB1 + KTEM = MAX(L-2, KD) + LL = L - 1 +! +! VT(2) = GMS(L) * QRP(L)**0.1364 + VT(2) = GMS(L) * QRPF(QRP(L)) + TRW(2) = ETA(L) * QRP(L) * STLT(L) + VRW(2) = F3*WVL(L) - CTL2*VT(2) + QQQ = STLA * TRW(2) * VT(2) + ST1 = TX1 * QRB(LL) + BUD(L) = QQQ * (ST1 + QRT(L)) +! + QA(2) = DOF + WA(2) = DOFW + DOF = 1.1364 * BUD(L) * QRPI(L) + DOFW = -BUD(L) * STLT(L) +! + RNF(LL) = RNF(LL) + QQQ * ST1 + RNF(L) = QQQ * QRT(L) +! + TEM3 = VRW(1) + VRW(2) + TEM4 = TRW(1) + TRW(2) +! + TX6 = pt25 * TEM3 * TEM4 + TEM4 = TEM4 * CTL3 +! +!-----BY QR ABOVE +! +! TEM1 = pt25*(TRW(1)*TEM3 - TEM4*VT(1))*TX7 + TEM1 = pt25*(TRW(1)*TEM3 - TEM4*VT(1))*QRPI(LL) + ST1 = pt25*(TRW(1)*(CTL2*VT(1)-VRW(2)) & + & * STLT(LL) + F3*TRW(2)) +!-----BY QR BELOW + TEM2 = pt25*(TRW(2)*TEM3 - TEM4*VT(2))*QRPI(L) + ST2 = pt25*(TRW(2)*(CTL2*VT(2)-VRW(1)) & + & * STLT(L) + F3*TRW(1)) +! +! From top to the KBL-2 layer +! + QA(1) = TX2 + QA(2) = QA(2) + TX3 - TEM1 + QA(3) = -TEM2 +! + WA(1) = TX4 + WA(2) = WA(2) + TX5 - ST1 + WA(3) = -ST2 +! + TX2 = TEM1 + TX3 = TEM2 + TX4 = ST1 + TX5 = ST2 +! + VT(1) = VT(2) + TRW(1) = TRW(2) + VRW(1) = VRW(2) +! + IF (WVL(KTEM) == WCMIN) WA(1) = zero + IF (WVL(LL) == WCMIN) WA(2) = zero + IF (WVL(L) == WCMIN) WA(3) = zero + DO N=KTEM,KBL + AA(LL,N) = (WA(1)*QW(KTEM,N) * STLT(KTEM) & + & + WA(2)*QW(LL,N) * STLT(LL) & + & + WA(3)*QW(L,N) * STLT(L) ) * half + ENDDO + AA(LL,KTEM) = AA(LL,KTEM) + QA(1) + AA(LL,LL) = AA(LL,LL) + QA(2) + AA(LL,L) = AA(LL,L) + QA(3) + BUD(LL) = (TX8 + RNN(LL)) * half & + & - RNB + TX6 - BUD(LL) + AA(LL,KBL+1) = BUD(LL) + RNB = TX6 + TX1 = one + TX8 = RNN(LL) + ENDDO + L = KBL + LL = L - 1 +! VT(2) = GMS(L) * QRP(L)**0.1364 + VT(2) = GMS(L) * QRPF(QRP(L)) + TRW(2) = ETA(L) * QRP(L) * STLT(L) + VRW(2) = F3*WVL(L) - CTL2*VT(2) + ST1 = STLA * TRW(2) * VT(2) * QRB(LL) + BUD(L) = ST1 + + QA(2) = DOF + WA(2) = DOFW + DOF = 1.1364 * BUD(L) * QRPI(L) + DOFW = -BUD(L) * STLT(L) +! + RNF(LL) = RNF(LL) + ST1 +! + TEM3 = VRW(1) + VRW(2) + TEM4 = TRW(1) + TRW(2) +! + TX6 = pt25 * TEM3 * TEM4 + TEM4 = TEM4 * CTL3 +! +!-----BY QR ABOVE +! + TEM1 = pt25*(TRW(1)*TEM3 - TEM4*VT(1))*QRPI(LL) + ST1 = pt25*(TRW(1)*(CTL2*VT(1)-VRW(2)) & + & * STLT(LL) + F3*TRW(2)) +!-----BY QR BELOW + TEM2 = pt25*(TRW(2)*TEM3 - TEM4*VT(2))*QRPI(L) + ST2 = pt25*(TRW(2)*(CTL2*VT(2)-VRW(1)) & + & * STLT(L) + F3*TRW(1)) +! +! For the layer next to the top of the boundary layer +! + QA(1) = TX2 + QA(2) = QA(2) + TX3 - TEM1 + QA(3) = -TEM2 +! + WA(1) = TX4 + WA(2) = WA(2) + TX5 - ST1 + WA(3) = -ST2 +! + TX2 = TEM1 + TX3 = TEM2 + TX4 = ST1 + TX5 = ST2 +! + IDW = MAX(L-2, KD) +! + IF (WVL(IDW) == WCMIN) WA(1) = zero + IF (WVL(LL) == WCMIN) WA(2) = zero + IF (WVL(L) == WCMIN) WA(3) = zero +! + KK = IDW + DO N=KK,L + AA(LL,N) = (WA(1)*QW(KK,N) * STLT(KK) & + & + WA(2)*QW(LL,N) * STLT(LL) & + & + WA(3)*QW(L,N) * STLT(L) ) * half + + ENDDO +! + AA(LL,IDW) = AA(LL,IDW) + QA(1) + AA(LL,LL) = AA(LL,LL) + QA(2) + AA(LL,L) = AA(LL,L) + QA(3) + BUD(LL) = (TX8+RNN(LL)) * half - RNB + TX6 - BUD(LL) +! + AA(LL,L+1) = BUD(LL) +! + RNB = TRW(2) * VRW(2) +! +! For the top of the boundary layer +! + IF (RNB < zero) THEN + KK = KBL + TEM = VT(2) * TRW(2) + QA(2) = (RNB - CTL3*TEM) * QRPI(KK) + WA(2) = CTL2 * TEM * STLT(KK) + ELSE + RNB = zero + QA(2) = zero + WA(2) = zero + ENDIF +! + QA(1) = TX2 + QA(2) = DOF + TX3 - QA(2) + QA(3) = zero +! + WA(1) = TX4 + WA(2) = DOFW + TX5 - WA(2) + WA(3) = zero +! + KK = KBL + IF (WVL(KK-1) == WCMIN) WA(1) = zero + IF (WVL(KK) == WCMIN) WA(2) = zero +! + DO II=1,2 + N = KK + II - 2 + AA(KK,N) = (WA(1)*QW(KK-1,N) * STLT(KK-1) & + & + WA(2)*QW(KK,N) * STLT(KK)) * half + ENDDO + FAC = half + LL = KBL + L = LL + 1 + LM1 = LL - 1 + AA(LL,LM1) = AA(LL,LM1) + QA(1) + AA(LL,LL) = AA(LL,LL) + QA(2) + BUD(LL) = half*RNN(LM1) - TX6 + RNB - BUD(LL) + AA(LL,LL+1) = BUD(LL) +! +!-----SOLVING THE BUDGET EQUATIONS FOR DQR +! + DO L=KD1,KBL + LM1 = L - 1 + cnvflg = ABS(AA(LM1,LM1)) < ABS(AA(L,LM1)) + DO N=LM1,KBL+1 + IF (cnvflg) THEN + TX1 = AA(LM1,N) + AA(LM1,N) = AA(L,N) + AA(L,N) = TX1 + ENDIF + ENDDO + TX1 = AA(L,LM1) / AA(LM1,LM1) + DO N=L,KBL+1 + AA(L,N) = AA(L,N) - TX1 * AA(LM1,N) + ENDDO + ENDDO +! +!-----BACK SUBSTITUTION AND CHECK IF THE SOLUTION CONVERGES +! + KK = KBL + KK1 = KK + 1 + AA(KK,KK1) = AA(KK,KK1) / AA(KK,KK) ! Qr correction ! + TX2 = ABS(AA(KK,KK1)) * QRPI(KK) ! Error Measure ! +! if (lprnt) write(0,*) ' tx2a=',tx2,' aa1=',aa(kk,kk1) +! &,' qrpi=',qrpi(kk) +! + KK = KBL + 1 + DO L=KB1,KD,-1 + LP1 = L + 1 + TX1 = zero + DO N=LP1,KBL + TX1 = TX1 + AA(L,N) * AA(N,KK) + ENDDO + AA(L,KK) = (AA(L,KK) - TX1) / AA(L,L) ! Qr correction ! + TX2 = MAX(TX2, ABS(AA(L,KK))*QRPI(L)) ! Error Measure ! + +! if (lprnt) write(0,*)' tx2b=',tx2,' aa1=',aa(l,kk) +! &,' qrpi=',qrpi(l),' L=',L + + ENDDO +! +! tem = 0.5 + if (tx2 > one .and. abs(errq-tx2) > 0.1) then + tem = half +!! elseif (tx2 < 0.1) then +!! tem = 1.2 + else + tem = one + endif +! + DO L=KD,KBL +! QRP(L) = MAX(QRP(L)+AA(L,KBL+1), QRMIN) + QRP(L) = MAX(QRP(L)+AA(L,KBL+1)*tem, QRMIN) + ENDDO +! +! if (lprnt) write(0,*)' itr=',itr,' tx2=',tx2 + + IF (ITR < ITRMIN) THEN + TEM = ABS(ERRQ-TX2) + IF (TEM >= ERRMI2 .AND. TX2 >= ERRMIN) THEN + ERRQ = TX2 ! Further iteration ! + ELSE + SKPUP = .TRUE. ! Converges ! + ERRQ = zero ! Rain profile exists! +! if (lprnt) write(0,*)' here1',' tem=',tem,' tx2=',tx2,' errmi2=', +! &errmi2,' errmin=',errmin + ENDIF + ELSE + TEM = ERRQ - TX2 +! IF (TEM < ZERO .AND. ERRQ > 0.1) THEN + IF (TEM < ZERO .AND. ERRQ > 0.5) THEN +! IF (TEM < ZERO .and. & +! & (ntla < numtla .or. ERRQ > 0.5)) THEN +! if (lprnt) write(0,*)' tx2=',tx2,' errq=',errq,' tem=',tem + SKPUP = .TRUE. ! No convergence ! + ERRQ = 10.0 ! No rain profile! +!!!! ELSEIF (ABS(TEM) < ERRMI2 .OR. TX2 < ERRMIN) THEN + ELSEIF (TX2 < ERRMIN) THEN + SKPUP = .TRUE. ! Converges ! + ERRQ = zero ! Rain profile exists! +! if (lprnt) write(0,*)' here2' + elseif (tem < zero .and. errq < 0.1) then + skpup = .true. +! if (ntla == numtla .or. tem > -0.003) then + errq = zero +! else +! errq = 10.0 +! endif + ELSE + ERRQ = TX2 ! Further iteration ! +! if (lprnt) write(0,*)' itr=',itr,' errq=',errq +! if (itr == itrmu .and. ERRQ > ERRMIN*10 & +! & .and. ntla == 1) ERRQ = 10.0 + ENDIF + ENDIF +! +! if (lprnt) write(0,*)' ERRQ=',ERRQ + + ENDIF ! SKPUP ENDIF! +! + ENDDO ! End of the ITR Loop!! +! +! if(lprnt) then +! write(0,*)' QRP=',(QRP(L),L=KD,KBL) +! write(0,*)'RNF=',(RNF(L),L=KD,KBL),' RNT=',RNT,' RNB=',RNB +! &,' errq=',errq +! endif +! + IF (ERRQ < 0.1) THEN + DDFT = .TRUE. + RNB = - RNB +! do l=kd1,kb1-1 +! if (wvl(l)-wcbase < 1.0E-9) ddft = .false. +! enddo + ELSE + DDFT = .FALSE. + ENDIF + + enddo ! End of ntla loop +! +! Caution !! Below is an adjustment to rain flux to maintain +! conservation of precip! +! + IF (DDFT) THEN + TX1 = zero + DO L=KD,KB1 + TX1 = TX1 + RNF(L) + ENDDO +! if (lprnt) write(0,*)' tx1+rnt+rnb=',tx1+rnt+rnb, ' train=',train + TX1 = TRAIN / (TX1+RNT+RNB) +! if (lprnt) write(0,*)' tx1= ', tx1 + IF (ABS(TX1-one) < 0.2) THEN + RNT = MAX(RNT*TX1,ZERO) + RNB = RNB * TX1 + DO L=KD,KB1 + RNF(L) = RNF(L) * TX1 + ENDDO +! rain flux adjustment is over + +! if (lprnt) write(0,*)' TRAIN=',TRAIN +! if (lprnt) write(0,*)' RNF=',RNF + + ELSE + DDFT = .FALSE. + ERRQ = 10.0 + ENDIF + ENDIF +! + DOF = zero + IF (.NOT. DDFT) then + wvlu(kd:kp1) = zero + RETURN ! Rain profile did not converge! + ! No down draft for this case - rerurn + ! ------------------------------------ +! + else ! rain profile converged - do downdraft calculation + ! ------------------------------------------------ + + wvlu(kd:kp1) = wvl(kd:kp1) ! save updraft vertical velocity for output + +! if (lprnt) write(0,*)' in ddrft kd=',kd,'wvlu=',wvlu(kd:kp1) +! +! Downdraft calculation begins +! ---------------------------- +! + DO L=KD,K + WCB(L) = zero + ENDDO +! + ERRQ = 10.0 +! At this point stlt contains inverse of updraft vertical velocity 1/Wu. + + KK = MAX(KB1,KD1) + DO L=KK,K + STLT(L) = STLT(L-1) + ENDDO + TEM = stla / BB1 ! this is 2/(pi*radius*grav) +! + DO L=KD,K + IF (L <= KBL) THEN + STLT(L) = ETA(L) * STLT(L) * TEM / ROR(L) + ELSE + STLT(L) = zero + ENDIF + ENDDO +! if (lprnt) write(0,*)' STLT=',stlt + + rsum1 = zero + rsum2 = zero +! + IDN(:) = idnmax + DO L=KD,KP1 + ETD(L) = zero + WVL(L) = zero +! QRP(L) = zero + ENDDO + DO L=KD,K + EVP(L) = zero + BUY(L) = zero + QRP(L+1) = zero + ENDDO + HOD(KD) = HOL(KD) + QOD(KD) = QOL(KD) + TX1 = zero +!!! TX1 = STLT(KD)*QRB(KD)*ONE ! sigma at the top +! TX1 = MIN(STLT(KD)*QRB(KD)*ONE, ONE) ! sigma at the top +! TX1 = MIN(STLT(KD)*QRB(KD)*0.5, ONE) ! sigma at the top + RNTP = zero + TX5 = TX1 + QA(1) = zero +! if(lprnt) write(0,*)' stlt=',stlt(kd),' qrb=',qrb(kd) +! *,' tx1=',tx1,' ror=',ror(kd),' gms=',gms(kd),' rpart=',rpart +! *,' rnt=',rnt +! +! Here we assume RPART of detrained rain RNT goes to Pd +! + IF (RNT > zero) THEN + if (TX1 > zero) THEN + QRP(KD) = (RPART*RNT / (ROR(KD)*TX1*GMS(KD))) & + & ** (one/1.1364) + else + tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364) + endif + RNTP = (one - RPART) * RNT + BUY(KD) = - ROR(KD) * TX1 * QRP(KD) + ELSE + QRP(KD) = zero + ENDIF +! +! L-loop for the downdraft iteration from KD1 to KP1 (bottom surface) +! +! BUD(KD) = ROR(KD) + idnm = 1 + DO L=KD1,KP1 + + QA(1) = zero + ddlgk = idn(idnm) == idnmax + if (.not. ddlgk) cycle + IF (L <= K) THEN + ST1 = one - ALFIND(L) + WA(1) = ALFIND(L)*HOL(L-1) + ST1*HOL(L) + WA(2) = ALFIND(L)*QOL(L-1) + ST1*QOL(L) + WA(3) = ALFIND(L)*TOL(L-1) + ST1*TOL(L) + QA(2) = ALFIND(L)*HST(L-1) + ST1*HST(L) + QA(3) = ALFIND(L)*QST(L-1) + ST1*QST(L) + ELSE + WA(1) = HOL(K) + WA(2) = QOL(K) + WA(3) = TOL(K) + QA(2) = HST(K) + QA(3) = QST(K) + ENDIF +! + FAC = two + IF (L == KD1) FAC = one + + FACG = FAC * half * GMF5 ! 12/17/97 +! +! DDLGK = IDN(idnm) == 99 + + BUD(KD) = ROR(L) + + TX1 = TX5 + WVL(L) = MAX(WVL(L-1),ONE_M1) + + QRP(L) = MAX(QRP(L-1),QRP(L)) +! +! VT(1) = GMS(L-1) * QRP(L-1) ** 0.1364 + VT(1) = GMS(L-1) * QRPF(QRP(L-1)) + RNT = ROR(L-1) * (WVL(L-1)+VT(1))*QRP(L-1) +! if(lprnt) write(0,*)' l=',l,' qa=',qa(1), ' tx1RNT=',RNT*tx1, +! *' wvl=',wvl(l-1) +! *,' qrp=',qrp(l-1),' tx5=',tx5,' tx1=',tx1,' rnt=',rnt + +! + +! TEM = MAX(ALM, 2.5E-4) * MAX(ETA(L), 1.0) + TEM = MAX(ALM,ONE_M6) * MAX(ETA(L), ONE) +! TEM = MAX(ALM, 1.0E-5) * MAX(ETA(L), 1.0) + TRW(1) = PICON*TEM*(QRB(L-1)+QRT(L-1)) + TRW(2) = one / TRW(1) +! + VRW(1) = half * (GAM(L-1) + GAM(L)) + VRW(2) = one / (VRW(1) + VRW(1)) +! + TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.00*EKNOB) +! + DOFW = one / (WA(3) * (one + NU*WA(2))) ! 1.0 / TVbar! +! + ETD(L) = ETD(L-1) + HOD(L) = HOD(L-1) + QOD(L) = QOD(L-1) +! + ERRQ = 10.0 + +! + IF (L <= KBL) THEN + TX3 = STLT(L-1) * QRT(L-1) * (half*FAC) + TX8 = STLT(L) * QRB(L-1) * (half*FAC) + TX9 = TX8 + TX3 + ELSE + TX3 = zero + TX8 = zero + TX9 = zero + ENDIF +! + TEM = WVL(L-1) + VT(1) + IF (TEM > zero) THEN + TEM1 = one / (TEM*ROR(L-1)) + TX3 = VT(1) * TEM1 * ROR(L-1) * TX3 + TX6 = TX1 * TEM1 + ELSE + TX6 = one + ENDIF +! + IF (L == KD1) THEN + IF (RNT > zero) THEN + TEM = MAX(QRP(L-1),QRP(L)) + WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0) + ENDIF + WVL(L) = MAX(ONE_M2, WVL(L)) + TRW(1) = TRW(1) * half + TRW(2) = TRW(2) + TRW(2) + ELSE + IF (DDLGK) EVP(L-1) = EVP(L-2) + ENDIF +! +! No downdraft above level IDH +! + + IF (L < IDH) THEN + + ETD(L) = zero + HOD(L) = WA(1) + QOD(L) = WA(2) + EVP(L-1) = zero + WVL(L) = zero + QRP(L) = zero + BUY(L) = zero + TX5 = TX9 + ERRQ = zero + RNTP = RNTP + RNT * TX1 + RNT = zero + WCB(L-1) = zero + +! ENDIF +! BUD(KD) = ROR(L) +! +! Iteration loop for a given level L begins +! +! if (lprnt) write(0,*)' tx8=',tx8,' tx9=',tx9,' tx5=',tx5 +! &, ' tx1=',tx1 + else + DO ITR=1,ITRMD +! +! cnvflg = DDLGK .AND. (ERRQ > ERRMIN) + cnvflg = ERRQ > ERRMIN + IF (cnvflg) THEN +! +! VT(1) = GMS(L) * QRP(L) ** 0.1364 + VT(1) = GMS(L) * QRPF(QRP(L)) + TEM = WVL(L) + VT(1) +! + IF (TEM > zero) THEN + ST1 = ROR(L) * TEM * QRP(L) + RNT + IF (ST1 /= zero) ST1 = two * EVP(L-1) / ST1 + TEM1 = one / (TEM*ROR(L)) + TEM2 = VT(1) * TEM1 * ROR(L) * TX8 + ELSE + TEM1 = zero + TEM2 = TX8 + ST1 = zero + ENDIF +! if (lprnt) write(0,*)' st1=',st1,' tem=',tem,' ror=',ror(l) +! &,' qrp=',qrp(l),' rnt=',rnt,' ror1=',ror(l-1),' wvl=',wvl(l) +! &,' wvl1=',wvl(l-1),' tem2=',tem2,' vt=',vt(1),' tx3=',tx3 +! + st2 = tx5 + TEM = ROR(L)*WVL(L) - ROR(L-1)*WVL(L-1) + if (tem > zero) then + TX5 = (TX1 - ST1 + TEM2 + TX3)/(one+tem*tem1) + else + TX5 = TX1 - tem*tx6 - ST1 + TEM2 + TX3 + endif + TX5 = MAX(TX5,ZERO) + tx5 = half * (tx5 + st2) +! +! qqq = 1.0 + tem * tem1 * (1.0 - sialf) +! +! if (qqq > 0.0) then +! TX5 = (TX1 - sialf*tem*tx6 - ST1 + TEM2 + TX3) / qqq +! else +! TX5 = (TX1 - tem*tx6 - ST1 + TEM2 + TX3) +! endif +! +! if(lprnt) write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' +! if(tx5 <= 0.0 .and. l > kd+2) +! & write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' +! *,tem2,' tx3=',tx3,' tem=',tem,' tem1=',tem1,' wvl=',wvl(l-1), +! &wvl(l),' l=',l,' itr=',itr,' evp=',evp(l-1),' vt=',vt(1) +! *,' qrp=',qrp(l),' rnt=',rnt,' kd=',kd +! if (lprnt) write(0,*)' etd=',etd(l),' wvl=',wvl(l) +! &,' trw=',trw(1),trw(2),' ror=',ror(l),' wa=',wa + + +! + TEM1 = ETD(L) + ETD(L) = ROR(L) * TX5 * MAX(WVL(L),ZERO) +! + if (etd(l) > zero) etd(l) = half * (etd(l) + tem1) +! + + DEL_ETA = ETD(L) - ETD(L-1) + +! TEM = DEL_ETA * TRW(2) +! TEM2 = MAX(MIN(TEM, 1.0), -1.0) +! IF (ABS(TEM) > 1.0 .AND. ETD(L) > 0.0 ) THEN +! DEL_ETA = TEM2 * TRW(1) +! ETD(L) = ETD(L-1) + DEL_ETA +! ENDIF +! IF (WVL(L) > 0.0) TX5 = ETD(L) / (ROR(L)*WVL(L)) +! + ERRE = ETD(L) - TEM1 +! + tem = max(abs(del_eta), trw(1)) + tem2 = del_eta / tem + TEM1 = SQRT(MAX((tem+DEL_ETA)*(tem-DEL_ETA),ZERO)) +! TEM1 = SQRT(MAX((TRW(1)+DEL_ETA)*(TRW(1)-DEL_ETA),0.0)) + + EDZ = (half + ASIN(TEM2)*PIINV)*DEL_ETA + TEM1*PIINV + + DDZ = EDZ - DEL_ETA + WCB(L-1) = ETD(L) + DDZ +! + TEM1 = HOD(L) + IF (DEL_ETA > zero) THEN + QQQ = one / (ETD(L) + DDZ) + HOD(L) = (ETD(L-1)*HOD(L-1) + DEL_ETA*HOL(L-1) & + & + DDZ*WA(1)) * QQQ + QOD(L) = (ETD(L-1)*QOD(L-1) + DEL_ETA*QOL(L-1) & + & + DDZ*WA(2)) * QQQ + ELSEif((ETD(L-1) + EDZ) > zero) then + QQQ = one / (ETD(L-1) + EDZ) + HOD(L) = (ETD(L-1)*HOD(L-1) + EDZ*WA(1)) * QQQ + QOD(L) = (ETD(L-1)*QOD(L-1) + EDZ*WA(2)) * QQQ + ENDIF + ERRH = HOD(L) - TEM1 + ERRQ = ABS(ERRH/HOD(L)) + ABS(ERRE/MAX(ETD(L),ONE_M5)) +! if (lprnt) write(0,*)' ERRQP=',errq,' errh=',errh,' hod=',hod(l) +! &,' erre=',erre,' etd=',etd(l),' del_eta=',del_eta + DOF = DDZ + VT(2) = QQQ +! + DDZ = DOF + TEM4 = QOD(L) + TEM1 = VRW(1) +! + QHS = QA(3) + half * (GAF(L-1)+GAF(L)) * (HOD(L)-QA(2)) +! +! First iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + TEM2 = ROR(L) * QRP(L) + CALL QRABF(TEM2,QRAF,QRBF) + TEM6 = TX5 * (1.6 + 124.9 * QRAF) * QRBF * TX4 +! + CE = TEM6 * ST2 / ((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) + TEM3 = (one + TEM1) * QHS * (QOD(L)+CE) + TEM = MAX(TEM2*TEM2 - four*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) +! +! +! second iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + CE = TEM6 * ST2 / ((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! CEE = CE * (ETD(L)+DDZ) +! + + + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*tem4) + TEM3 = (one + TEM1) * QHS * (tem4+CE) + TEM = MAX(TEM2*TEM2 - four*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) +! Evaporation in Layer L-1 +! + EVP(L-1) = (QOD(L)-TEM4) * (ETD(L)+DDZ) +! Calculate Pd (L+1/2) + QA(1) = TX1*RNT + RNF(L-1) - EVP(L-1) +! +! if(lprnt) write(0,*)' etd=',etd(l),' tx5=',tx5,' rnt=',rnt +! *,' rnf=',rnf(l-1),' evp=',evp(l-1),' itr=',itr,' L=',L +! + if (qa(1) > zero) then + IF (ETD(L) > zero) THEN + TEM = QA(1) / (ETD(L)+ROR(L)*TX5*VT(1)) + QRP(L) = MAX(TEM,ZERO) + ELSEIF (TX5 > zero) THEN + QRP(L) = (MAX(ZERO,QA(1)/(ROR(L)*TX5*GMS(L)))) & + & ** (one/1.1364) + ELSE + QRP(L) = zero + ENDIF + else + qrp(l) = half * qrp(l) + endif +! Compute Buoyancy + TEM1 = WA(3) + (HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & + & * onebcp +! if (lprnt) write(0,*)' tem1=',tem1,' wa3=',wa(3),' hod=' +! &,hod(l),' wa1=',wa(1),' qod=',qod(l),' wa2=',wa(2),' alhl=',alhl +! &,' cmpor=',cmpor,' dofw=',dofw,' prl=',prl(l),' qrp=',qrp(l) + TEM1 = TEM1 * (one + NU*QOD(L)) + ROR(L) = CMPOR * PRL(L) / TEM1 + TEM1 = TEM1 * DOFW +!!! TEM1 = TEM1 * (1.0 + NU*QOD(L)) * DOFW + + BUY(L) = (TEM1 - one - QRP(L)) * ROR(L) * TX5 +! Compute W (L+1/2) + + TEM1 = WVL(L) +! IF (ETD(L) > 0.0) THEN + WVL(L) = VT(2) * (ETD(L-1)*WVL(L-1) - FACG & + & * (BUY(L-1)*QRT(L-1)+BUY(L)*QRB(L-1))) +! +! if (lprnt) write(0,*)' wvl=',wvl(l),'vt2=',vt(2),' buy1=' +! &,buy(l-1),' buy=',buy(l),' qrt1=',qrt(l-1),' qrb1=',qrb(l-1) +! &,' etd1=',etd(l-1),' wvl1=',wvl(l-1) +! ENDIF +! + if (wvl(l) < zero) then +! WVL(L) = max(wvl(l), 0.1*tem1) +! WVL(L) = 0.5*tem1 +! WVL(L) = 0.1*tem1 +! WVL(L) = 0.0 + WVL(L) = 1.0e-10 + else + WVL(L) = half*(WVL(L)+TEM1) + endif + +! +! WVL(L) = max(0.5*(WVL(L)+TEM1), 0.0) + + ERRW = WVL(L) - TEM1 +! + ERRQ = ERRQ + ABS(ERRW/MAX(WVL(L),ONE_M5)) + +! if (lprnt) write(0,*)' errw=',errw,' wvl=',wvl(l) +! if(lprnt .or. tx5 == 0.0) then +! if(tx5 == 0.0 .and. l > kbl) then +! write(0,*)' errq=',errq,' itr=',itr,' l=',l,' wvl=',wvl(l) +! &,' tx5=',tx5,' idnm=',idnm,' etd1=',etd(l-1),' etd=',etd(l) +! &,' kbl=',kbl +! endif +! +! if(lprnt) write(0,*)' itr=',itr,' itrmnd=',itrmnd,' itrmd=',itrmd +! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN + IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN +! if(lprnt) write(0,*)' itr=',itr,' etd1=',etd(l-1),' errq=',errq + IF (ETD(L-1) == zero .AND. ERRQ > 0.2) THEN +! if(lprnt) write(0,*)' bud=',bud(kd),' wa=',wa(1),wa(2) + ROR(L) = BUD(KD) + ETD(L) = zero + WVL(L) = zero + ERRQ = zero + HOD(L) = WA(1) + QOD(L) = WA(2) +! TX5 = TX1 + TX9 + if (L <= KBL) then + TX5 = TX9 + else + TX5 = (STLT(KB1) * QRT(KB1) & + & + STLT(KBL) * QRB(KB1)) * (0.5*FAC) + endif + +! if(lprnt) write(0,*)' tx1=',tx1,' rnt=',rnt,' rnf=',rnf(l-1) +! *,' evp=',evp(l-1),' l=',l + + EVP(L-1) = zero + TEM = MAX(TX1*RNT+RNF(L-1),ZERO) + QA(1) = TEM - EVP(L-1) +! IF (QA(1) > 0.0) THEN + +! if(lprnt) write(0,*)' ror=',ror(l),' tx5=',tx5,' tx1=',tx1 +! *,' tx9=',tx9,' gms=',gms(l),' qa=',qa(1) +! if(lprnt) call mpi_quit(13) +! if (tx5 == 0.0 .or. gms(l) == 0.0) +! if (lprnt) +! * write(0,*)' Atx5=',tx5,' gms=',gms(l),' ror=',ror(l) +! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 +! *,' kbl=',kbl,' etd1=',etd(l-1),' idnm=',idnm,' idn=',idn(idnm) +! *,' errq=',errq + + QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & + & ** (one/1.1364) +! endif + BUY(L) = - ROR(L) * TX5 * QRP(L) + WCB(L-1) = zero + ENDIF +! + DEL_ETA = ETD(L) - ETD(L-1) + IF(DEL_ETA < zero .AND. ERRQ > 0.1) THEN + ROR(L) = BUD(KD) + ETD(L) = zero + WVL(L) = zero +!!!!! TX5 = TX1 + TX9 + CLDFRD(L-1) = TX5 +! + DEL_ETA = - ETD(L-1) + EDZ = zero + DDZ = -DEL_ETA + WCB(L-1) = DDZ +! + HOD(L) = HOD(L-1) + QOD(L) = QOD(L-1) +! + TEM4 = QOD(L) + TEM1 = VRW(1) +! + QHS = QA(3) + half * (GAF(L-1)+GAF(L)) & + & * (HOD(L)-QA(2)) + +! +! First iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + TEM2 = ROR(L) * QRP(L-1) + CALL QRABF(TEM2,QRAF,QRBF) + TEM6 = TX5 * (1.6 + 124.9 * QRAF) * QRBF * TX4 +! + CE = TEM6*ST2/((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! + + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) + TEM3 = (one + TEM1) * QHS * (QOD(L)+CE) + TEM = MAX(TEM2*TEM2 -FOUR*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) +! +! second iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + CE = TEM6*ST2/((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! CEE = CE * (ETD(L)+DDZ) +! + + + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*tem4) + TEM3 = (one + TEM1) * QHS * (tem4+CE) + TEM = MAX(TEM2*TEM2 -FOUR*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) + +! Evaporation in Layer L-1 +! + EVP(L-1) = (QOD(L)-TEM4) * (ETD(L)+DDZ) + +! Calculate Pd (L+1/2) +! RNN(L-1) = TX1*RNT + RNF(L-1) - EVP(L-1) + + QA(1) = TX1*RNT + RNF(L-1) + EVP(L-1) = min(EVP(L-1), QA(1)) + QA(1) = QA(1) - EVP(L-1) + qrp(l) = zero + +! +! if (tx5 == 0.0 .or. gms(l) == 0.0) +! if (lprnt) +! * write(0,*)' Btx5=',tx5,' gms=',gms(l),' ror=',ror(l) +! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 +! *,' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA +! &,' evp=',evp(l-1) +! +! IF (QA(1) > 0.0) THEN +!! RNS(L-1) = QA(1) +!!! tx5 = tx9 +! QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & +! & ** (1.0/1.1364) +! endif +! ERRQ = 0.0 +! Compute Buoyancy +! TEM1 = WA(3)+(HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & +! & * (1.0/CP) +! TEM1 = TEM1 * (1.0 + NU*QOD(L)) * DOFW +! BUY(L) = (TEM1 - 1.0 - QRP(L)) * ROR(L) * TX5 +! +! IF (QA(1) > 0.0) RNS(L) = QA(1) + + IF (L .LE. K) THEN + RNS(L) = QA(1) + QA(1) = zero + ENDIF + tx5 = tx9 + ERRQ = zero + QRP(L) = zero + BUY(L) = zero +! + ENDIF + ENDIF + ENDIF +! + ENDDO ! End of the iteration loop for a given L! + IF (L <= K) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.1 .and. l <= kbl) THEN +!!! & .AND. ERRQ > ERRMIN*10.0 .and. l <= kbl) THEN +! & .AND. ERRQ > ERRMIN*10.0) THEN + ROR(L) = BUD(KD) + HOD(L) = WA(1) + QOD(L) = WA(2) + TX5 = TX9 ! Does not make too much difference! +! TX5 = TX1 + TX9 + EVP(L-1) = zero +! EVP(L-1) = CEE * (1.0 - qod(l)/qa(3)) + QA(1) = TX1*RNT + RNF(L-1) + EVP(L-1) = min(EVP(L-1), QA(1)) + QA(1) = QA(1) - EVP(L-1) + +! QRP(L) = 0.0 +! if (tx5 == 0.0 .or. gms(l) == 0.0) then +! write(0,*)' Ctx5=',tx5,' gms=',gms(l),' ror=',ror(l) & +! &, ' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & +! &, ' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA +! endif +! IF (QA(1) > 0.0) THEN + + QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & + & ** (one/1.1364) +! ENDIF + ETD(L) = zero + WVL(L) = zero + ST1 = one - ALFIND(L) + + ERRQ = zero + BUY(L) = - ROR(L) * TX5 * QRP(L) + WCB(L-1) = zero + ENDIF + ENDIF +! + LL = MIN(IDN(idnm), KP1) + IF (ERRQ < one .AND. L <= LL) THEN + IF (ETD(L-1) > zero .AND. ETD(L) == zero) THEN + IDN(idnm) = L + wvl(l) = zero + if (L < KBL .or. tx5 > zero) idnm = idnm + 1 + errq = zero + ENDIF + if (etd(l) == zero .and. l > kbl) then + idn(idnm) = l + if (tx5 > zero) idnm = idnm + 1 + endif + ENDIF + +! if (lprnt) then +! write(0,*)' ERRQ=',ERRQ,' IDN=',IDN(idnm),' idnm=',idnm +! write(0,*)' L=',L,' QRP=',QRP(L),' ETD=',ETD(L),' QA=',QA(1) +! *,' evp=',evp(l-1),' rnf=',rnf(l-1) +! endif + +! +! If downdraft properties are not obtainable, (i.e.solution does +! not converge) , no downdraft is assumed +! +! IF (ERRQ > ERRMIN*100.0 .AND. IDN(idnm) == 99) & + IF (ERRQ > 0.1 .AND. IDN(idnm) == idnmax) DDFT = .FALSE. +! + DOF = zero + IF (.NOT. DDFT) RETURN +! +! if (ddlgk .or. l .le. idn(idnm)) then +! rsum2 = rsum2 + evp(l-1) +! write(0,*)' rsum1=',rsum1,' rsum2=',rsum2,' L=',L,' qa=',qa(1)& +! &, ' evp=',evp(l-1) +! else +! rsum1 = rsum1 + rnf(l-1) +! write(0,*)' rsum1=',rsum1,' rsum2=',rsum2,' L=',L,' rnf=', & +! & rnf(l-1) +! endif + + endif ! if (l < idh) + ENDDO ! End of the L Loop of downdraft ! + + TX1 = zero + + DOF = QA(1) +! +! write(0,*)' dof=',dof,' rntp=',rntp,' rnb=',rnb +! write(0,*)' total=',(rsum1+dof+rntp+rnb) +! + dof = max(dof, zero) + RNN(KD) = RNTP + TX1 = EVP(KD) + TX2 = RNTP + RNB + DOF + +! if (lprnt) write(0,*)' tx2=',tx2 + II = IDH + IF (II >= KD1+1) THEN + RNN(KD) = RNN(KD) + RNF(KD) + TX2 = TX2 + RNF(KD) + RNN(II-1) = zero + TX1 = EVP(II-1) + ENDIF +! if (lprnt) write(0,*)' tx2=',tx2,' idnm=',idnm,' idn=',idn(idnm) + DO L=KD,K + II = IDH + + IF (L > KD1 .AND. L < II) THEN + RNN(L-1) = RNF(L-1) + TX2 = TX2 + RNN(L-1) + ELSEIF (L >= II .AND. L < IDN(idnm)) THEN + rnn(l) = rns(l) + tx2 = tx2 + rnn(l) + TX1 = TX1 + EVP(L) + ELSEIF (L >= IDN(idnm)) THEN + ETD(L+1) = zero + HOD(L+1) = zero + QOD(L+1) = zero + EVP(L) = zero + RNN(L) = RNF(L) + RNS(L) + TX2 = TX2 + RNN(L) + ENDIF +! if (lprnt) write(0,*)' tx2=',tx2,' L=',L,' rnn=',rnn(l) + ENDDO +! +! For Downdraft case the rain is that falls thru the bottom + + L = KBL + + RNN(L) = RNN(L) + RNB + CLDFRD(L) = TX5 + +! +! Caution !! Below is an adjustment to rain flux to maintain +! conservation of precip! + +! +! if (lprnt) write(0,*)' train=',train,' tx2=',tx2,' tx1=',tx1 + + IF (TX1 > zero) THEN + TX1 = (TRAIN - TX2) / TX1 + ELSE + TX1 = zero + ENDIF + + DO L=KD,K + EVP(L) = EVP(L) * TX1 + ENDDO + + ENDIF ! if (.not. DDFT) loop endif +! +!*********************************************************************** +!*********************************************************************** + + RETURN + END + + SUBROUTINE QSATCN(TT,P,Q,DQDT) +! SUBROUTINE QSATCN(TT,P,Q,DQDT,lprnt) + + USE MACHINE , ONLY : kind_phys + USE FUNCPHYS , ONLY : fpvs + USE PHYSCONS, RV => con_RV, CVAP => con_CVAP, CLIQ => con_CLIQ & + &, CSOL => con_CSOL, TTP => con_TTP, HVAP => con_HVAP & + &, HFUS => con_HFUS, EPS => con_eps & + &, EPSM1 => con_epsm1 + implicit none +! + real(kind=kind_phys) TT, P, Q, DQDT +! + real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & + &, ONE_M10=1.E-10 & + &, rvi=one/rv, facw=CVAP-CLIQ & + &, faci=CVAP-CSOL, hsub=HVAP+HFUS & + &, tmix=TTP-20.0 & + &, DEN=one/(TTP-TMIX) +! logical lprnt +! + real(kind=kind_phys) es, d, hlorv, W +! +! es = 10.0 * fpvs(tt) ! fpvs is in centibars! + es = 0.01 * fpvs(tt) ! fpvs is in Pascals! + D = one / max(p+epsm1*es,ONE_M10) +! + q = MIN(eps*es*D, ONE) +! + W = max(ZERO, min(ONE, (TT - TMIX)*DEN)) + hlorv = ( W * (HVAP + FACW * (tt-ttp)) & + & + (one-W) * (HSUB + FACI * (tt-ttp)) ) * RVI + dqdt = p * q * hlorv * D / (tt*tt) +! + return + end + + SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) + USE MACHINE , ONLY : kind_phys +! use module_ras , only : refp, refr, tlac, plac, tlbpl, drdp + implicit none + + real(kind=kind_phys) PRES, ALM, AL2, TLA, TEM +! + integer i +! + IF (TLA < 0.0) THEN + IF (PRES <= PLAC(1)) THEN + TLA = TLAC(1) + ELSEIF (PRES <= PLAC(2)) THEN + TLA = TLAC(2) + (PRES-PLAC(2))*tlbpl(1) + ELSEIF (PRES <= PLAC(3)) THEN + TLA = TLAC(3) + (PRES-PLAC(3))*tlbpl(2) + ELSEIF (PRES <= PLAC(4)) THEN + TLA = TLAC(4) + (PRES-PLAC(4))*tlbpl(3) + ELSEIF (PRES <= PLAC(5)) THEN + TLA = TLAC(5) + (PRES-PLAC(5))*tlbpl(4) + ELSEIF (PRES <= PLAC(6)) THEN + TLA = TLAC(6) + (PRES-PLAC(6))*tlbpl(5) + ELSEIF (PRES <= PLAC(7)) THEN + TLA = TLAC(7) + (PRES-PLAC(7))*tlbpl(6) + ELSEIF (PRES <= PLAC(8)) THEN + TLA = TLAC(8) + (PRES-PLAC(8))*tlbpl(7) + ELSE + TLA = TLAC(8) + ENDIF + ENDIF + IF (PRES >= REFP(1)) THEN + TEM = REFR(1) + ELSEIF (PRES >= REFP(2)) THEN + TEM = REFR(1) + (PRES-REFP(1)) * drdp(1) + ELSEIF (PRES >= REFP(3)) THEN + TEM = REFR(2) + (PRES-REFP(2)) * drdp(2) + ELSEIF (PRES >= REFP(4)) THEN + TEM = REFR(3) + (PRES-REFP(3)) * drdp(3) + ELSEIF (PRES >= REFP(5)) THEN + TEM = REFR(4) + (PRES-REFP(4)) * drdp(4) + ELSEIF (PRES >= REFP(6)) THEN + TEM = REFR(5) + (PRES-REFP(5)) * drdp(5) + ELSE + TEM = REFR(6) + ENDIF +! + tem = 2.0E-4 / tem + al2 = min(4.0*tem, max(alm, tem)) +! + RETURN + END + SUBROUTINE SETQRP + USE MACHINE , ONLY : kind_phys +! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB,one + implicit none + + real(kind=kind_phys) tem2,tem1,x,xinc,xmax,xmin + integer jx +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! XMIN = 1.0E-6 + XMIN = 0.0 + XMAX = 5.0 + XINC = (XMAX-XMIN)/(NQRP-1) + C2XQRP = one / XINC + C1XQRP = one - XMIN*C2XQRP + TEM1 = 0.001 ** 0.2046 + TEM2 = 0.001 ** 0.525 + DO JX=1,NQRP + X = XMIN + (JX-1)*XINC + TBQRP(JX) = X ** 0.1364 + TBQRA(JX) = TEM1 * X ** 0.2046 + TBQRB(JX) = TEM2 * X ** 0.525 + ENDDO +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + END + FUNCTION QRPF(QRP) +! + USE MACHINE , ONLY : kind_phys +! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB, one + implicit none + + real(kind=kind_phys) QRP, QRPF, XJ, REAL_NQRP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NQRP = REAL(NQRP) + XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),REAL_NQRP) +! XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),FLOAT(NQRP)) + JX = MIN(XJ,NQRP-ONE) + QRPF = TBQRP(JX) + (XJ-JX) * (TBQRP(JX+1)-TBQRP(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + END + SUBROUTINE QRABF(QRP,QRAF,QRBF) + USE MACHINE , ONLY : kind_phys +! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB, one + implicit none +! + real(kind=kind_phys) QRP, QRAF, QRBF, XJ, REAL_NQRP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NQRP = REAL(NQRP) + XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),REAL_NQRP) + JX = MIN(XJ,NQRP-ONE) + XJ = XJ - JX + QRAF = TBQRA(JX) + XJ * (TBQRA(JX+1)-TBQRA(JX)) + QRBF = TBQRB(JX) + XJ * (TBQRB(JX+1)-TBQRB(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + END + SUBROUTINE SETVTP + USE MACHINE , ONLY : kind_phys +! use module_ras , only : NVTP,C1XVTP,C2XVTP,TBVTP + implicit none + + real(kind=kind_phys), parameter :: vtpexp=-0.3636, one=1.0 + real(kind=kind_phys) xinc,x,xmax,xmin + integer jx +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + XMIN = 0.05 + XMAX = 1.5 + XINC = (XMAX-XMIN)/(NVTP-1) + C2XVTP = one / XINC + C1XVTP = one - XMIN*C2XVTP + DO JX=1,NVTP + X = XMIN + (JX-1)*XINC + TBVTP(JX) = X ** VTPEXP + ENDDO +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + END + FUNCTION VTPF(ROR) +! + USE MACHINE , ONLY : kind_phys +! use module_ras , only : NVTP,C1XVTP,C2XVTP,TBVTP, one + implicit none + real(kind=kind_phys) ROR, VTPF, XJ, REAL_NVTP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NVTP = REAL(NVTP) + XJ = MIN(MAX(C1XVTP+C2XVTP*ROR,ONE),REAL_NVTP) + JX = MIN(XJ,NVTP-ONE) + VTPF = TBVTP(JX) + (XJ-JX) * (TBVTP(JX+1)-TBVTP(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + END + FUNCTION CLF(PRATE) +! + USE MACHINE , ONLY : kind_phys + implicit none + real(kind=kind_phys) PRATE, CLF +! + real (kind=kind_phys), parameter :: ccf1=0.30, ccf2=0.09 & + &, ccf3=0.04, ccf4=0.01 & + &, pr1=1.0, pr2=5.0 & + &, pr3=20.0 +! + if (prate < pr1) then + clf = ccf1 + elseif (prate < pr2) then + clf = ccf2 + elseif (prate < pr3) then + clf = ccf3 + else + clf = ccf4 + endif +! + RETURN + END diff --git a/physics/rascnv.meta b/physics/rascnv.meta new file mode 100644 index 000000000..022871ec6 --- /dev/null +++ b/physics/rascnv.meta @@ -0,0 +1,611 @@ +[ccpp-arg-table] + name = rascnv_init + type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F + +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F +######################################################################## +[ccpp-arg-table] + name = rascnv_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## + +[ccpp-arg-table] + name = rascnvcnv_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[k] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtf] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rannum] + standard_name = random_numbers + long_name = random numbers time step + units = count + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tin] + standard_name = air_temperature_updated_by_physics + long_name = updated temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qin] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = updated vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[uin] + standard_name = x_wind_updated_by_physics + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[vin] + standard_name = y_wind_updated_by_physics + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ccin] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[trac] + standard_name = number_tracers + long_name = number on tracers transported by convection + units = count + dimensions = () + type = integer + intent = in + optional = F +[fscav] + standard_name = coefficients_for_aerosol_scavenging + long_name = array of aerosol scavenging coefficients + units = none + dimensions = (number_of_chemical_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = interface_air_pressure + long_name = layer interface pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = count + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsik] + standard_name = interface_exner_function + long_name = layer interface exner function + units = count + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = layer_exner_function + long_name = mean layer exner function + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = layer_geopotential + long_name = layer geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = interface_geopotential + long_name = layer interface geopotential + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_pbl_top + long_name = index for pbl top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[cdrag] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rainc] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F + +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = index for cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F + +[ddvel] + standard_name = downdraft_induced_surface_wind + long_name = downdraft induced surface wind + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F + +[flipv] + standard_name = flag_flip + long_name = vertical flip logical + units = flag + dimensions = () + type = logical + intent = in + optional = F + +[facmb] + standard_name = pressure_conversion_factor + long_name = conversion factor from input pressure to hPa + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F + +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F + +[garea] + standard_name = cell_area + long_name = grid cell area + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F + +[ccwfac] + standard_name = critical_work_function_factor + long_name = factor mupltiplying critical work function + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F + +[nrcm] + standard_name = number_of_random_numbers + long_name = number of random numbers + units = none + dimensions = () + type = integer + intent = in + optional = F + +[rhc] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F + +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F + +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F + +[det_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * delt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F + +[c00] + standard_name = rain_auto_conversion_coefficient + long_name = rain auto conversion coefficient + long_name = convective rain conversion parameter for deep conv. + units = m-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F + +[qw0] + standard_name = liquid_water_threshold_in_autoconversion + long_name = liquid water threshold in autoconversion + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F + +[c00i] + standard_name = snow_auto_conversion_coefficient + long_name = snow auto conversion coefficient + units = m-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F + +[qi0] + standard_name = ice_water_threshold_in_autoconversion + long_name = iice water threshold in autoconversion + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F + +[dlqfac] + standard_name = condensate_fraction_detrained_in_updraft_layer + long_name = condensate fraction detrained with in a updraft layer + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F + +[lprnt] + standard_name = flag_debug_print + long_name = debug print logical + units = flag + dimensions = () + type = logical + intent = in + optional = F + +[ipr] + standard_name = horizontal_grid_index + long_name = horizontal grid index + units = count + dimensions = () + type = integer + intent = in + optional = F + +[kdt] + standard_name = htime_step + long_name = current time step + units = count + dimensions = () + type = integer + intent = in + optional = F + +[revap] + standard_name = flag_rain_revap + long_name = rain reevaporation logical + units = flag + dimensions = () + type = logical + intent = in + optional = F + + + +[qlcn] + standard_name = mass_fraction_of_convective_cloud_liquid_water + long_name = mass fraction of convective cloud liquid water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qicn] + standard_name = mass_fraction_of_convective_cloud_ice + long_name = mass fraction of convective cloud ice water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[w_upi] + standard_name = vertical_velocity_for_updraft + long_name = vertical velocity for updraft + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cf_upi] + standard_name = convective_cloud_fraction_for_microphysics + long_name = convective cloud fraction for microphysics + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_mfd] + standard_name = detrained_mass_flux + long_name = detrained mass flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_dqldt] + standard_name = tendency_of_cloud_water_due_to_convective_microphysics + long_name = tendency of cloud water due to convective microphysics + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clcn] + standard_name = convective_cloud_volume_fraction + long_name = convective cloud volume fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_fice] + standard_name = ice_fraction_in_convective_tower + long_name = ice fraction in convective tower + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_ndrop] + standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment + long_name = droplet number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_nice] + standard_name = number_concentration_of_ice_crystals_for_detrainment + long_name = crystal number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[mp_phys] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[mp_phys_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[trcmin] + standard_name = floor_value_for_tracers + long_name = minimum tracet value + units = kgkg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ntk] + standard_name = index_of_location_turbulent_kinetic_energy + long_name = index of turbulent kinetic energy location + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F From e071bcd7af21ab2ad6b847b0d2519eab598818d7 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 21 Oct 2019 16:49:13 +0000 Subject: [PATCH 03/24] updating rascnv.meta --- physics/rascnv.meta | 29 ++--------------------------- 1 file changed, 2 insertions(+), 27 deletions(-) diff --git a/physics/rascnv.meta b/physics/rascnv.meta index 022871ec6..ee27a6c16 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -9,7 +9,6 @@ type = integer intent = in optional = F - [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -27,6 +26,7 @@ type = integer intent = out optional = F + ######################################################################## [ccpp-arg-table] name = rascnv_finalize @@ -50,9 +50,8 @@ optional = F ######################################################################## - [ccpp-arg-table] - name = rascnvcnv_run + name = rascnv_run type = scheme [im] standard_name = horizontal_loop_extent @@ -247,7 +246,6 @@ kind = kind_phys intent = out optional = F - [kbot] standard_name = vertical_index_at_cloud_base long_name = index for cloud base @@ -272,7 +270,6 @@ type = integer intent = inout optional = F - [ddvel] standard_name = downdraft_induced_surface_wind long_name = downdraft induced surface wind @@ -282,7 +279,6 @@ kind = kind_phys intent = out optional = F - [flipv] standard_name = flag_flip long_name = vertical flip logical @@ -291,7 +287,6 @@ type = logical intent = in optional = F - [facmb] standard_name = pressure_conversion_factor long_name = conversion factor from input pressure to hPa @@ -301,7 +296,6 @@ kind = kind_phys intent = in optional = F - [me] standard_name = mpi_rank long_name = current MPI-rank @@ -310,7 +304,6 @@ type = integer intent = in optional = F - [garea] standard_name = cell_area long_name = grid cell area @@ -320,7 +313,6 @@ kind = kind_phys intent = in optional = F - [ccwfac] standard_name = critical_work_function_factor long_name = factor mupltiplying critical work function @@ -330,7 +322,6 @@ kind = kind_phys intent = in optional = F - [nrcm] standard_name = number_of_random_numbers long_name = number of random numbers @@ -339,7 +330,6 @@ type = integer intent = in optional = F - [rhc] standard_name = critical_relative_humidity long_name = critical relative humidity @@ -349,7 +339,6 @@ kind = kind_phys intent = in optional = F - [ud_mf] standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt @@ -359,7 +348,6 @@ kind = kind_phys intent = out optional = F - [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -369,7 +357,6 @@ kind = kind_phys intent = out optional = F - [det_mf] standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt @@ -379,7 +366,6 @@ kind = kind_phys intent = out optional = F - [c00] standard_name = rain_auto_conversion_coefficient long_name = rain auto conversion coefficient @@ -390,7 +376,6 @@ kind = kind_phys intent = in optional = F - [qw0] standard_name = liquid_water_threshold_in_autoconversion long_name = liquid water threshold in autoconversion @@ -400,7 +385,6 @@ kind = kind_phys intent = in optional = F - [c00i] standard_name = snow_auto_conversion_coefficient long_name = snow auto conversion coefficient @@ -410,7 +394,6 @@ kind = kind_phys intent = in optional = F - [qi0] standard_name = ice_water_threshold_in_autoconversion long_name = iice water threshold in autoconversion @@ -420,7 +403,6 @@ kind = kind_phys intent = in optional = F - [dlqfac] standard_name = condensate_fraction_detrained_in_updraft_layer long_name = condensate fraction detrained with in a updraft layer @@ -430,7 +412,6 @@ kind = kind_phys intent = in optional = F - [lprnt] standard_name = flag_debug_print long_name = debug print logical @@ -439,7 +420,6 @@ type = logical intent = in optional = F - [ipr] standard_name = horizontal_grid_index long_name = horizontal grid index @@ -448,7 +428,6 @@ type = integer intent = in optional = F - [kdt] standard_name = htime_step long_name = current time step @@ -457,7 +436,6 @@ type = integer intent = in optional = F - [revap] standard_name = flag_rain_revap long_name = rain reevaporation logical @@ -466,9 +444,6 @@ type = logical intent = in optional = F - - - [qlcn] standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water From 2b42c9eaaa71206ce68d088066a507c085c10052 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 22 Oct 2019 00:45:16 +0000 Subject: [PATCH 04/24] addingarg_table_rascnv-run to rascnv.F90 --- physics/rascnv.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 602e1cc94..a68b96998 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -267,6 +267,9 @@ end subroutine rascnv_finalize ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! \section arg_table_rascnv_run Argument Table +!! \htmlinclude rascnv_run.html +!! subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & &, tin, qin, uin, vin, ccin, trac, fscav& &, prsi, prsl, prsik, prslk, phil, phii & From 42997f3a0fe1edfcc63a972701471d4bd9243f48 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 23 Oct 2019 18:22:25 +0000 Subject: [PATCH 05/24] updating rascnv.F90 and rascnv.meta --- physics/rascnv.F90 | 200 ++++++++++++++++++++++---------------------- physics/rascnv.meta | 45 +++++----- 2 files changed, 121 insertions(+), 124 deletions(-) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index a68b96998..f4834cdb8 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -2,8 +2,6 @@ !! This file contains the entire Relaxed Arakawa-Schubert convection !! parameteriztion -!> This module contains the CCPP-compliant scale-aware mass-flux deep -!! convection scheme. module rascnv USE machine , ONLY : kind_phys @@ -13,6 +11,7 @@ module rascnv implicit none public :: rascnv_init, rascnv_run, rascnv_finalize private + logical :: is_initialized = .False. ! integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s @@ -140,39 +139,38 @@ subroutine rascnv_init(me, errmsg, errflg) ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (first) then + if (is_initialized) return ! set critical workfunction arrays - ACTOP = ACTP*FACM - DO L=1,15 - A(L) = A(L)*FACM - ENDDO - DO L=2,15 - TEM = one / (PH(L) - PH(L-1)) - AC(L) = (PH(L)*A(L-1) - PH(L-1)*A(L)) * TEM - AD(L) = (A(L) - A(L-1)) * TEM - ENDDO - AC(1) = ACTOP - AC(16) = A(15) - AD(1) = zero - AD(16) = zero + ACTOP = ACTP*FACM + DO L=1,15 + A(L) = A(L)*FACM + ENDDO + DO L=2,15 + TEM = one / (PH(L) - PH(L-1)) + AC(L) = (PH(L)*A(L-1) - PH(L-1)*A(L)) * TEM + AD(L) = (A(L) - A(L-1)) * TEM + ENDDO + AC(1) = ACTOP + AC(16) = A(15) + AD(1) = zero + AD(16) = zero ! - CALL SETQRP - CALL SETVTP + CALL SETQRP + CALL SETVTP ! - do i=1,7 - tlbpl(i) = (tlac(i)-tlac(i+1)) / (plac(i)-plac(i+1)) - enddo - do i=1,5 - drdp(i) = (REFR(i+1)-REFR(i)) / (REFP(i+1)-REFP(i)) - enddo + do i=1,7 + tlbpl(i) = (tlac(i)-tlac(i+1)) / (plac(i)-plac(i+1)) + enddo + do i=1,5 + drdp(i) = (REFR(i+1)-REFR(i)) / (REFP(i+1)-REFP(i)) + enddo ! -! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 +! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 ! - if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & + if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & &, ' DETRAINING AT NORMALIZED PRESSURE ABOVE ',DPD ! - first = .false. - endif + is_initialized = .true. ! end subroutine rascnv_init @@ -192,79 +190,79 @@ subroutine rascnv_finalize (errmsg, errflg) errflg = 0 end subroutine rascnv_finalize -! -! -! ===================================================================== ! -! rascnv_run: ! -! ! -! program history log: ! -! Oct 2019 -- shrinivas moorthi ! -! ! -! ! -! ==================== defination of variables ==================== -! ! -! ! -! inputs: size -! ! -! im - integer, horiz dimension and num of used pts 1 ! -! ix - integer, maximum horiz dimension 1 ! -! k - integer, vertical dimension 1 ! -! dt - real, time step in seconds 1 ! -! dtf - real, dynamics time step in seconds 1 ! -! rannum - real, array holding random numbers between 0 an 1 (ix,nrcm) ! -! tin - real, input temperature (K) -! qin - real, input specific humidity (kg/kg) -! uin - real, input zonal wind component -! vin - real, input meridional wind component -! ccin - real, input condensates+tracers -! fscav - real -! prsi - real, layer interface pressure -! prsl - real, layer mid pressure -! prsik - real, layer interface Exner function -! prslk - real, layer mid Exner function -! phil - real, layer mid geopotential height -! phii - real, layer interface geopotential height -! kpbl - integer pbl top index -! cdrag - real, drag coefficient -! rainc - real, convectinve rain (m/sec) -! kbot - integer, cloud bottom index -! ktop - integer, cloud top index -! knv - integer, 0 - no convvection; 1 - convection -! ddvel - downdraft induced surface wind -! flipv - logical, true if input data from bottom to top -! facmb - real, factor bewteen input pressure and hPa -! me - integer, current pe number -! garea - real, grid area -! ccwfac - real, grid area -! nrcm - integer, number of random numbers at each grid point -! rhc - real, critical relative humidity -! ud_mf - real, updraft mass flux -! dd_mf - real, downdraft mass flux -! det_mf - real, detrained mass flux -! c00 - real, auto convection coefficient for rain -! qw0 - real, min cloud water before autoconversion -! c00i - real, auto convection coefficient for snow -! qi0 - real, min cloud ice before autoconversion -! dlqfac - real,fraction of condensated detrained in layers -! lprnt - logical, true for debug print -! ipr - integer, horizontal grid point to print when lprnt=true -! kdt - integer, current teime step -! revap - logial, when true reevaporate falling rain/snow -! qlcn - real -! qicn - real -! w_upi - real -! cf_upi - real -! cnv_mfd - real -! cnv_dqldt- real -! clcn - real -! cnv_fice - real -! cnv_ndrop- real -! cnv_nice - real -! mp_phys - integer, microphysics option -! mp_phys_mg - integer, flag for MG microphysics option -! trcmin - real, floor value for tracers -! ntk - integer, index representing TKE in the tracer array -! +!! +!! +!!===================================================================== ! +!! rascnv_run: ! +!! ! +!! program history log: ! +!! Oct 2019 -- shrinivas moorthi ! +!! ! +!! ! +!! ==================== defination of variables ==================== +!! ! +!! ! +!! inputs: size +!! ! +!! im - integer, horiz dimension and num of used pts 1 ! +!! ix - integer, maximum horiz dimension 1 ! +!! k - integer, vertical dimension 1 ! +!! dt - real, time step in seconds 1 ! +!! dtf - real, dynamics time step in seconds 1 ! +!! rannum - real, array holding random numbers between 0 an 1 (ix,nrcm) ! +!! tin - real, input temperature (K) +!! qin - real, input specific humidity (kg/kg) +!! uin - real, input zonal wind component +!! vin - real, input meridional wind component +!! ccin - real, input condensates+tracers +!! fscav - real +!! prsi - real, layer interface pressure +!! prsl - real, layer mid pressure +!! prsik - real, layer interface Exner function +!! prslk - real, layer mid Exner function +!! phil - real, layer mid geopotential height +!! phii - real, layer interface geopotential height +!! kpbl - integer pbl top index +!! cdrag - real, drag coefficient +!! rainc - real, convectinve rain (m/sec) +!! kbot - integer, cloud bottom index +!! ktop - integer, cloud top index +!! knv - integer, 0 - no convvection; 1 - convection +!! ddvel - downdraft induced surface wind +!! flipv - logical, true if input data from bottom to top +!! facmb - real, factor bewteen input pressure and hPa +!! me - integer, current pe number +!! garea - real, grid area +!! ccwfac - real, grid area +!! nrcm - integer, number of random numbers at each grid point +!! rhc - real, critical relative humidity +!! ud_mf - real, updraft mass flux +!! dd_mf - real, downdraft mass flux +!! det_mf - real, detrained mass flux +!! c00 - real, auto convection coefficient for rain +!! qw0 - real, min cloud water before autoconversion +!! c00i - real, auto convection coefficient for snow +!! qi0 - real, min cloud ice before autoconversion +!! dlqfac - real,fraction of condensated detrained in layers +!! lprnt - logical, true for debug print +!! ipr - integer, horizontal grid point to print when lprnt=true +!! kdt - integer, current teime step +!! revap - logial, when true reevaporate falling rain/snow +!! qlcn - real +!! qicn - real +!! w_upi - real +!! cf_upi - real +!! cnv_mfd - real +!! cnv_dqldt- real +!! clcn - real +!! cnv_fice - real +!! cnv_ndrop- real +!! cnv_nice - real +!! mp_phys - integer, microphysics option +!! mp_phys_mg - integer, flag for MG microphysics option +!! trcmin - real, floor value for tracers +!! ntk - integer, index representing TKE in the tracer array +!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! \section arg_table_rascnv_run Argument Table diff --git a/physics/rascnv.meta b/physics/rascnv.meta index ee27a6c16..7d93886c0 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -96,10 +96,10 @@ intent = in optional = F [rannum] - standard_name = random_numbers - long_name = random numbers time step - units = count - dimensions = () + standard_name = random_number_array + long_name = random number array (0-1) + units = none + dimensions = (horizontal_dimension,array_dimension_of_random_number) type = real kind = kind_phys intent = in @@ -178,7 +178,7 @@ [prsl] standard_name = air_pressure long_name = mean layer pressure - units = count + units = Pa dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -187,7 +187,7 @@ [prsik] standard_name = interface_exner_function long_name = layer interface exner function - units = count + units = ratio dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -196,7 +196,7 @@ [prslk] standard_name = layer_exner_function long_name = mean layer exner function - units = Pa + units = ratio dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -290,7 +290,7 @@ [facmb] standard_name = pressure_conversion_factor long_name = conversion factor from input pressure to hPa - units = none + units = ratio dimensions = () type = real kind = kind_phys @@ -325,7 +325,7 @@ [nrcm] standard_name = number_of_random_numbers long_name = number of random numbers - units = none + units = count dimensions = () type = integer intent = in @@ -333,7 +333,7 @@ [rhc] standard_name = critical_relative_humidity long_name = critical relative humidity - units = none + units = frac dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -341,7 +341,7 @@ optional = F [ud_mf] standard_name = instantaneous_atmosphere_updraft_convective_mass_flux - long_name = (updraft mass flux) * delt + long_name = (updraft mass flux) * dt units = kg m-2 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -350,7 +350,7 @@ optional = F [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux - long_name = (downdraft mass flux) * delt + long_name = (downdraft mass flux) * dt units = kg m-2 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -359,7 +359,7 @@ optional = F [det_mf] standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux - long_name = (detrainment mass flux) * delt + long_name = (detrainment mass flux) * dt units = kg m-2 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -369,7 +369,6 @@ [c00] standard_name = rain_auto_conversion_coefficient long_name = rain auto conversion coefficient - long_name = convective rain conversion parameter for deep conv. units = m-1 dimensions = (horizontal_dimension) type = real @@ -396,7 +395,7 @@ optional = F [qi0] standard_name = ice_water_threshold_in_autoconversion - long_name = iice water threshold in autoconversion + long_name = ice water threshold in autoconversion units = kg kg-1 dimensions = (horizontal_dimension) type = real @@ -429,9 +428,9 @@ intent = in optional = F [kdt] - standard_name = htime_step - long_name = current time step - units = count + standard_name = index_of_time_step + long_name = current time step index + units = index dimensions = () type = integer intent = in @@ -552,17 +551,17 @@ optional = F [trcmin] standard_name = floor_value_for_tracers - long_name = minimum tracet value - units = kgkg-1 + long_name = minimum tracer value + units = kg kg-1 dimensions = () type = real kind = kind_phys intent = in optional = F [ntk] - standard_name = index_of_location_turbulent_kinetic_energy - long_name = index of turbulent kinetic energy location - units = flag + standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer + long_name = index for turbulent kinetic energy in the convectively transported tracer array + units = index dimensions = () type = integer intent = in From de0058a2d40edb98b47be3eaf7cd42db6f535af9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 28 Oct 2019 17:25:36 +0000 Subject: [PATCH 06/24] modifying rascvnv and GFS_suite_interstitial to include ras convection parameterization --- physics/GFS_suite_interstitial.F90 | 6 +- physics/GFS_suite_interstitial.meta | 8 + physics/rascnv.F90 | 490 ++++++++++++++-------------- physics/rascnv.meta | 390 +++++++++++----------- 4 files changed, 448 insertions(+), 446 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 6ecc5925f..73b275b04 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -422,7 +422,7 @@ end subroutine GFS_suite_interstitial_3_finalize subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, xlat, gq0, imp_physics, imp_physics_mg, imp_physics_zhao_carr,& imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, prsi, prsl, prslk, rhcbot, & - rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, kinver, & + rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, kinver, ras, & clw, rhc, save_qc, save_qi, errmsg, errflg) use machine, only: kind_phys @@ -434,7 +434,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 integer, dimension(im), intent(in) :: islmsk, kpbl, kinver - logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol + logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras real(kind=kind_phys), intent(in) :: rhcbot, rhcmax, rhcpbl, rhctop real(kind=kind_phys), dimension(im), intent(in) :: work1, work2 @@ -493,7 +493,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr ! endif !*GF - if (cscnv .or. satmedmf .or. trans_trac ) then + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then tracers = 2 do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 91a2c04a4..a97574b99 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1303,6 +1303,14 @@ type = integer intent = in optional = F +[ras] + standard_name = flag_for_ras_deep_convection + long_name = flag for ras convection scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F [clw] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index f4834cdb8..8273bd3af 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -5,9 +5,13 @@ module rascnv USE machine , ONLY : kind_phys - use physcons, grav => con_g, cp => con_cp, alhl => con_hvap& - &, alhf => con_hfus, rgas => con_rd, rkap => con_rocp& - &, nu => con_FVirt, pi => con_pi, t0c => con_t0c + use physcons, grav => con_g, cp => con_cp, alhl => con_hvap& + &, alhf => con_hfus, rgas => con_rd, rkap => con_rocp& + &, nu => con_FVirt, pi => con_pi, t0c => con_t0c & + &, rv => con_rv, cvap => con_cvap & + &, cliq => con_cliq, csol => con_csol, ttp=> con_ttp & + &, eps => con_eps, epsm1 => con_epsm1 + USE FUNCPHYS , ONLY : fpvs implicit none public :: rascnv_init, rascnv_run, rascnv_finalize private @@ -34,6 +38,7 @@ module rascnv &, ONE_M2=1.E-2, ONE_M1=1.E-1 & &, oneolog10=one/log(10.0) & &, deg2rad=pi/180.d0 & ! conversion factor from degree to radians +! &, pa2mb = 0.01 !& ! conversion factor from Pa to hPa (or mb) &, cmb2pa = 100.0 ! Conversion from hPa to Pa ! real(kind=kind_phys), parameter :: & @@ -59,7 +64,7 @@ module rascnv logical, parameter :: do_aw=.true., cumfrc=.true. & &, updret=.false., vsmooth=.false. & &, wrkfun=.false., crtfun=.true. & - &, calkbl=.true, botop=.true. + &, calkbl=.true., botop=.true., revap=.true. & &, advcld=.true., advups=.false.,advtvd=.true. ! &, advcld=.true., advups=.true., advtvd=.false. ! &, advcld=.true., advups=.false.,advtvd=.false. @@ -99,6 +104,7 @@ module rascnv integer, parameter :: nvtp=10001 real(kind=kind_phys) C1XVTP, C2XVTP, TBVTP(NVTP) ! + real(kind=kind_phys) afc, facdt contains @@ -112,11 +118,12 @@ module rascnv !> \section arg_table_rascnv_init Argument Table !! \htmlinclude rascnv_init.html !! - subroutine rascnv_init(me, errmsg, errflg) + subroutine rascnv_init(me, dt, errmsg, errflg) ! Implicit none ! integer, intent(in) :: me + real(kind=kind_phys), intent(in) :: dt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -167,6 +174,8 @@ subroutine rascnv_init(me, errmsg, errflg) ! ! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 ! + AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 + if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & &, ' DETRAINING AT NORMALIZED PRESSURE ABOVE ',DPD ! @@ -230,18 +239,15 @@ end subroutine rascnv_finalize !! knv - integer, 0 - no convvection; 1 - convection !! ddvel - downdraft induced surface wind !! flipv - logical, true if input data from bottom to top -!! facmb - real, factor bewteen input pressure and hPa !! me - integer, current pe number -!! garea - real, grid area -!! ccwfac - real, grid area +!! area - real, grid area +!! ccwf - real, multiplication factor for critical workfunction !! nrcm - integer, number of random numbers at each grid point !! rhc - real, critical relative humidity !! ud_mf - real, updraft mass flux !! dd_mf - real, downdraft mass flux -!! det_mf - real, detrained mass flux -!! c00 - real, auto convection coefficient for rain +!! dt_mf - real, detrained mass flux !! qw0 - real, min cloud water before autoconversion -!! c00i - real, auto convection coefficient for snow !! qi0 - real, min cloud ice before autoconversion !! dlqfac - real,fraction of condensated detrained in layers !! lprnt - logical, true for debug print @@ -268,19 +274,19 @@ end subroutine rascnv_finalize !! \section arg_table_rascnv_run Argument Table !! \htmlinclude rascnv_run.html !! - subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & - &, tin, qin, uin, vin, ccin, trac, fscav& - &, prsi, prsl, prsik, prslk, phil, phii & - &, KPBL, CDRAG, RAINC, kbot, ktop, kcnv & - &, DDVEL, FLIPV, facmb, me, garea, ccwfac & - &, nrcm, rhc, ud_mf, dd_mf, det_mf & - &, c00, qw0, c00i, qi0, dlqfac & - &, lprnt, ipr, kdt, revap & - &, QLCN, QICN, w_upi, cf_upi, CNV_MFD & - &, CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE & - &, mp_phys, mp_phys_mg, trcmin, ntk & - &, errmsg, errflg) -! &, lprnt, ipr, kdt, fscav, ctei_r, ctei_rm) + subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & + &, ccwf, area, dxmin, dxinv & + &, psauras, prauras, wminras, dlqf, flipv & + &, me, rannum, nrcm, mp_phys, mp_phys_mg & + &, ntk, lprnt, ipr, kdt, rhc & +! &, ntk, lprnt, ipr, kdt, trcmin, rhc & + &, tin, qin, uin, vin, ccin, fscav & + &, prsi, prsl, prsik, prslk, phil, phii & + &, KPBL, CDRAG, RAINC, kbot, ktop, kcnv & + &, DDVEL, ud_mf, dd_mf, dt_mf & + &, QLCN, QICN, w_upi, cf_upi, CNV_MFD & + &, CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE & + &, errmsg, errflg) ! !********************************************************************* !********************************************************************* @@ -298,39 +304,40 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & !********************************************************************* ! ! - USE MACHINE , ONLY : kind_phys Implicit none ! LOGICAL FLIPV, lprnt,revap ! ! input ! -! Integer IM, IX, k, ncrnd, me, trac, ipr, nrcm, mp_phys, kdt - Integer IM, IX, k, ncrnd, me, trac, ipr, nrcm, mp_phys, kdt,ntk - integer, dimension(im) :: kbot, ktop, kcnv, kpbl, mg_phys_mg + integer, intent(in) :: im, ix, k, ntr, me, nrcm, ntk, ipr & + &, kdt, mp_phys, mp_phys_mg + integer, dimension(im) :: kbot, ktop, kcnv, kpbl +! + real(kind=kind_phys), intent(in) :: dxmin, dxinv, ccwf(2) & + &, psauras(2), prauras(2) & + &, wminras(2), dlqf(2) ! real(kind=kind_phys), dimension(ix,k) :: tin, qin, uin, vin & &, prsl, prslk, phil real(kind=kind_phys), dimension(ix,k+1) :: prsi, prsik, phii - real(kind=kind_phys), dimension(im,k) :: ud_mf, dd_mf, det_mf & + real(kind=kind_phys), dimension(im,k) :: ud_mf, dd_mf, dt_mf & &, rhc, qlcn, qicn, w_upi & &, cnv_mfd & -! &, cnv_mfd, cnv_prc3 & &, cnv_dqldt, clcn & &, cnv_fice, cnv_ndrop & &, cnv_nice, cf_upi - real(kind=kind_phys), dimension(im) :: ccwfac, rainc, cdrag & - &, ddvel, garea & - &, c00, c00i, dlqfac + real(kind=kind_phys), dimension(im) :: area, cdrag & + &, rainc, ddvel real(kind=kind_phys), dimension(ix,nrcm):: rannum - real(kind=kind_phys) ccin(ix,k,trac+2) - real(kind=kind_phys) trcmin(trac+2) + real(kind=kind_phys) ccin(ix,k,ntr+2) + real(kind=kind_phys) trcmin(ntr+2) - real(kind=kind_phys) DT, facmb, dtf, qw0, qi0 + real(kind=kind_phys) DT, dtf, qw0, qi0 ! ! Added for aerosol scavenging for GOCART ! - real(kind=kind_phys), intent(in) :: fscav(trac) + real(kind=kind_phys), intent(in) :: fscav(ntr) ! &, ctei_r(im), ctei_rm character(len=*), intent(out) :: errmsg @@ -341,7 +348,7 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & real(kind=kind_phys), dimension(k) :: toi, qoi, tcu, qcu & &, pcu, clw, cli, qii, qli& &, phi_l, prsm,psjm & - &, alfinq, alfind, rhc_l + &, alfinq, alfind, rhc_l & &, qoi_l, qli_l, qii_l real(kind=kind_phys), dimension(k+1) :: prs, psj, phi_h, flx, flxd @@ -349,18 +356,18 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & integer, dimension(100) :: ic real(kind=kind_phys), parameter :: clwmin=1.0e-10 ! - real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) + real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) & &, trcfac(:,:), rcu(:,:) real(kind=kind_phys) dtvd(2,4) ! &, DPI(K) - real(kind=kind_phys) CFAC, TEM, sgc, ccwf, tem1, tem2, rain & + real(kind=kind_phys) CFAC, TEM, sgc, ccwfac, tem1, tem2, rain & &, wfnc,tla,pl,qiid,qlid, c0, c0i, dlq_fac, sumq& - &, rainp, facdt + &, rainp ! Integer KCR, KFX, NCMX, NC, KTEM, I, L, lm1 & &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & - &, kblmn, ksfc + &, kblmn, ksfc, ncrnd real(kind=kind_phys) sgcs(k,im) ! LOGICAL lprint @@ -368,14 +375,16 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ! ! Scavenging related parameters ! - real fscav_(trac+2) ! Fraction scavenged per km + real fscav_(ntr+2) ! Fraction scavenged per km ! fscav_ = zero ! By default no scavenging - if (trac > 0) then - do i=1,trac + if (ntr > 0) then + do i=1,ntr fscav_(i) = fscav(i) enddo endif + trcmin = -99999.0 + if (ntk-2 > 0) trcmin(ntk-2) = 1.0d-4 !> - Initialize CCPP error handling variables @@ -383,9 +392,8 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & errflg = 0 ! if (me == 0) write(0,*)' rann=',rannum(1,:),' kdt=',kdt -! if (lprnt) write(0,*)' in RAS fscav=',fscav_,' ccwfac=', -! & ccwfac(ipr),' mp_phys=',mp_phys -! &, ' fscav=',fscav,' trac=',trac +! if (lprnt) write(0,*)' in RAS fscav=',fscav_, ' mp_phys=',mp_phys & +! &, ' fscav=',fscav,' ntr=',ntr ! km1 = k - 1 kp1 = k + 1 @@ -395,7 +403,7 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ksfc = kp1 endif ! - ntrc = trac + ntrc = ntr IF (CUMFRC) THEN ntrc = ntrc + 2 ENDIF @@ -434,24 +442,26 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ! ! call set_ras_afc(dt) ! AFC = -(1.04E-4*DT)*(3600./DT)**0.578 - AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 +! AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 ! do l=1,k do i=1,im ud_mf(i,l) = zero dd_mf(i,l) = zero - det_mf(i,l) = zero + dt_mf(i,l) = zero enddo enddo DO IPT=1,IM - ccwf = half - if (ccwfac(ipt) >= zero) ccwf = ccwfac(ipt) - - dlq_fac = dlqfac(ipt) + tem1 = (log(area(i)) - dxmin) * dxinv + tem2 = one - tem1 + ccwfac = ccwf(1)*tem1 + ccwf(2)*tem2 + dlq_fac = dlqf(1)*tem1 + dlqf(2)*tem2 tem = one + dlq_fac - c0 = c00(IPT) * tem - c0i = c00i(IPT) * tem + c0i = (psauras(1)*tem1 + psauras(2)*tem2) * tem + c0 = (prauras(1)*tem1 + prauras(2)*tem2) * tem + if (ccwfac == zero) ccwfac = half + ! ! ctei = .false. ! if (ctei_r(ipt) > ctei_rm) ctei = .true. @@ -572,18 +582,18 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & toi(l) = tin(ipt,ll) qoi(l) = qin(ipt,ll) - PRSM(L) = prsl(ipt,ll) * facmb ! facmb is for conversion to MB + PRSM(L) = prsl(ipt,ll) * Pa2mb PSJM(L) = prslk(ipt,ll) phi_l(L) = phil(ipt,ll) rhc_l(L) = rhc(ipt,ll) ! - if (ntrc > trac) then ! CUMFRC is true - uvi(l,trac+1) = uin(ipt,ll) - uvi(l,trac+2) = vin(ipt,ll) + if (ntrc > ntr) then ! CUMFRC is true + uvi(l,ntr+1) = uin(ipt,ll) + uvi(l,ntr+2) = vin(ipt,ll) endif ! - if (trac > 0) then ! tracers such as O3, dust etc - do n=1,trac + if (ntr > 0) then ! tracers such as O3, dust etc + do n=1,ntr uvi(l,n) = ccin(ipt,ll,n+2) if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero enddo @@ -591,7 +601,7 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & enddo do l=1,kp1 ll = kp1 + 1 - l ! Input variables are bottom to top! - PRS(LL) = prsi(ipt,L) * facmb ! facmb is for conversion to MB + PRS(LL) = prsi(ipt,L) * Pa2mb PSJ(LL) = prsik(ipt,L) phi_h(LL) = phii(ipt,L) enddo @@ -621,25 +631,25 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & toi(l) = tin(ipt,l) qoi(l) = qin(ipt,l) - PRSM(L) = prsl(ipt, L) * facmb ! facmb is for conversion to MB + PRSM(L) = prsl(ipt, L) * Pa2mb PSJM(L) = prslk(ipt,L) phi_l(L) = phil(ipt,L) rhc_l(L) = rhc(ipt,L) ! - if (ntrc > trac) then ! CUMFRC is true - uvi(l,trac+1) = uin(ipt,l) - uvi(l,trac+2) = vin(ipt,l) + if (ntrc > ntr) then ! CUMFRC is true + uvi(l,ntr+1) = uin(ipt,l) + uvi(l,ntr+2) = vin(ipt,l) endif ! - if (trac > 0) then ! tracers such as O3, dust etc - do n=1,trac + if (ntr > 0) then ! tracers such as O3, dust etc + do n=1,ntr uvi(l,n) = ccin(ipt,l,n+2) if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero enddo endif enddo DO L=1,kp1 - PRS(L) = prsi(ipt,L) * facmb ! facmb is for conversion to MB + PRS(L) = prsi(ipt,L) * Pa2mb PSJ(L) = prsik(ipt,L) phi_h(L) = phii(ipt,L) ENDDO @@ -776,15 +786,15 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & if (CUMFRC) then do l=krmin,k tem = one - max(pgfbot, min(pgftop, pgftop+pgfgrad*prsm(l))) - trcfac(l,trac+1) = tem - trcfac(l,trac+2) = tem + trcfac(l,ntr+1) = tem + trcfac(l,ntr+2) = tem enddo endif ! ! lprint = lprnt .and. ipt == ipr ! if (lprint) then -! write(0,*)' trcfac=',trcfac(krmin:k,1+trac) +! write(0,*)' trcfac=',trcfac(krmin:k,1+ntr) ! write(0,*)' alfint=',alfint(krmin:k,1) ! write(0,*)' alfinq=',alfint(krmin:k,2) ! write(0,*)' alfini=',alfint(krmin:k,4) @@ -915,13 +925,13 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & &, FRAC, MAX_NEG_BOUY, vsmooth, do_aw & &, REVAP, WRKFUN, CALKBL, CRTFUN, lprint & &, DT, KDT, TLA, DPD & - &, ALFINT, rhfacl, rhfacs, garea(ipt) & - &, ccwf, CDRAG(ipt), trcfac & + &, ALFINT, rhfacl, rhfacs, area(ipt) & + &, ccwfac, CDRAG(ipt), trcfac & &, alfind, rhc_l, phi_l, phi_h, PRS, PRSM,sgcs(1,ipt) & &, TOI, QOI, UVI, QLI, QII, KBL, DDVEL(ipt) & &, TCU, QCU, RCU, PCU, FLX, FLXD, RAIN, WFNC, fscav_ & -! &, trcmin) - &, trcmin, ntk-2, c0, qw0, c0i, qi0, dlq_fac, afc) + &, trcmin, ntk-2, c0, wminras(1), c0i, wminras(2) & + &, dlq_fac) ! &, ctei) ! if(lprint) write(0,*)' uvitkea=',uvi(ib:k,ntk-2),' ib=',ib @@ -951,7 +961,7 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & dd_mf(ipt,ll) = dd_mf(ipt,ll) + flxd(l+1) enddo ll = kp1 - ib - det_mf(ipt,ll) = det_mf(ipt,ll) + flx(ib) + dt_mf(ipt,ll) = dt_mf(ipt,ll) + flx(ib) if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 @@ -965,10 +975,10 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ! CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) ! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt - CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) + flx(ib)* + CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) + flx(ib)* & & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt ! & max(0.,(QLI(ib)+QII(ib)))/dt/3. - if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) + if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & & ,ipt,ll endif @@ -978,7 +988,7 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ud_mf(ipt,l) = ud_mf(ipt,l) + flx(l+1) dd_mf(ipt,l) = dd_mf(ipt,l) + flxd(l+1) enddo - det_mf(ipt,ib) = det_mf(ipt,ib) + flx(ib) + dt_mf(ipt,ib) = dt_mf(ipt,ib) + flx(ib) if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 ! if (lprint) write(0,*)' ib=',ib,' flx=',flx(ib),' ib=',ib @@ -988,10 +998,10 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ! &,' ib=',ib,' kp1=',kp1 ! CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) ! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt - CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* + CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* & & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt ! & max(0.,(QLI(ib)+QII(ib)))/dt/3. - if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) + if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & & ,ipt,ib endif endif @@ -1053,17 +1063,17 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & if (flipv) then do l=1,k ll = kp1 - l - tin(ipt,ll) = toi(l) ! Temperature - qin(ipt,ll) = qoi(l) ! Specific humidity - uin(ipt,ll) = uvi(l,trac+1) ! U momentum - vin(ipt,ll) = uvi(l,trac+2) ! V momentum + tin(ipt,ll) = toi(l) ! Temperature + qin(ipt,ll) = qoi(l) ! Specific humidity + uin(ipt,ll) = uvi(l,ntr+1) ! U momentum + vin(ipt,ll) = uvi(l,ntr+2) ! V momentum !! for 2M microphysics, always output these variables if (mp_phys == 10) then if (advcld) then QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) - CNV_FICE(ipt,ll) = QICN(ipt,ll) + CNV_FICE(ipt,ll) = QICN(ipt,ll) & & / max(1.e-10,QLCN(ipt,ll)+QICN(ipt,ll)) else QLCN(ipt,ll) = qli(l) @@ -1073,18 +1083,18 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & !! CNV_PRC3(ipt,ll) = PCU(l)/dt ! CNV_PRC3(ipt,ll) = zero ! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,ll - cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ + cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ & & 500*ud_mf(ipt,ll)/dt), cfmax)) ! & 500*ud_mf(ipt,ll)/dt), 0.60)) ! if (lprint) write(0,*)' ll=',ll,' cf_upi=',cf_upi(ipt,ll) ! &,' ud_mf=',ud_mf(ipt,ll),' dt=',dt,' cfmax=',cfmax CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft - w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / + w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / & & (dt*max(cf_upi(ipt,ll),1.e-12)*prsl(ipt,ll)) endif - if (trac > 0) then - do n=1,trac + if (ntr > 0) then + do n=1,ntr ccin(ipt,ll,n+2) = uvi(l,n) ! Tracers enddo endif @@ -1114,17 +1124,17 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & else do l=1,k - tin(ipt,l) = toi(l) ! Temperature - qin(ipt,l) = qoi(l) ! Specific humidity - uin(ipt,l) = uvi(l,trac+1) ! U momentum - vin(ipt,l) = uvi(l,trac+2) ! V momentum + tin(ipt,l) = toi(l) ! Temperature + qin(ipt,l) = qoi(l) ! Specific humidity + uin(ipt,l) = uvi(l,ntr+1) ! U momentum + vin(ipt,l) = uvi(l,ntr+2) ! V momentum !! for 2M microphysics, always output these variables if (mp_phys == 10) then if (advcld) then QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) - CNV_FICE(ipt,l) = QICN(ipt,l) + CNV_FICE(ipt,l) = QICN(ipt,l) & & / max(1.e-10,QLCN(ipt,l)+QICN(ipt,l)) else QLCN(ipt,l) = qli(l) @@ -1134,16 +1144,16 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & !! CNV_PRC3(ipt,l) = PCU(l)/dt ! CNV_PRC3(ipt,l) = zero ! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,l - cf_upi(ipt,l) = max(zero,min(0.02*log(one+ + cf_upi(ipt,l) = max(zero,min(0.02*log(one+ & & 500*ud_mf(ipt,l)/dt), cfmax)) ! & 500*ud_mf(ipt,l)/dt), 0.60)) CLCN(ipt,l) = cf_upi(ipt,l) !downdraft is below updraft - w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / + w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / & & (dt*max(cf_upi(ipt,l),1.e-12)*prsl(ipt,l)) endif - if (trac > 0) then - do n=1,trac + if (ntr > 0) then + do n=1,ntr ccin(ipt,l,n+2) = uvi(l,n) ! Tracers enddo endif @@ -1182,11 +1192,11 @@ SUBROUTINE CLOUD( & &, FRACBL, MAX_NEG_BOUY, vsmooth, do_aw & &, REVAP, WRKFUN, CALKBL, CRTFUN, lprnt & &, DT, KDT, TLA, DPD & - &, ALFINT, RHFACL, RHFACS, garea, ccwf, cd, trcfac & + &, ALFINT, RHFACL, RHFACS, area, ccwf, cd, trcfac & &, alfind, rhc_ls, phil, phih, prs, prsm, sgcs & &, TOI, QOI, ROI, QLI, QII, KPBL, DSFC & &, TCU, QCU, RCU, PCU, FLX, FLXD, CUP, WFNC,fscav_ & - &, trcmin, ntk, c0, qw0, c0i, qi0, dlq_fac, afc) + &, trcmin, ntk, c0, qw0, c0i, qi0, dlq_fac) ! &, ctei) ! @@ -1246,36 +1256,35 @@ SUBROUTINE CLOUD( & !===> FLX(K ) UPDATE MASS FLUX @ TOP OF LAYER KG/M^2 !===> CUP UPDATE PRECIPITATION AT THE SURFACE KG/M^2 ! - USE MACHINE , ONLY : kind_phys -! use module_ras IMPLICIT NONE ! - real (kind=kind_phys) :: RHMAX=1.0 ! MAX RELATIVE HUMIDITY - &, QUAD_LAM=1.0 ! MASK FOR QUADRATIC LAMBDA - &, RHRAM=0.05 ! PBL RELATIVE HUMIDITY RAMP -! &, RHRAM=0.15 ! PBL RELATIVE HUMIDITY RAMP - &, HCRITD=4000.0 ! Critical Moist Static Energy for Deep clouds - &, HCRITS=2000.0 ! Critical Moist Static Energy for Shallow clouds - &, pcrit_lcl=250.0 ! Critical pressure difference between boundary layer top - ! layer top and lifting condensation level (hPa) -! &, hpert_fac=1.01 ! Perturbation on hbl when ctei=.true. -! &, hpert_fac=1.005 ! Perturbation on hbl when ctei=.true. - &, qudfac=quad_lam*half, shalfac=3.0 -! &, qudfac=quad_lam*pt25, shalfac=3.0 ! Yogesh's - &, testmb=0.1, testmbi=one/testmb - &, testmboalhl=testmb/alhl - &, c0ifac=0.07 ! following Han et al, 2016 MWR - &, dpnegcr = 150.0 -! &, dpnegcr = 100.0 -! &, dpnegcr = 200.0 + real (kind=kind_phys), parameter :: RHMAX=1.0 & ! MAX RELATIVE HUMIDITY + &, QUAD_LAM=1.0 & ! MASK FOR QUADRATIC LAMBDA + &, RHRAM=0.05 & ! PBL RELATIVE HUMIDITY RAMP +! &, RHRAM=0.15 !& ! PBL RELATIVE HUMIDITY RAMP + &, HCRITD=4000.0 & ! Critical Moist Static Energy for Deep clouds + &, HCRITS=2000.0 & ! Critical Moist Static Energy for Shallow clouds + &, pcrit_lcl=250.0 & ! Critical pressure difference between boundary layer top + ! layer top and lifting condensation level (hPa) +! &, hpert_fac=1.01 !& ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.005 !& ! Perturbation on hbl when ctei=.true. + &, qudfac=quad_lam*half & + &, shalfac=3.0 & +! &, qudfac=quad_lam*pt25, shalfac=3.0 !& ! Yogesh's + &, testmb=0.1, testmbi=one/testmb& + &, testmboalhl=testmb/alhl & + &, c0ifac=0.07 & ! following Han et al, 2016 MWR + &, dpnegcr = 150.0 +! &, dpnegcr = 100.0 +! &, dpnegcr = 200.0 ! real(kind=kind_phys), parameter :: ERRMIN=0.0001 & &, ERRMI2=0.1*ERRMIN & -! &, rainmin=1.0e-9 ! & +! &, rainmin=1.0e-9 !& &, rainmin=1.0e-8 & &, oneopt9=1.0/0.09 & &, oneopt4=1.0/0.04 - real(kind=kind_phys), parameter :: almax=1.0e-2 + real(kind=kind_phys), parameter :: almax=1.0e-2 & &, almin1=0.0, almin2=0.0 real(kind=kind_phys), parameter :: bldmax = 300.0, bldmin=25.0 ! @@ -1298,8 +1307,8 @@ SUBROUTINE CLOUD( & real(kind=kind_phys) ALFINT(K,NTRC+4) real(kind=kind_phys) FRACBL, MAX_NEG_BOUY, DPD & - &, RHFACL, RHFACS, garea, ccwf & - &, c0, qw0, c0i, qi0, dlq_fac, afc + &, RHFACL, RHFACS, area, ccwf & + &, c0, qw0, c0i, qi0, dlq_fac ! UPDATE ARGUMENTS @@ -1350,16 +1359,17 @@ SUBROUTINE CLOUD( & &, FAC, RSUM1, RSUM2, RSUM3, dpneg, hcrit & &, ACTEVAP,AREARAT,DELTAQ,MASS,MASSINV,POTEVAP & &, TEQ,QSTEQ,DQDT,QEQ & - &, CLFRAC, DT, clf, clvfr, delzkm, fnoscav, delp + &, CLFRAC, DT, clvfr, delzkm, fnoscav, delp +! &, CLFRAC, DT, clf, clvfr, delzkm, fnoscav, delp ! &, almin1, almin2 INTEGER I, L, N, KD1, II, idh, lcon & - &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1, kbls, kmxh + &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1, kbls, kmxh & &, kblh, kblm, kblpmn, kmax, kmaxm1, kmaxp1, klcl, kmin, kmxb ! !*********************************************************************** ! -! almin2 = 0.2 * sqrt(pi/garea) +! almin2 = 0.2 * sqrt(pi/area) ! almin1 = almin2 KM1 = K - 1 @@ -1939,7 +1949,7 @@ SUBROUTINE CLOUD( & cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4 -! if (lprnt) write(0,*)' ii=',ii,' cnvflg=',cnvflg,' hsu=',hsu +! if (lprnt) write(0,*)' ii=',ii,' cnvflg=',cnvflg,' hsu=',hsu & ! &,' hbl=',hbl,' tx1=',tx1,' hsd=',hsd !*********************************************************************** @@ -1972,7 +1982,7 @@ SUBROUTINE CLOUD( & if (tem2 > almax) tem2 = -100.0 alm = max(tem1,tem2) -! if (lprnt) write(0,*) ' tem1=',tem1,' tem2=',tem2,' alm=',alm +! if (lprnt) write(0,*) ' tem1=',tem1,' tem2=',tem2,' alm=',alm & ! &,' tx1=',tx1,' tem=',tem,' epp=',epp,' x00=',x00,' st2=',st2 endif @@ -2062,7 +2072,8 @@ SUBROUTINE CLOUD( & rel_fac = max(zero, min(half,rel_fac)) IF (CRTFUN) THEN - II = MAX(1, MIN(tem*0.02-0.999999999, 16)) + II = tem*0.02-0.999999999 + II = MAX(1, MIN(II, 16)) ACR = tx1 * (AC(II) + tem * AD(II)) * CCWF ENDIF ! @@ -2136,8 +2147,8 @@ SUBROUTINE CLOUD( & ! ! if(lprnt) write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu ! if (lprnt .and. kd == 15) -! & write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu -! &,' qst=',qst(l),' qol=',qol(l),' hccp=',hccp,' detp=',detp +! & write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu & +! &,' qst=',qst(l),' qol=',qol(l),' hccp=',hccp,' detp=',detp & ! *,' qtp=',qtp,' alhf=',alhf,' vtf=',vtf(l) ST2 = LTL(L) * VTF(L) @@ -2147,17 +2158,17 @@ SUBROUTINE CLOUD( & ! ! if (lprnt) then ! if (lprnt .and. kd == 12) then -! write(0,*)' tem3=',tem3,' tx1=',tx1,' st1=',st1,' eta1=',eta(l+1) -! &, ' st2=',st2,' det=',det,' tem5=',tem5,' dlb=',dlb(l) -! write(0,*)' tem4=',tem4,' tem2=',tem2,' detp=',detp -! &, ' eta=',eta(l),' dlt=',dlt(l),' rns=',rns(l),' l=',l +! write(0,*)' tem3=',tem3,' tx1=',tx1,' st1=',st1,' eta1=',eta(l+1) & +! &, ' st2=',st2,' det=',det,' tem5=',tem5,' dlb=',dlb(l) & +! write(0,*)' tem4=',tem4,' tem2=',tem2,' detp=',detp & +! &, ' eta=',eta(l),' dlt=',dlt(l),' rns=',rns(l),' l=',l & ! write(0,*)' bt1=',tem3/(eta(l+1)*qrb(l)) ! &, ' bt2=',tem4/(eta(l)*qrt(l)) ! endif ST1 = TEM3 + TEM4 -! if (lprnt) write(0,*)' wfn=',wfn,' st1=',st1,' l=',l,' ep_wfn=', +! if (lprnt) write(0,*)' wfn=',wfn,' st1=',st1,' l=',l,' ep_wfn=', & ! &ep_wfn,' akm=',akm WFN = WFN + ST1 @@ -2236,7 +2247,7 @@ SUBROUTINE CLOUD( & endif ! ! -! ST1 = 0.5 * (HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) +! ST1 = 0.5 * (HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) & ! & + HST(KD1) - LTL(KD1)*NU*(QST(KD1)-QOL(KD1))) ! ST1 = HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) @@ -2244,7 +2255,7 @@ SUBROUTINE CLOUD( & TEM5 = (QLS + QIS) * eta(kd1) ST1 = HALF * (TX1-ETA(KD1)*ST1-ST2*(DET-TEM5))*DLB(KD) ! -! if (lprnt) write(0,*)' st1=',st1,' st2=',st2,' ltl=',ltl(kd) +! if (lprnt) write(0,*)' st1=',st1,' st2=',st2,' ltl=',ltl(kd) & ! *,ltl(kd1),' qos=',qos,qol(kd1) WFN = WFN + ST1 @@ -2253,7 +2264,7 @@ SUBROUTINE CLOUD( & BUY(KD) = ST1 / (ETA(KD1)*qrb(kd)) ! -! if (lprnt) write(0,*)' wfn=',wfn,' akm=',akm,' st1=',st1 +! if (lprnt) write(0,*)' wfn=',wfn,' akm=',akm,' st1=',st1 & ! &,' dpneg=',dpneg DET = DETP @@ -2677,9 +2688,9 @@ SUBROUTINE CLOUD( & ! endif if (do_aw) then tx1 = (0.2 / max(alm, 1.0e-5)) - tx2 = one - min(one, pi * tx1 * tx1 / garea) + tx2 = one - min(one, pi * tx1 * tx1 / area) ! if(lprnt) write(0,*)' kd=',kd,' alm=',alm,' tx1=',tx1 -! &,' garea=',garea,' pi=',pi,' tx2=',tx2 +! &,' area=',area,' pi=',pi,' tx2=',tx2 tx2 = tx2 * tx2 ! if(lprnt) write(0,*)' kd=',kd,' wvl=',wvl(kd:k+1) ! if(lprnt) write(0,*)' kd=',kd,' eta=',eta(kd:k+1) @@ -2755,7 +2766,7 @@ SUBROUTINE CLOUD( & ! avr = avr + (QLL(L) + QIL(L)*(1+alhf/alhl)) avr = avr + (QLL(L) + QIL(L)) * delp * sigf(l) * gravcon -! if(lprnt) write(0,*)' avr=',avr,' qll=',qll(l),' l=',l +! if(lprnt) write(0,*)' avr=',avr,' qll=',qll(l),' l=',l & ! &, ' qil=',qil(l) ! Correction for negative condensate! @@ -2802,11 +2813,11 @@ SUBROUTINE CLOUD( & ! avt = avt * cp * 100.0*86400.0 / (alhl*DT*grav) ! avq = avq * 100.0*86400.0 / (DT*grav) ! avr = avr * 86400.0 / DT -! write(0,*) ' avt=',avt,' avq=',avq,' avr=',avr,' avh=' -! * ,avh,' alm=',alm,' DDFT=',DDFT,' KD=',KD -! &,' TOIK-',toi(k),' TOIK-1=',toi(k-1),' TOIK-2=',toi(k-2) +! write(0,*) ' avt=',avt,' avq=',avq,' avr=',avr,' avh=' & +! * ,avh,' alm=',alm,' DDFT=',DDFT,' KD=',KD & +! &,' TOIK-',toi(k),' TOIK-1=',toi(k-1),' TOIK-2=',toi(k-2) & ! if (kd == 12 .and. .not. ddft) stop -! if (avh > 0.1 .or. abs(avt+avq) > 1.0e-5 .or. +! if (avh > 0.1 .or. abs(avt+avq) > 1.0e-5 .or. & ! & abs(avt-avr) > 1.0e-5 .or. abs(avr+avq) > 1.0e-5) stop ! ! if (lprnt) then @@ -2828,12 +2839,12 @@ SUBROUTINE CLOUD( & enddo tem = tem + amb * dof * sigf(kbl) tem = tem * (3600.0/dt) -!!!! tem1 = max(1.0, min(100.0,sqrt((5.0E10/max(garea,one))))) -! tem1 = max(1.0, min(100.0,(7.5E10/max(garea,one)))) -! tem1 = max(1.0, min(100.0,(5.0E10/max(garea,one)))) -! tem1 = max(1.0, min(100.0,(4.0E10/max(garea,one)))) -!! tem1 = sqrt(max(1.0, min(100.0,(4.0E10/max(garea,one))))) ! 20100902 - tem1 = sqrt(max(one, min(100.0,(6.25E10/max(garea,one))))) ! 20110530 +!!!! tem1 = max(1.0, min(100.0,sqrt((5.0E10/max(area,one))))) +! tem1 = max(1.0, min(100.0,(7.5E10/max(area,one)))) +! tem1 = max(1.0, min(100.0,(5.0E10/max(area,one)))) +! tem1 = max(1.0, min(100.0,(4.0E10/max(area,one)))) +!! tem1 = sqrt(max(1.0, min(100.0,(4.0E10/max(area,one))))) ! 20100902 + tem1 = sqrt(max(one, min(100.0,(6.25E10/max(area,one))))) ! 20110530 ! if (lprnt) write(0,*)' clfr0=',clf(tem),' tem=',tem,' tem1=',tem1 @@ -2896,9 +2907,9 @@ SUBROUTINE CLOUD( & ! & TEM4 = POTEVAP * (1. - EXP( AFC*tx4*SQRT(TX1) ) ) ACTEVAP = MIN(TX1, TEM4*CLFRAC) -! if(lprnt) write(0,*)' L=',L,' actevap=',actevap,' tem4=',tem4, -! &' clfrac=' -! &,clfrac,' potevap=',potevap,'efac=',AFC*SQRT(TX1*TEM3) +! if(lprnt) write(0,*)' L=',L,' actevap=',actevap,' tem4=',tem4, & +! &' clfrac=' & +! &,clfrac,' potevap=',potevap,'efac=',AFC*SQRT(TX1*TEM3) & ! &,' tx1=',tx1 if (tx1 < rainmin*dt) actevap = min(tx1, potevap) @@ -3012,7 +3023,7 @@ SUBROUTINE CLOUD( & if (st2 < zero) then ROI(L,N) = trcmin(n) RCU(L,N) = RCU(L,N) + ST1 - if (l < k) + if (l < k) & & st2 = st2 * (prl(l+1)-prl(l))*pri(l+1) * (cmb2pa/grav) else ROI(L,N) = ST3 @@ -3045,7 +3056,7 @@ SUBROUTINE CLOUD( & ! if (lprnt) write(0,*)' qoio=',qoi RETURN - END + end subroutine cloud SUBROUTINE DDRFT( & & K, KP1, KD & @@ -3078,8 +3089,6 @@ SUBROUTINE DDRFT( & !===> K INPUT THE RISE & THE INDEX OF THE SUBCLOUD LAYER !===> KD INPUT DETRAINMENT LEVEL ( 1<= KD < K ) ! - USE MACHINE , ONLY : kind_phys -! use module_ras IMPLICIT NONE ! ! INPUT ARGUMENTS @@ -3119,7 +3128,8 @@ SUBROUTINE DDRFT( & &, GMF1, GMF5, QRAF, QRBF, del_tla & &, TLA, STLA, CTL2, CTL3 & ! &, TLA, STLA, CTL2, CTL3, ASIN & - &, RNT, RNB, ERRQ, RNTP, QRPF, VTPF & +! &, RNT, RNB, ERRQ, RNTP, QRPF, VTPF & + &, RNT, RNB, ERRQ, RNTP & &, EDZ, DDZ, CE, QHS, FAC, FACG & &, RSUM1, RSUM2, RSUM3, CEE, DOF, DOFW ! &, sialf @@ -3145,15 +3155,15 @@ SUBROUTINE DDRFT( & parameter (WCMIN=sqrt(wc2min)) ! parameter (sialf=0.5) ! - integer, parameter :: itrmu=25, itrmd=25 + integer, parameter :: itrmu=25, itrmd=25 & &, itrmin=15, itrmnd=12, numtla=2 ! uncentering for vvel in dd - real(kind=kind_phys), parameter :: ddunc1=0.25, ddunc2=one-ddunc1 -! &, ddunc1=0.4, ddunc2=one-ddunc1 -! &, ddunc1=0.3, ddunc2=one-ddunc1 - &, VTPEXP=-0.3636 - & VTP=36.34*SQRT(1.2)*(0.001)**0.1364 + real(kind=kind_phys), parameter :: ddunc1=0.25, ddunc2=one-ddunc1 & +! &, ddunc1=0.4, ddunc2=one-ddunc1 & +! &, ddunc1=0.3, ddunc2=one-ddunc1 & + &, VTPEXP=-0.3636 & + &, VTP=36.34*SQRT(1.2)*(0.001)**0.1364 ! ! real(kind=kind_phys) EM(K*K), ELM(K) real(kind=kind_phys) ELM(K), AA(KD:K,KD:KP1), QW(KD:K,KD:K) & @@ -3302,7 +3312,7 @@ SUBROUTINE DDRFT( & STLA = SIN(TLA*deg2rad) ! sine of tilting angle CTL2 = one - STLA * STLA ! cosine square of tilting angle ! -! if (lprnt) write(0,*)' tla=',tla,' al2=',al2,' ptop=' +! if (lprnt) write(0,*)' tla=',tla,' al2=',al2,' ptop=' & ! &,0.5*(prl(kd)+prl(kd1)),' ntla=',ntla,' f2=',f2,' stla=',stla ! if (lprnt) write(0,*)' buy=',(buy(l),l=kd,kbl) ! @@ -3350,8 +3360,8 @@ SUBROUTINE DDRFT( & ! & + qrp(l)) else -! if (lprnt) write(0,*)' l=',l,' st1=',st1,' wcb=',wcb(l),' qw=' -! &,qw(l,l),' qrp=',qrp(l),' tx1=',tx1,' gsd=',gsd(l),' itr=',itr +! if (lprnt) write(0,*)' l=',l,' st1=',st1,' wcb=',wcb(l),' qw='& +! &,qw(l,l),' qrp=',qrp(l),' tx1=',tx1,' gsd=',gsd(l),' itr=',itr & ! &,' wvl=',wvl(l) ! wvl(l) = 0.5*(wcmin+wvl(l)) @@ -3611,7 +3621,7 @@ SUBROUTINE DDRFT( & KK1 = KK + 1 AA(KK,KK1) = AA(KK,KK1) / AA(KK,KK) ! Qr correction ! TX2 = ABS(AA(KK,KK1)) * QRPI(KK) ! Error Measure ! -! if (lprnt) write(0,*) ' tx2a=',tx2,' aa1=',aa(kk,kk1) +! if (lprnt) write(0,*) ' tx2a=',tx2,' aa1=',aa(kk,kk1) & ! &,' qrpi=',qrpi(kk) ! KK = KBL + 1 @@ -3624,7 +3634,7 @@ SUBROUTINE DDRFT( & AA(L,KK) = (AA(L,KK) - TX1) / AA(L,L) ! Qr correction ! TX2 = MAX(TX2, ABS(AA(L,KK))*QRPI(L)) ! Error Measure ! -! if (lprnt) write(0,*)' tx2b=',tx2,' aa1=',aa(l,kk) +! if (lprnt) write(0,*)' tx2b=',tx2,' aa1=',aa(l,kk) & ! &,' qrpi=',qrpi(l),' L=',L ENDDO @@ -3652,7 +3662,7 @@ SUBROUTINE DDRFT( & ELSE SKPUP = .TRUE. ! Converges ! ERRQ = zero ! Rain profile exists! -! if (lprnt) write(0,*)' here1',' tem=',tem,' tx2=',tx2,' errmi2=', +! if (lprnt) write(0,*)' here1',' tem=',tem,' tx2=',tx2,' errmi2=', & ! &errmi2,' errmin=',errmin ENDIF ELSE @@ -3858,8 +3868,8 @@ SUBROUTINE DDRFT( & ! VT(1) = GMS(L-1) * QRP(L-1) ** 0.1364 VT(1) = GMS(L-1) * QRPF(QRP(L-1)) RNT = ROR(L-1) * (WVL(L-1)+VT(1))*QRP(L-1) -! if(lprnt) write(0,*)' l=',l,' qa=',qa(1), ' tx1RNT=',RNT*tx1, -! *' wvl=',wvl(l-1) +! if(lprnt) write(0,*)' l=',l,' qa=',qa(1), ' tx1RNT=',RNT*tx1,& +! *' wvl=',wvl(l-1) & ! *,' qrp=',qrp(l-1),' tx5=',tx5,' tx1=',tx1,' rnt=',rnt ! @@ -3961,8 +3971,8 @@ SUBROUTINE DDRFT( & TEM2 = TX8 ST1 = zero ENDIF -! if (lprnt) write(0,*)' st1=',st1,' tem=',tem,' ror=',ror(l) -! &,' qrp=',qrp(l),' rnt=',rnt,' ror1=',ror(l-1),' wvl=',wvl(l) +! if (lprnt) write(0,*)' st1=',st1,' tem=',tem,' ror=',ror(l) & +! &,' qrp=',qrp(l),' rnt=',rnt,' ror1=',ror(l-1),' wvl=',wvl(l) & ! &,' wvl1=',wvl(l-1),' tem2=',tem2,' vt=',vt(1),' tx3=',tx3 ! st2 = tx5 @@ -3984,12 +3994,12 @@ SUBROUTINE DDRFT( & ! endif ! ! if(lprnt) write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' -! if(tx5 <= 0.0 .and. l > kd+2) -! & write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' -! *,tem2,' tx3=',tx3,' tem=',tem,' tem1=',tem1,' wvl=',wvl(l-1), -! &wvl(l),' l=',l,' itr=',itr,' evp=',evp(l-1),' vt=',vt(1) +! if(tx5 <= 0.0 .and. l > kd+2) & +! & write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' i & +! *,tem2,' tx3=',tx3,' tem=',tem,' tem1=',tem1,' wvl=',wvl(l-1), & +! &wvl(l),' l=',l,' itr=',itr,' evp=',evp(l-1),' vt=',vt(1) & ! *,' qrp=',qrp(l),' rnt=',rnt,' kd=',kd -! if (lprnt) write(0,*)' etd=',etd(l),' wvl=',wvl(l) +! if (lprnt) write(0,*)' etd=',etd(l),' wvl=',wvl(l) & ! &,' trw=',trw(1),trw(2),' ror=',ror(l),' wa=',wa @@ -4036,7 +4046,7 @@ SUBROUTINE DDRFT( & ENDIF ERRH = HOD(L) - TEM1 ERRQ = ABS(ERRH/HOD(L)) + ABS(ERRE/MAX(ETD(L),ONE_M5)) -! if (lprnt) write(0,*)' ERRQP=',errq,' errh=',errh,' hod=',hod(l) +! if (lprnt) write(0,*)' ERRQP=',errq,' errh=',errh,' hod=',hod(l) & ! &,' erre=',erre,' etd=',etd(l),' del_eta=',del_eta DOF = DDZ VT(2) = QQQ @@ -4080,7 +4090,7 @@ SUBROUTINE DDRFT( & ! Calculate Pd (L+1/2) QA(1) = TX1*RNT + RNF(L-1) - EVP(L-1) ! -! if(lprnt) write(0,*)' etd=',etd(l),' tx5=',tx5,' rnt=',rnt +! if(lprnt) write(0,*)' etd=',etd(l),' tx5=',tx5,' rnt=',rnt & ! *,' rnf=',rnf(l-1),' evp=',evp(l-1),' itr=',itr,' L=',L ! if (qa(1) > zero) then @@ -4099,8 +4109,8 @@ SUBROUTINE DDRFT( & ! Compute Buoyancy TEM1 = WA(3) + (HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & & * onebcp -! if (lprnt) write(0,*)' tem1=',tem1,' wa3=',wa(3),' hod=' -! &,hod(l),' wa1=',wa(1),' qod=',qod(l),' wa2=',wa(2),' alhl=',alhl +! if (lprnt) write(0,*)' tem1=',tem1,' wa3=',wa(3),' hod=' & +! &,hod(l),' wa1=',wa(1),' qod=',qod(l),' wa2=',wa(2),' alhl=',alhl & ! &,' cmpor=',cmpor,' dofw=',dofw,' prl=',prl(l),' qrp=',qrp(l) TEM1 = TEM1 * (one + NU*QOD(L)) ROR(L) = CMPOR * PRL(L) / TEM1 @@ -4115,8 +4125,8 @@ SUBROUTINE DDRFT( & WVL(L) = VT(2) * (ETD(L-1)*WVL(L-1) - FACG & & * (BUY(L-1)*QRT(L-1)+BUY(L)*QRB(L-1))) ! -! if (lprnt) write(0,*)' wvl=',wvl(l),'vt2=',vt(2),' buy1=' -! &,buy(l-1),' buy=',buy(l),' qrt1=',qrt(l-1),' qrb1=',qrb(l-1) +! if (lprnt) write(0,*)' wvl=',wvl(l),'vt2=',vt(2),' buy1=' & +! &,buy(l-1),' buy=',buy(l),' qrt1=',qrt(l-1),' qrb1=',qrb(l-1) & ! &,' etd1=',etd(l-1),' wvl1=',wvl(l-1) ! ENDIF ! @@ -4173,13 +4183,13 @@ SUBROUTINE DDRFT( & QA(1) = TEM - EVP(L-1) ! IF (QA(1) > 0.0) THEN -! if(lprnt) write(0,*)' ror=',ror(l),' tx5=',tx5,' tx1=',tx1 -! *,' tx9=',tx9,' gms=',gms(l),' qa=',qa(1) +! if(lprnt) write(0,*)' ror=',ror(l),' tx5=',tx5,' tx1=',tx1 & +! *,' tx9=',tx9,' gms=',gms(l),' qa=',qa(1 ! if(lprnt) call mpi_quit(13) ! if (tx5 == 0.0 .or. gms(l) == 0.0) -! if (lprnt) -! * write(0,*)' Atx5=',tx5,' gms=',gms(l),' ror=',ror(l) -! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 +! if (lprnt) & +! * write(0,*)' Atx5=',tx5,' gms=',gms(l),' ror=',ror(l) & +! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & ! *,' kbl=',kbl,' etd1=',etd(l-1),' idnm=',idnm,' idn=',idn(idnm) ! *,' errq=',errq @@ -4256,9 +4266,9 @@ SUBROUTINE DDRFT( & ! ! if (tx5 == 0.0 .or. gms(l) == 0.0) ! if (lprnt) -! * write(0,*)' Btx5=',tx5,' gms=',gms(l),' ror=',ror(l) -! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 -! *,' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA +! * write(0,*)' Btx5=',tx5,' gms=',gms(l),' ror=',ror(l) & +! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & +! *,' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA & ! &,' evp=',evp(l-1) ! ! IF (QA(1) > 0.0) THEN @@ -4441,17 +4451,11 @@ SUBROUTINE DDRFT( & !*********************************************************************** RETURN - END + end subroutine ddrft SUBROUTINE QSATCN(TT,P,Q,DQDT) ! SUBROUTINE QSATCN(TT,P,Q,DQDT,lprnt) - USE MACHINE , ONLY : kind_phys - USE FUNCPHYS , ONLY : fpvs - USE PHYSCONS, RV => con_RV, CVAP => con_CVAP, CLIQ => con_CLIQ & - &, CSOL => con_CSOL, TTP => con_TTP, HVAP => con_HVAP & - &, HFUS => con_HFUS, EPS => con_eps & - &, EPSM1 => con_epsm1 implicit none ! real(kind=kind_phys) TT, P, Q, DQDT @@ -4459,7 +4463,7 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & &, ONE_M10=1.E-10 & &, rvi=one/rv, facw=CVAP-CLIQ & - &, faci=CVAP-CSOL, hsub=HVAP+HFUS & + &, faci=CVAP-CSOL, hsub=alhl+alhf & &, tmix=TTP-20.0 & &, DEN=one/(TTP-TMIX) ! logical lprnt @@ -4473,15 +4477,14 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) q = MIN(eps*es*D, ONE) ! W = max(ZERO, min(ONE, (TT - TMIX)*DEN)) - hlorv = ( W * (HVAP + FACW * (tt-ttp)) & - & + (one-W) * (HSUB + FACI * (tt-ttp)) ) * RVI + hlorv = ( W * (alhl + FACW * (tt-ttp)) & + & + (one-W) * (alhf + FACI * (tt-ttp)) ) * RVI dqdt = p * q * hlorv * D / (tt*tt) ! return - end + end subroutine qsatcn SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) - USE MACHINE , ONLY : kind_phys ! use module_ras , only : refp, refr, tlac, plac, tlbpl, drdp implicit none @@ -4530,9 +4533,9 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) al2 = min(4.0*tem, max(alm, tem)) ! RETURN - END + end subroutine angrad + SUBROUTINE SETQRP - USE MACHINE , ONLY : kind_phys ! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB,one implicit none @@ -4555,26 +4558,9 @@ SUBROUTINE SETQRP ENDDO ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END - FUNCTION QRPF(QRP) -! - USE MACHINE , ONLY : kind_phys -! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB, one - implicit none + end subroutine setqrp - real(kind=kind_phys) QRP, QRPF, XJ, REAL_NQRP - INTEGER JX -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - REAL_NQRP = REAL(NQRP) - XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),REAL_NQRP) -! XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),FLOAT(NQRP)) - JX = MIN(XJ,NQRP-ONE) - QRPF = TBQRP(JX) + (XJ-JX) * (TBQRP(JX+1)-TBQRP(JX)) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END SUBROUTINE QRABF(QRP,QRAF,QRBF) - USE MACHINE , ONLY : kind_phys ! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB, one implicit none ! @@ -4589,9 +4575,9 @@ SUBROUTINE QRABF(QRP,QRAF,QRBF) QRBF = TBQRB(JX) + XJ * (TBQRB(JX+1)-TBQRB(JX)) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END + end subroutine qrabf + SUBROUTINE SETVTP - USE MACHINE , ONLY : kind_phys ! use module_ras , only : NVTP,C1XVTP,C2XVTP,TBVTP implicit none @@ -4610,13 +4596,28 @@ SUBROUTINE SETVTP ENDDO ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END - FUNCTION VTPF(ROR) + end subroutine setvtp +! + real(kind=kind_phys) FUNCTION QRPF(QRP) +! + implicit none + + real(kind=kind_phys) QRP, XJ, REAL_NQRP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NQRP = REAL(NQRP) + XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),REAL_NQRP) +! XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),FLOAT(NQRP)) + JX = MIN(XJ,NQRP-ONE) + QRPF = TBQRP(JX) + (XJ-JX) * (TBQRP(JX+1)-TBQRP(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end function qrpf + + real(kind=kind_phys) FUNCTION VTPF(ROR) ! - USE MACHINE , ONLY : kind_phys -! use module_ras , only : NVTP,C1XVTP,C2XVTP,TBVTP, one implicit none - real(kind=kind_phys) ROR, VTPF, XJ, REAL_NVTP + real(kind=kind_phys) ROR, XJ, REAL_NVTP INTEGER JX ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - REAL_NVTP = REAL(NVTP) @@ -4625,12 +4626,12 @@ FUNCTION VTPF(ROR) VTPF = TBVTP(JX) + (XJ-JX) * (TBVTP(JX+1)-TBVTP(JX)) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END - FUNCTION CLF(PRATE) + end function vtpf + + real(kind=kind_phys) FUNCTION CLF(PRATE) ! - USE MACHINE , ONLY : kind_phys implicit none - real(kind=kind_phys) PRATE, CLF + real(kind=kind_phys) PRATE ! real (kind=kind_phys), parameter :: ccf1=0.30, ccf2=0.09 & &, ccf3=0.04, ccf4=0.01 & @@ -4648,4 +4649,5 @@ FUNCTION CLF(PRATE) endif ! RETURN - END + end function clf + end module rascnv diff --git a/physics/rascnv.meta b/physics/rascnv.meta index 7d93886c0..7201888bc 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -9,6 +9,15 @@ type = integer intent = in optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -77,6 +86,14 @@ type = integer intent = in optional = F +[ntr] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer + intent = in + optional = F [dt] standard_name = time_step_for_physics long_name = physics time step @@ -87,14 +104,102 @@ intent = in optional = F [dtf] - standard_name = time_step_for_physics - long_name = physics time step + standard_name = time_step_for_dynamics + long_name = dynamics timestep units = s dimensions = () type = real kind = kind_phys intent = in optional = F +[ccwf] + standard_name = multiplication_factor_for_critical_cloud_workfunction + long_name = multiplication factor for tical_cloud_workfunction + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dxmin] + standard_name = minimum_scaling_factor_for_critical_relative_humidity + long_name = minimum scaling factor for critical relative humidity + units = m2 rad-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dxinv] + standard_name = inverse_scaling_factor_for_critical_relative_humidity + long_name = inverse scaling factor for critical relative humidity + units = rad2 m-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[psauras] + standard_name = coefficient_from_cloud_ice_to_snow_ras + long_name = conversion coefficient from cloud ice to snow in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[prauras] + standard_name = coefficient_from_cloud_water_to_rain_ras + long_name = conversion coefficient from cloud water to rain in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[wminras] + standard_name = cloud_condensed_water_ice_conversion_threshold_ras + long_name = conversion coefficient from cloud liquid and ice to precipitation in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[dlqf] + standard_name = condensate_fraction_detrained_in_updraft_layers + long_name = condensate fraction detrained with in a updraft layers + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[flipv] + standard_name = flag_flip + long_name = vertical flip logical + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [rannum] standard_name = random_number_array long_name = random number array (0-1) @@ -104,6 +209,71 @@ kind = kind_phys intent = in optional = F +[nrcm] + standard_name = array_dimension_of_random_number + long_name = second dimension of random number stream for RAS + units = count + dimensions = () + type = integer + intent = in + optional = F +[mp_phys] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[mp_phys_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ntk] + standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer + long_name = index for turbulent kinetic energy in the convectively transported tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[rhc] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [tin] standard_name = air_temperature_updated_by_physics long_name = updated temperature @@ -144,19 +314,11 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + dimensions = (horizontal_dimension,vertical_dimension,tracer_dimension) type = real kind = kind_phys intent = inout optional = F -[trac] - standard_name = number_tracers - long_name = number on tracers transported by convection - units = count - dimensions = () - type = integer - intent = in - optional = F [fscav] standard_name = coefficients_for_aerosol_scavenging long_name = array of aerosol scavenging coefficients @@ -167,8 +329,8 @@ intent = in optional = F [prsi] - standard_name = interface_air_pressure - long_name = layer interface pressure + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces units = Pa dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -185,26 +347,26 @@ intent = in optional = F [prsik] - standard_name = interface_exner_function - long_name = layer interface exner function - units = ratio + standard_name = dimensionless_exner_function_at_model_interfaces + long_name = dimensionless Exner function at model layer interfaces + units = none dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [prslk] - standard_name = layer_exner_function - long_name = mean layer exner function - units = ratio + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [phil] - standard_name = layer_geopotential - long_name = layer geopotential + standard_name = geopotential + long_name = geopotential at model layer centers units = m2 s-2 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -212,17 +374,17 @@ intent = in optional = F [phii] - standard_name = interface_geopotential - long_name = layer interface geopotential + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,vertical_dimension_plus_one) type = real kind = kind_phys intent = in optional = F [kpbl] - standard_name = vertical_index_at_pbl_top - long_name = index for pbl top + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer units = index dimensions = (horizontal_dimension) type = integer @@ -271,74 +433,14 @@ intent = inout optional = F [ddvel] - standard_name = downdraft_induced_surface_wind - long_name = downdraft induced surface wind + standard_name = surface_wind_enhancement_due_to_convection + long_name = surface wind enhancement due to convection units = m s-1 dimensions = (horizontal_dimension) type = real kind = kind_phys intent = out optional = F -[flipv] - standard_name = flag_flip - long_name = vertical flip logical - units = flag - dimensions = () - type = logical - intent = in - optional = F -[facmb] - standard_name = pressure_conversion_factor - long_name = conversion factor from input pressure to hPa - units = ratio - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[garea] - standard_name = cell_area - long_name = grid cell area - units = m2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ccwfac] - standard_name = critical_work_function_factor - long_name = factor mupltiplying critical work function - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[nrcm] - standard_name = number_of_random_numbers - long_name = number of random numbers - units = count - dimensions = () - type = integer - intent = in - optional = F -[rhc] - standard_name = critical_relative_humidity - long_name = critical relative humidity - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [ud_mf] standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * dt @@ -357,7 +459,7 @@ kind = kind_phys intent = out optional = F -[det_mf] +[dt_mf] standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * dt units = kg m-2 @@ -366,83 +468,6 @@ kind = kind_phys intent = out optional = F -[c00] - standard_name = rain_auto_conversion_coefficient - long_name = rain auto conversion coefficient - units = m-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[qw0] - standard_name = liquid_water_threshold_in_autoconversion - long_name = liquid water threshold in autoconversion - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[c00i] - standard_name = snow_auto_conversion_coefficient - long_name = snow auto conversion coefficient - units = m-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[qi0] - standard_name = ice_water_threshold_in_autoconversion - long_name = ice water threshold in autoconversion - units = kg kg-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dlqfac] - standard_name = condensate_fraction_detrained_in_updraft_layer - long_name = condensate fraction detrained with in a updraft layer - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[lprnt] - standard_name = flag_debug_print - long_name = debug print logical - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ipr] - standard_name = horizontal_grid_index - long_name = horizontal grid index - units = count - dimensions = () - type = integer - intent = in - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current time step index - units = index - dimensions = () - type = integer - intent = in - optional = F -[revap] - standard_name = flag_rain_revap - long_name = rain reevaporation logical - units = flag - dimensions = () - type = logical - intent = in - optional = F [qlcn] standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water @@ -533,39 +558,6 @@ kind = kind_phys intent = inout optional = F -[mp_phys] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[mp_phys_mg] - standard_name = flag_for_morrison_gettelman_microphysics_scheme - long_name = choice of Morrison-Gettelman microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[trcmin] - standard_name = floor_value_for_tracers - long_name = minimum tracer value - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[ntk] - standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer - long_name = index for turbulent kinetic energy in the convectively transported tracer array - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 9e906cc1ffa93fc22eda95715ba73b3d63546a30 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 1 Nov 2019 11:05:51 +0000 Subject: [PATCH 07/24] bug fix in rascnv.F90 --- physics/rascnv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 8273bd3af..6354f826a 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -453,7 +453,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & enddo DO IPT=1,IM - tem1 = (log(area(i)) - dxmin) * dxinv + tem1 = (log(area(ipt)) - dxmin) * dxinv tem2 = one - tem1 ccwfac = ccwf(1)*tem1 + ccwf(2)*tem2 dlq_fac = dlqf(1)*tem1 + dlqf(2)*tem2 From 51c13beef8b36036b5a9ac34b7951fe20b1d4eb2 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 6 Nov 2019 00:22:21 +0000 Subject: [PATCH 08/24] after merging with ccpp/physics master on nom04 --- physics/GFS_debug.F90 | 43 ++--------------------------- physics/GFS_suite_interstitial.F90 | 32 ++++++++++++++++----- physics/GFS_suite_interstitial.meta | 41 +++++++++++++++++++++++++++ physics/rrtmg_lw_pre.F90 | 12 +------- physics/rrtmg_sw_pre.F90 | 19 +------------ 5 files changed, 71 insertions(+), 76 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 1a13b3649..df56cc069 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -41,23 +41,7 @@ subroutine GFS_diagtoscreen_finalize () end subroutine GFS_diagtoscreen_finalize !> \section arg_table_GFS_diagtoscreen_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type in FV3 | DDT | 0 | GFS_control_type | | in | F | -!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type in FV3 | DDT | 0 | GFS_statein_type | | in | F | -!! | Stateout | GFS_stateout_type_instance | instance of derived type GFS_stateout_type | DDT | 0 | GFS_stateout_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | instance of type GFS_sfcprop_type in FV3 | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Coupling | GFS_coupling_type_instance | instance of type GFS_coupling_type in FV3 | DDT | 0 | GFS_coupling_type | | in | F | -!! | Grid | GFS_grid_type_instance | instance of type GFS_grid_type in FV3 | DDT | 0 | GFS_grid_type | | in | F | -!! | Tbd | GFS_tbd_type_instance | instance of type GFS_tbd_type in FV3 | DDT | 0 | GFS_tbd_type | | in | F | -!! | Cldprop | GFS_cldprop_type_instance | instance of type GFS_cldprop_type in FV3 | DDT | 0 | GFS_cldprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | instance of type GFS_radtend_type in FV3 | DDT | 0 | GFS_radtend_type | | in | F | -!! | Diag | GFS_diag_type_instance | instance of type GFS_diag_type in FV3 | DDT | 0 | GFS_diag_type | | in | F | -!! | Interstitial | GFS_interstitial_type_instance | instance of type GFS_interstitial_type in FV3 | DDT | 0 | GFS_interstitial_type | | in | F | -!! | nthreads | omp_threads | number of OpenMP threads or fast physics schemes | count | 0 | integer | | in | F | -!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_diagtoscreen_run.html !! subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & @@ -765,23 +749,7 @@ subroutine GFS_interstitialtoscreen_finalize () end subroutine GFS_interstitialtoscreen_finalize !> \section arg_table_GFS_interstitialtoscreen_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type | DDT | 0 | GFS_control_type | | in | F | -!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type | DDT | 0 | GFS_statein_type | | in | F | -!! | Stateout | GFS_stateout_type_instance | instance of derived type GFS_stateout_type | DDT | 0 | GFS_stateout_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | instance of derived type GFS_sfcprop_type | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Coupling | GFS_coupling_type_instance | instance of derived type GFS_coupling_type | DDT | 0 | GFS_coupling_type | | in | F | -!! | Grid | GFS_grid_type_instance | instance of derived type GFS_grid_type | DDT | 0 | GFS_grid_type | | in | F | -!! | Tbd | GFS_tbd_type_instance | instance of derived type GFS_tbd_type | DDT | 0 | GFS_tbd_type | | in | F | -!! | Cldprop | GFS_cldprop_type_instance | instance of derived type GFS_cldprop_type | DDT | 0 | GFS_cldprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | instance of derived type GFS_radtend_type | DDT | 0 | GFS_radtend_type | | in | F | -!! | Diag | GFS_diag_type_instance | instance of derived type GFS_diag_type | DDT | 0 | GFS_diag_type | | in | F | -!! | Interstitial | GFS_interstitial_type_instance | instance of derived type GFS_interstitial_type | DDT | 0 | GFS_interstitial_type | | in | F | -!! | nthreads | omp_threads | number of OpenMP threads or fast physics schemes | count | 0 | integer | | in | F | -!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_interstitialtoscreen_run.html !! subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & @@ -893,12 +861,7 @@ subroutine GFS_abort_finalize () end subroutine GFS_abort_finalize !> \section arg_table_GFS_abort_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type | DDT | 0 | GFS_control_type | | in | F | -!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_abort_run.html !! subroutine GFS_abort_run (Model, blkno, errmsg, errflg) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 379589b3c..d88992c64 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -459,10 +459,10 @@ end subroutine GFS_suite_interstitial_3_finalize !! \htmlinclude GFS_suite_interstitial_3_run.html !! #endif - subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & - ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, xlat, gq0, imp_physics, imp_physics_mg, imp_physics_zhao_carr,& - imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, prsi, prsl, prslk, rhcbot, & - rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, kinver, ras, & + subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & + ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, xlon, xlat, gq0, imp_physics, imp_physics_mg, & + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, prsi, prsl, & + prslk, rhcbot, rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, kinver, ras, lprnt, ipt, kdt, me, & clw, rhc, save_qc, save_qi, errmsg, errflg) use machine, only: kind_phys @@ -472,7 +472,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr ! interface variables integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntclamt, ntrw, & ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, kdt, me integer, dimension(im), intent(in) :: islmsk, kpbl, kinver logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras @@ -480,13 +480,15 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr real(kind=kind_phys), dimension(im), intent(in) :: work1, work2 real(kind=kind_phys), dimension(im, levs), intent(in) :: prsl, prslk real(kind=kind_phys), dimension(im, levs+1), intent(in) :: prsi - real(kind=kind_phys), dimension(im), intent(in) :: xlat + real(kind=kind_phys), dimension(im), intent(in) :: xlon, xlat real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 real(kind=kind_phys), dimension(im, levs), intent(inout) :: rhc, save_qc ! save_qi is not allocated for Zhao-Carr MP real(kind=kind_phys), dimension(:, :), intent(inout) :: save_qi real(kind=kind_phys), dimension(im, levs, nn), intent(inout) :: clw + logical, intent(inout) :: lprnt + integer, intent(inout) :: ipt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -500,12 +502,28 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr ! turnrhcrit = 0.900, turnrhcrit_upper = 0.150 ! in the following inverse of slope_mg and slope_upmg are specified real(kind=kind_phys),parameter :: slope_mg = 50.0_kind_phys, & - slope_upmg = 25.0_kind_phys + slope_upmg = 25.0_kind_phys, & + rad2dg = 180.0/3.14159265359 ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + do i=1,im + lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-29.55) < 0.201 & + .and. abs(xlat(i)*rad2dg+59.62) < 0.201 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-169.453) < 0.501 & +! .and. abs(xlat(i)*rad2dg-72.96) < 0.501 +! if (kdt == 1) & +! write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & +! ' xlat=',xlat(i)*rad2dg,' me=',me + if (lprnt) then + ipt = i + write(0,*)' ipt=',ipt,'xlon=',xlon(i)*rad2dg,' xlat=',xlat(i)*rad2dg,' me=',me + exit + endif + enddo +! !GF* The following section (initializing convective variables) is already executed in GFS_typedefs%interstitial_phys_reset ! do k=1,levs ! do i=1,im diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 1523219ae..0e322a819 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1201,6 +1201,15 @@ type = integer intent = in optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [xlat] standard_name = latitude long_name = latitude @@ -1388,6 +1397,38 @@ type = logical intent = in optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipt] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [clw] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index ca0bc408b..5f128a79a 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -12,17 +12,7 @@ subroutine rrtmg_lw_pre_init () end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rrtmg_lw_pre_run.html !! subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errmsg, errflg) diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 41919b1a2..8eeb16430 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -12,24 +12,7 @@ subroutine rrtmg_sw_pre_init () end subroutine rrtmg_sw_pre_init !> \section arg_table_rrtmg_sw_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | -!! | idxday | daytime_points | daytime points | index | 1 | integer | | out | F | -!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb3 | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb4 | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | out | F | -!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rrtmg_sw_pre_run.html !! subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & nday, idxday, tsfg, tsfa, sfcalb1, sfcalb2, sfcalb3, sfcalb4, & From af996a7fb3253dd5e0e78160c97e81d423653464 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 12 Nov 2019 12:59:33 +0000 Subject: [PATCH 09/24] debugging rascnv in ccpp --- physics/GFS_phys_time_vary.fv3.F90 | 2 +- physics/GFS_suite_interstitial.F90 | 13 ++++--- physics/rascnv.F90 | 58 +++++++++++++++++------------- 3 files changed, 42 insertions(+), 31 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 2b79d6883..0303248b7 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -260,7 +260,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e do j = 1,Model%ny do i = 1,Model%nx ix = ix + 1 - if (ix .gt. Model%blksz(nb)) then + if (ix > Model%blksz(nb)) then ix = 1 nb = nb + 1 endif diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index d88992c64..cd7a0733f 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -509,14 +509,17 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr errmsg = '' errflg = 0 + lprnt = .false. do i=1,im - lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-29.55) < 0.201 & - .and. abs(xlat(i)*rad2dg+59.62) < 0.201 + lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.29) < 0.301 & + .and. abs(xlat(i)*rad2dg-18.75) < 0.301 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.29) < 0.201 & +! .and. abs(xlat(i)*rad2dg-17.45) < 0.201 ! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-169.453) < 0.501 & ! .and. abs(xlat(i)*rad2dg-72.96) < 0.501 -! if (kdt == 1) & -! write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & -! ' xlat=',xlat(i)*rad2dg,' me=',me + if (kdt == 1) & + write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & + ' xlat=',xlat(i)*rad2dg,' me=',me if (lprnt) then ipt = i write(0,*)' ipt=',ipt,'xlon=',xlon(i)*rad2dg,' xlat=',xlat(i)*rad2dg,' me=',me diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 6354f826a..f1a8da68e 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -17,7 +17,7 @@ module rascnv private logical :: is_initialized = .False. ! - integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s +! integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s integer, parameter :: idnmax=999 real (kind=kind_phys), parameter :: delt_c=1800.0/3600.0 & @@ -363,6 +363,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & real(kind=kind_phys) CFAC, TEM, sgc, ccwfac, tem1, tem2, rain & &, wfnc,tla,pl,qiid,qlid, c0, c0i, dlq_fac, sumq& &, rainp + integer :: nrcmax ! Maximum # of random clouds per 1200s ! Integer KCR, KFX, NCMX, NC, KTEM, I, L, lm1 & &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & @@ -385,15 +386,20 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & endif trcmin = -99999.0 if (ntk-2 > 0) trcmin(ntk-2) = 1.0d-4 + nrcmax = nrcm !> - Initialize CCPP error handling variables errmsg = '' errflg = 0 +! if (me == 0) write(0,*)' in ras ntr=',ntr,' kdt=',kdt,' ntk=',ntk +! if (me == 0) write(0,*)' in ras tke=',ccin(1,:,ntk),' kdt=',kdt & +! &, ' ntk=',ntk ! if (me == 0) write(0,*)' rann=',rannum(1,:),' kdt=',kdt -! if (lprnt) write(0,*)' in RAS fscav=',fscav_, ' mp_phys=',mp_phys & -! &, ' fscav=',fscav,' ntr=',ntr + if (lprnt) write(0,*)' in RAS fscav=',fscav_, ' mp_phys=',mp_phys & + &, ' fscav=',fscav,' ntr=',ntr & + &, ' rannum=',rannum(1,:) ! km1 = k - 1 kp1 = k + 1 @@ -519,8 +525,8 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & KTEM = MIN(K,KFMAX) KFX = KTEM - KCR -! if(lprnt)write(0,*)' enter RASCNV k=',k,' ktem=',ktem -! &, ' krmax=',krmax,' kfmax=',kfmax +! if(lprnt)write(0,*)' enter RASCNV k=',k,' ktem=',ktem & +! &, ' krmax=',krmax,' kfmax=',kfmax & ! &, ' kcr=',kcr, ' cdrag=',cdrag(ipr) IF (KFX > 0) THEN @@ -545,12 +551,12 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! ! ia = 1 ! -! write(0,*)' in rascnv: k=',k,'lat=',lat,' lprnt=',lprnt -! if (lprnt) then +! if (me == 0) write(0,*)' in rascnv: k=',k,' lprnt=',lprnt + if (lprnt) then ! if (me == 0) then -! write(0,*)' tin',(tin(ia,l),l=k,1,-1) -! write(0,*)' qin',(qin(ia,l),l=k,1,-1) -! endif + write(0,*)' tin',(tin(ia,l),l=k,1,-1) + write(0,*)' qin',(qin(ia,l),l=k,1,-1) + endif ! ! lprint = lprnt .and. ipt == ipr @@ -673,9 +679,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! endif ! end of if (flipv) then ! -! if (lprnt .and. ipt == ipr) write(0,*)' phi_h=',phi_h(:) -! if(lprint) write(0,*)' PRS=',PRS -! if(lprint) write(0,*)' PRSM=',PRSM + if (lprnt .and. ipt == ipr) write(0,*)' phi_h=',phi_h(:) + if(lprint) write(0,*)' PRS=',PRS + if(lprint) write(0,*)' PRSM=',PRSM ! if (lprint) then ! write(0,*)' qns=',qns(ia),' qoi=',qn0(ia,k),'qin=',qin(ia,1) ! if (me == 0) then @@ -912,7 +918,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & qiid = qii(ib) ! cloud top level ice before convection qlid = qli(ib) ! cloud top level water before convection ! -! if(lprint) write(0,*)' uvitke=',uvi(ib:k,ntk-2), ' ib=',ib +! if(lprint) write(0,*)' uvitke=',uvi(ib:k,ntk-2), ' ib=',ib & ! &,' trcmin=',trcmin(ntk-2) ! if (lprnt) then ! qoi_l(ib:k) = qoi(ib:k) @@ -938,7 +944,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! if (lprint) then ! write(0,*) ' rain=',rain,' ipt=',ipt ! write(0,*) ' after calling CLOUD TYPE IB= ', IB & -! &,' rain=',rain,' prskd=',prs(ib),' qli=',qli(ib),' qii=',qii(ib) +! &,' rain=',rain,' prskd=',prs(ib),' qli=',qli(ib),' qii=',qii(ib) & ! &,' rainp=',rainp ! write(0,*) ' phi_h=',phi_h(K-5:KP1) ! write(0,*) ' TOI=',(TOI(L),L=1,K),' me=',me,' ib=',ib @@ -1380,15 +1386,15 @@ SUBROUTINE CLOUD( & qcd(L) = zero enddo ! -! if (lprnt) then -! write(0,*) ' IN CLOUD for KD=',kd -! write(0,*) ' prs=',prs(Kd:KP1) -! write(0,*) ' phil=',phil(KD:K) + if (lprnt) then + write(0,*) ' IN CLOUD for KD=',kd + write(0,*) ' prs=',prs(Kd:KP1) + write(0,*) ' phil=',phil(KD:K) !! write(0,*) ' phih=',phih(kd:KP1),' kdt=',kdt -! write(0,*) ' phih=',phih(KD:KP1) -! write(0,*) ' toi=',toi -! write(0,*) ' qoi=',qoi -! endif + write(0,*) ' phih=',phih(KD:KP1) + write(0,*) ' toi=',toi + write(0,*) ' qoi=',qoi + endif ! CLDFRD = zero DOF = zero @@ -1769,8 +1775,10 @@ SUBROUTINE CLOUD( & ! ! if (ntk > 0 .and. do_aw) then if (ntk > 0) then - wcbase = min(2.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) -! wcbase = min(1.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) + if (rbl(ntk) > 0.0) then + wcbase = min(2.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) +! wcbase = min(1.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) + endif endif ! if (lprnt) write(0,*)' wcbase=',wcbase,' rbl=', From 052a0d5fc9a474a521f0a2f54c8df6a57f43970c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 12 Nov 2019 18:48:50 +0000 Subject: [PATCH 10/24] fix ia in rascnv and lat/lon for debug point --- physics/GFS_suite_interstitial.F90 | 4 ++-- physics/rascnv.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index cd7a0733f..c4d1abed2 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -511,8 +511,8 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr lprnt = .false. do i=1,im - lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.29) < 0.301 & - .and. abs(xlat(i)*rad2dg-18.75) < 0.301 + lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.18) < 0.101 & + .and. abs(xlat(i)*rad2dg-19.01) < 0.101 ! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.29) < 0.201 & ! .and. abs(xlat(i)*rad2dg-17.45) < 0.201 ! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-169.453) < 0.501 & diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index f1a8da68e..84f271eff 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -549,7 +549,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ENDDO ENDIF ! -! ia = 1 + ia = ipr ! ! if (me == 0) write(0,*)' in rascnv: k=',k,' lprnt=',lprnt if (lprnt) then From 947d7c99411f6b9b025380dd2465baa258c26062 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 16 Dec 2019 13:02:36 +0000 Subject: [PATCH 11/24] adding RAS and updating mg driver and shoc and and corresponding updates to other routines --- physics/GFS_DCNV_generic.F90 | 13 +- physics/GFS_DCNV_generic.meta | 18 - physics/GFS_MP_generic.F90 | 21 +- physics/GFS_PBL_generic.F90 | 77 +- physics/GFS_PBL_generic.meta | 91 ++ physics/GFS_suite_interstitial.F90 | 170 ++- physics/GFS_suite_interstitial.meta | 98 +- physics/GFS_surface_composites.F90 | 137 +- physics/GFS_surface_composites.meta | 43 + physics/GFS_surface_generic.F90 | 58 +- physics/GFS_surface_generic.meta | 26 +- physics/cs_conv.meta | 6 +- physics/cu_gf_driver.meta | 4 +- physics/dcyc2.f | 63 +- physics/gcm_shoc.F90 | 1924 ++++++++++++--------------- physics/gcm_shoc.meta | 264 ++-- physics/gscond.meta | 4 +- physics/m_micro.F90 | 30 +- physics/m_micro.meta | 22 +- physics/m_micro_interstitial.F90 | 78 +- physics/m_micro_interstitial.meta | 61 +- physics/micro_mg3_0.F90 | 60 +- physics/module_MYNNPBL_wrapper.meta | 4 +- physics/module_MYNNSFC_wrapper.meta | 2 +- physics/module_MYNNrad_post.meta | 8 +- physics/module_MYNNrad_pre.meta | 8 +- physics/moninshoc.f | 49 +- physics/moninshoc.meta | 2 +- physics/rascnv.F90 | 294 ++-- physics/sfc_cice.f | 9 +- physics/sfc_cice.meta | 8 - physics/sfc_diff.f | 66 +- physics/sfc_drv_ruc.meta | 2 +- physics/sfc_nst.f | 6 +- physics/ugwp_driver_v0.F | 4 +- 35 files changed, 1887 insertions(+), 1843 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 0acfbd19e..1ac2a7619 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -97,7 +97,7 @@ end subroutine GFS_DCNV_generic_post_finalize !! subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_ca, & isppt_deep, frain, rain1, dtf, cld1d, save_u, save_v, save_t, save_qv, gu0, gv0, gt0, & - gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, clw_ice, clw_liquid, npdf3d, num_p3d, ncnvcld3d, & + gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, & rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, & cape, tconvtend, qconvtend, uconvtend, vconvtend, errmsg, errflg) @@ -115,7 +115,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0, gq0_water_vapor real(kind=kind_phys), dimension(im,levs), intent(in) :: ud_mf, dd_mf, dt_mf real(kind=kind_phys), intent(in) :: con_g - real(kind=kind_phys), dimension(im,levs), intent(in) :: clw_ice, clw_liquid integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d real(kind=kind_phys), dimension(im), intent(inout) :: rainc, cldwrk @@ -144,7 +143,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c if (.not. ras .and. .not. cscnv) then if(do_ca) then do i=1,im - cape(i)=cld1d(i) + cape(i) = cld1d(i) enddo endif if (npdf3d == 3 .and. num_p3d == 4) then @@ -179,13 +178,13 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c do k=1,levs do i=1,im dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain -! dq3dt(i,k) = dq3dt(i,k) + (gq0_water_vapor(i,k)-save_qv(i,k)) * frain +! dq3dt(i,k) = dq3dt(i,k) + (gq0_water_vapor(i,k)-save_qv(i,k)) * frain du3dt(i,k) = du3dt(i,k) + (gu0(i,k)-save_u(i,k)) * frain dv3dt(i,k) = dv3dt(i,k) + (gv0(i,k)-save_v(i,k)) * frain -! upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) -! dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) -! det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) +! upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) +! dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) +! det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) enddo enddo endif ! if (ldiag3d) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index eae53a910..fb02f2ae5 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -360,24 +360,6 @@ kind = kind_phys intent = in optional = F -[clw_ice] - standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[clw_liquid] - standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [npdf3d] standard_name = number_of_3d_arrays_associated_with_pdf_based_clouds long_name = number of 3d arrays associated with pdf based clouds/mp diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 512257258..f8f97bfcb 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -154,7 +154,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt onebg = one/con_g do i = 1, im - rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit + rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit enddo !> - If requested (e.g. Zhao-Carr MP scheme), call calpreciptype() to calculate dominant @@ -193,11 +193,11 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (cal_pre) then ! hchuang: add dominant precipitation type algorithm ! - call calpreciptype (kdt, nrcm, im, ix, levs, levs+1, & - rann, xlat, xlon, gt0, & - gq0(:,:,1), prsl, prsi, & - rain, phii, tsfc, & !input - domr, domzr, domip, doms) ! output + call calpreciptype (kdt, nrcm, im, ix, levs, levs+1, & + rann, xlat, xlon, gt0, & + gq0(:,:,1), prsl, prsi, & + rain, phii, tsfc, & ! input + domr, domzr, domip, doms) ! output ! ! if (lprnt) print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ' ! &,DOMR(ipr),DOMZR(ipr),DOMIP(ipr),DOMS(ipr) @@ -252,7 +252,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt do k=1,levs do i=1,im dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain -! dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(i,k)) * frain +! dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(i,k)) * frain enddo enddo endif @@ -281,7 +281,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt ! determine convective rain/snow by surface temperature ! determine large-scale rain/snow by rain/snow coming out directly from MP - if (lsm/=lsm_ruc) then + if (lsm /= lsm_ruc) then do i = 1, im !tprcp(i) = max(0.0, rain(i) )! clu: rain -> tprcp ! DH now lines 245-250 srflag(i) = 0. ! clu: default srflag as 'rain' (i.e. 0) @@ -309,7 +309,8 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt enddo endif ! lsm==lsm_ruc elseif( .not. cal_pre) then - if (imp_physics == imp_physics_mg) then ! MG microphysics + if (imp_physics == imp_physics_mg) then ! MG microphysics + tem = con_day / (dtp * con_p001) ! mm / day do i=1,im tprcp(i) = max(0.0, rain(i) ) ! clu: rain -> tprcp if (rain(i)*tem > rainmin) then @@ -338,7 +339,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (cplchm) then do i = 1, im - rainc_cpl(i) = rainc_cpl(i) + rainc(i) + rainc_cpl(i) = rainc_cpl(i) + rainc(i) enddo endif diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 49401d6ae..16d7df01c 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -84,7 +84,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ntwa, ntia, ntgl, ntoz, ntke, ntkev, trans_aero, ntchs, ntchm, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & imp_physics_zhao_carr, imp_physics_mg, cplchm, ltaerosol, hybedmf, do_shoc, & - satmedmf, qgrs, vdftra, errmsg, errflg) + satmedmf, qgrs, vdftra, dvdftra, xlon, xlat, lprnt, ipt, kdt, me, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -99,11 +99,17 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg logical, intent(in) :: cplchm, ltaerosol, hybedmf, do_shoc, satmedmf - real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs - real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra + real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon + real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs + real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra, dvdftra + + logical, intent(inout) :: lprnt + integer, intent(inout) :: ipt + integer, intent(in) :: kdt, me character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(out) :: errflg + real(kind=kind_phys), parameter :: rad2dg = 180.0/3.14159265359 !local variables integer :: i, k, kk, k1, n @@ -112,6 +118,37 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, errmsg = '' errflg = 0 + + lprnt = .false. + ipt = 1 +! do i=1,im +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-294.37) < 0.101 & +! .and. abs(xlat(i)*rad2dg-4.1) < 0.101 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-308.88) < 0.101 & +! .and. abs(xlat(i)*rad2dg+29.16) < 0.101 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-311.08) < 0.101 & +! .and. abs(xlat(i)*rad2dg+28.27) < 0.101 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-113.48) < 0.101 & +! .and. abs(xlat(i)*rad2dg-21.07) < 0.101 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.29) < 0.201 & +! .and. abs(xlat(i)*rad2dg-17.45) < 0.201 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-169.453) < 0.501 & +! .and. abs(xlat(i)*rad2dg-72.96) < 0.501 +! if (kdt == 1) & +! write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & +! ' xlat=',xlat(i)*rad2dg,' me=',me +! if (lprnt) then +! ipt = i +! write(0,*)' GFS_PBL_generic_pre_run ipt=',ipt,'xlon=',xlon(i)*rad2dg,' xlat=',xlat(i)*rad2dg,' me=',me +! exit +! endif +! enddo +! if (lprnt) then +! write(0,*)' qgrsv=',qgrs(ipt,:,1) +! write(0,*)' qgrsw=',qgrs(ipt,:,2) +! write(0,*)' qgrsi=',qgrs(ipt,:,3) +! endif + !DH: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. ) if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then vdftra = qgrs @@ -272,7 +309,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & dq3dt_ozone, rd, cp,fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, fice, dusfc_cice, dvsfc_cice, dtsfc_cice, & - dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, errmsg, errflg) + dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, & + lprnt, ipt, kdt, me, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -287,6 +325,11 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu + logical, intent(inout) :: lprnt + integer, intent(inout) :: ipt + integer, intent(in) :: kdt, me + + real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac, fice @@ -463,10 +506,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dkt_cpl(1:im,1:levs-1) = dkt(1:im,1:levs-1) endif - if(cplflx)then - write(*,*)'Fatal error: CCPP is not ready for cplflx=true!!' - stop - endif +! if(cplflx)then +! write(*,*)'Fatal error: CCPP is not ready for cplflx=true!!' +! stop +! endif ! --- ... coupling insertion @@ -522,10 +565,14 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dtsfci_diag(i) = dtsfc1(i) dqsfci_diag(i) = dqsfc1(i) enddo - ! if (lprnt) then - ! write(0,*)' dusfc=',dusfc(ipr),' dusfc1=',dusfc1(ipr),' dtf=', - ! & dtf,' kdt=',kdt,' lat=',lat - ! endif +! if (lprnt) then +! write(0,*)' dusfc=',dusfc_diag(ipt),' dusfc1=',dusfc1(ipt), & +! & ' dvsfc=',dvsfc_diag(ipt),' dvsfc1=',dvsfc1(ipt), & +! & ' dtsfc=',dtsfc_diag(ipt),' dtsfc1=',dvsfc1(ipt), & +! & ' dtf=',dtf,' kdt=',kdt +! write(0,*)' dtdt=',dtdt(ipt,1:10)*86400 +! write(0,*)' dqidt=',dqdt(ipt,1:10,ntiw)*86400 +! endif if (ldiag3d) then if (lsidea) then @@ -540,9 +587,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, endif do k=1,levs do i=1,im - du3dt_PBL(i,k) = du3dt_PBL(i,k) + dudt(i,k) * dtf + du3dt_PBL(i,k) = du3dt_PBL(i,k) + dudt(i,k) * dtf du3dt_OGWD(i,k) = du3dt_OGWD(i,k) - dudt(i,k) * dtf - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + dvdt(i,k) * dtf + dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + dvdt(i,k) * dtf dv3dt_OGWD(i,k) = dv3dt_OGWD(i,k) - dvdt(i,k) * dtf enddo enddo diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 25e696add..2c30aee8f 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -291,6 +291,65 @@ kind = kind_phys intent = inout optional = F +[dvdftra] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = inout + optional = F +[ipt] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = inout + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1188,6 +1247,38 @@ kind = kind_phys intent = in optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = inout + optional = F +[ipt] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = inout + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index c4d1abed2..9f2debde2 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -264,23 +264,23 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif do i=1,im - dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf - ulwsfc(i) = ulwsfc(i) + adjsfculw(i)*dtf - psmean(i) = psmean(i) + pgr(i)*dtf ! mean surface pressure + dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf + ulwsfc(i) = ulwsfc(i) + adjsfculw(i)*dtf + psmean(i) = psmean(i) + pgr(i)*dtf ! mean surface pressure end do if (ldiag3d) then if (lsidea) then do k=1,levs do i=1,im - dt3dt_lw(i,k) = dt3dt_lw(i,k) + lwhd(i,k,1)*dtf - dt3dt_sw(i,k) = dt3dt_sw(i,k) + lwhd(i,k,2)*dtf - dt3dt_pbl(i,k) = dt3dt_pbl(i,k) + lwhd(i,k,3)*dtf + dt3dt_lw(i,k) = dt3dt_lw(i,k) + lwhd(i,k,1)*dtf + dt3dt_sw(i,k) = dt3dt_sw(i,k) + lwhd(i,k,2)*dtf + dt3dt_pbl(i,k) = dt3dt_pbl(i,k) + lwhd(i,k,3)*dtf dt3dt_dcnv(i,k) = dt3dt_dcnv(i,k) + lwhd(i,k,4)*dtf dt3dt_scnv(i,k) = dt3dt_scnv(i,k) + lwhd(i,k,5)*dtf - dt3dt_mp(i,k) = dt3dt_mp(i,k) + lwhd(i,k,6)*dtf - end do - end do + dt3dt_mp(i,k) = dt3dt_mp(i,k) + lwhd(i,k,6)*dtf + enddo + enddo else do k=1,levs do i=1,im @@ -297,7 +297,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl tx1(i) = 0.0 tx2(i) = 10.0 ctei_r(i) = 10.0 - end do + enddo if ((((imfshalcnv == 0 .and. shal_cnv) .or. old_monin) .and. mstrat) & .or. do_shoc) then @@ -491,7 +491,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr integer, intent(inout) :: ipt character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(out) :: errflg ! local variables integer :: i,k,n,tracers,kk @@ -510,49 +510,58 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr errflg = 0 lprnt = .false. - do i=1,im - lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.18) < 0.101 & - .and. abs(xlat(i)*rad2dg-19.01) < 0.101 + ipt = 1 +! do i=1,im +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-294.37) < 0.101 & +! .and. abs(xlat(i)*rad2dg-4.1) < 0.101 +! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-308.88) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg+29.16) < 0.101 +! lprnt = kdt >= 135 .and. abs(xlon(i)*rad2dg-95.27) < 0.101 & +! .and. abs(xlat(i)*rad2dg-26.08) < 0.101 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-311.08) < 0.101 & +! .and. abs(xlat(i)*rad2dg+28.27) < 0.101 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-113.48) < 0.101 & +! .and. abs(xlat(i)*rad2dg-21.07) < 0.101 ! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.29) < 0.201 & ! .and. abs(xlat(i)*rad2dg-17.45) < 0.201 ! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-169.453) < 0.501 & ! .and. abs(xlat(i)*rad2dg-72.96) < 0.501 - if (kdt == 1) & - write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & - ' xlat=',xlat(i)*rad2dg,' me=',me - if (lprnt) then - ipt = i - write(0,*)' ipt=',ipt,'xlon=',xlon(i)*rad2dg,' xlat=',xlat(i)*rad2dg,' me=',me - exit - endif - enddo +! if (kdt == 1) & +! write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & +! ' xlat=',xlat(i)*rad2dg,' me=',me +! if (lprnt) then +! ipt = i +! write(0,*)' ipt=',ipt,'xlon=',xlon(i)*rad2dg,' xlat=',xlat(i)*rad2dg,' me=',me +! exit +! endif +! enddo ! - !GF* The following section (initializing convective variables) is already executed in GFS_typedefs%interstitial_phys_reset - ! do k=1,levs - ! do i=1,im - ! clw(i,k,1) = 0.0 - ! clw(i,k,2) = -999.9 - ! enddo - ! enddo - ! if (Model%imfdeepcnv >= 0 .or. Model%imfshalcnv > 0 .or. & - ! (Model%npdf3d == 3 .and. Model%num_p3d == 4) .or. & - ! (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) ) then - ! do k=1,levs - ! do i=1,im - ! cnvc(i,k) = 0.0 - ! cnvw(i,k) = 0.0 - ! enddo - ! enddo - ! endif - ! if(imp_physics == 8) then - ! if(Model%ltaerosol) then - ! ice00 (:,:) = 0.0 - ! liq0 (:,:) = 0.0 - ! else - ! ice00 (:,:) = 0.0 - ! endif - ! endif - !*GF +!GF* The following section (initializing convective variables) is already executed in GFS_typedefs%interstitial_phys_reset +! do k=1,levs +! do i=1,im +! clw(i,k,1) = 0.0 +! clw(i,k,2) = -999.9 +! enddo +! enddo +! if (Model%imfdeepcnv >= 0 .or. Model%imfshalcnv > 0 .or. & +! (Model%npdf3d == 3 .and. Model%num_p3d == 4) .or. & +! (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) ) then +! do k=1,levs +! do i=1,im +! cnvc(i,k) = 0.0 +! cnvw(i,k) = 0.0 +! enddo +! enddo +! endif +! if(imp_physics == Model%imp_physics_thompson) then +! if(Model%ltaerosol) then +! ice00 (:,:) = 0.0 +! liq0 (:,:) = 0.0 +! else +! ice00 (:,:) = 0.0 +! endif +! endif +!*GF if (cscnv .or. satmedmf .or. trans_trac .or. ras) then tracers = 2 @@ -597,6 +606,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr rhc(i,k) = min(rhcmax, max(0.7, 1.0-tx2(i)*tem1*tem2)) enddo enddo + if (kdt == 1 .and. me == 0) write(0,*)' rhc=',rhc(1,:) else do k=1,levs do i=1,im @@ -636,7 +646,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr enddo if(ltaerosol) then save_qi(:,:) = clw(:,:,1) - save_qc(:,:) = clw(:,:,2) + save_qc(:,:) = clw(:,:,2) else save_qi(:,:) = clw(:,:,1) endif @@ -657,6 +667,10 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr rhc(:,:) = 1.0 endif ! end if_ntcw +! if (lprnt) write(0,*)' clwice=',clw(ipt,:,1) +! if (lprnt) write(0,*)' clwwat=',clw(ipt,:,2) +! if (lprnt) write(0,*)' rhc=',rhc(ipt,:) + end subroutine GFS_suite_interstitial_3_run end module GFS_suite_interstitial_3 @@ -755,16 +769,16 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to do k=1,levs do i=1,im gq0(i,k,ntlnc) = gq0(i,k,ntlnc) & - + max(0.0, (clw(i,k,2)-save_qc(i,k))) / liqm + + max(0.0, (clw(i,k,2)-save_qc(i,k))) / liqm gq0(i,k,ntinc) = gq0(i,k,ntinc) & - + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem + + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem enddo enddo else do k=1,levs do i=1,im gq0(i,k,ntinc) = gq0(i,k,ntinc) & - + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem + + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem enddo enddo endif @@ -796,3 +810,53 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to end subroutine GFS_suite_interstitial_4_run end module GFS_suite_interstitial_4 + + module GFS_suite_interstitial_5 + + contains + + subroutine GFS_suite_interstitial_5_init () + end subroutine GFS_suite_interstitial_5_init + + subroutine GFS_suite_interstitial_5_finalize() + end subroutine GFS_suite_interstitial_5_finalize + +#if 0 +!> \section arg_table_GFS_suite_interstitial_5_run Argument Table +!! \htmlinclude GFS_suite_interstitial_5_run.html +!! +#endif + subroutine GFS_suite_interstitial_5_run (im, levs, ntrac, ntcw, ntiw, nn, gq0, clw, errmsg, errflg) + + use machine, only: kind_phys + + implicit none + + ! interface variables + integer, intent(in) :: im, levs, ntrac, ntcw, ntiw, nn + + real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 + + real(kind=kind_phys), dimension(im, levs, nn), intent(out) :: clw + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + integer :: i,k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do k=1,levs + do i=1,im + clw(i,k,1) = gq0(i,k,ntiw) ! ice + clw(i,k,2) = gq0(i,k,ntcw) ! water + enddo + enddo + + end subroutine GFS_suite_interstitial_5_run + + end module GFS_suite_interstitial_5 + diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 0e322a819..c5371a6f6 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -526,7 +526,7 @@ optional = F [qgrs_cloud_water] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = mixing ratio of cloud water (condensate) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -1403,7 +1403,7 @@ units = flag dimensions = () type = logical - intent = in + intent = inout optional = F [ipt] standard_name = horizontal_index_of_printed_column @@ -1411,7 +1411,7 @@ units = index dimensions = () type = integer - intent = in + intent = inout optional = F [kdt] standard_name = index_of_time_step @@ -1449,7 +1449,7 @@ optional = F [save_qc] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = mixing ratio of cloud water (condensate) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -1682,7 +1682,7 @@ optional = F [save_qc] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = mixing ratio of cloud water (condensate) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -1751,3 +1751,91 @@ type = integer intent = out optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_interstitial_5_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[nn] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport + units = count + dimensions = () + type = integer + intent = in + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index cd5f3db11..a70579b1e 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -11,8 +11,7 @@ module GFS_surface_composites_pre public GFS_surface_composites_pre_init, GFS_surface_composites_pre_finalize, GFS_surface_composites_pre_run - real(kind=kind_phys), parameter :: one = 1.0d0 - real(kind=kind_phys), parameter :: zero = 0.0d0 + real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, epsln = 1.0d-10 contains @@ -25,7 +24,8 @@ end subroutine GFS_surface_composites_pre_finalize !> \section arg_table_GFS_surface_composites_pre_run Argument Table !! \htmlinclude GFS_surface_composites_pre_run.html !! - subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, landfrac, lakefrac, oceanfrac, & + subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cplwav2atm, & + landfrac, lakefrac, oceanfrac, & frland, dry, icy, lake, ocean, wet, cice, cimin, zorl, zorlo, zorll, zorl_ocn, & zorl_lnd, zorl_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, & tprcp_lnd, tprcp_ice, uustar, uustar_lnd, uustar_ice, weasd, weasd_ocn, & @@ -38,7 +38,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan ! Interface variables integer, intent(in ) :: im - logical, intent(in ) :: frac_grid, cplflx + logical, intent(in ) :: frac_grid, cplflx, cplwav2atm logical, dimension(im), intent(in ) :: flag_cice logical, dimension(im), intent(inout) :: dry, icy, lake, ocean, wet real(kind=kind_phys), intent(in ) :: cimin @@ -75,7 +75,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan frland(i) = landfrac(i) if (frland(i) > zero) dry(i) = .true. tem = one - frland(i) - if (tem > zero) then + if (tem > epsln) then if (flag_cice(i)) then if (cice(i) >= min_seaice*tem) then icy(i) = .true. @@ -90,18 +90,17 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan cice(i) = zero endif endif - if (icy(i)) tsfco(i) = max(tsfco(i), tisfc(i), tgice) +! if (icy(i)) tsfco(i) = max(tsfco(i), tisfc(i), tgice) else cice(i) = zero endif ! ocean/lake area that is not frozen - tem = max(zero, tem - cice(i)) - if (tem > zero) then + if (tem-cice(i) > epsln) then wet(i) = .true. ! there is some open water! ! if (icy(i)) tsfco(i) = max(tsfco(i), tgice) - if (icy(i)) tsfco(i) = max(tisfc(i), tgice) +! if (icy(i)) tsfco(i) = max(tisfc(i), tgice) endif enddo @@ -123,7 +122,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan if (cice(i) < one) then wet(i) = .true. ! tsfco(i) = tgice - tsfco(i) = max(tisfc(i), tgice) + if (.not. cplflx) tsfco(i) = max(tisfc(i), tgice) ! tsfco(i) = max((tsfc(i) - cice(i)*tisfc(i)) & ! / (one - cice(i)), tgice) endif @@ -133,11 +132,16 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan endif if (.not. cplflx .or. .not. frac_grid) then - do i=1,im - zorll(i) = zorl(i) - zorlo(i) = zorl(i) - !tisfc(i) = tsfc(i) - enddo + if (cplwav2atm) then + do i=1,im + zorll(i) = zorl(i) + enddo + else + do i=1,im + zorll(i) = zorl(i) + zorlo(i) = zorl(i) + enddo + endif endif do i=1,im @@ -148,8 +152,8 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan zorl_ocn(i) = zorlo(i) tsfc_ocn(i) = tsfco(i) tsurf_ocn(i) = tsfco(i) -! weasd_ocn(i) = weasd(i) -! snowd_ocn(i) = snowd(i) +! weasd_ocn(i) = weasd(i) +! snowd_ocn(i) = snowd(i) weasd_ocn(i) = zero snowd_ocn(i) = zero semis_ocn(i) = 0.984d0 @@ -173,13 +177,13 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan ep1d_ice(i) = zero gflx_ice(i) = zero semis_ice(i) = 0.95d0 - end if + endif enddo ! Assign sea ice temperature to interstitial variable do i = 1, im tice(i) = tisfc(i) - end do + enddo end subroutine GFS_surface_composites_pre_run @@ -208,15 +212,18 @@ end subroutine GFS_surface_composites_inter_finalize !! \htmlinclude GFS_surface_composites_inter_run.html !! subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_ocn, semis_lnd, semis_ice, adjsfcdlw, & - gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_ocn, errmsg, errflg) + gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_ocn, & + adjsfcusw, adjsfcdsw, adjsfcnsw, errmsg, errflg) implicit none ! Interface variables integer, intent(in ) :: im logical, dimension(im), intent(in ) :: dry, icy, wet - real(kind=kind_phys), dimension(im), intent(in ) :: semis_ocn, semis_lnd, semis_ice, adjsfcdlw + real(kind=kind_phys), dimension(im), intent(in ) :: semis_ocn, semis_lnd, semis_ice, adjsfcdlw, & + adjsfcdsw, adjsfcnsw real(kind=kind_phys), dimension(im), intent(inout) :: gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_ocn + real(kind=kind_phys), dimension(im), intent(out) :: adjsfcusw ! CCPP error handling character(len=*), intent(out) :: errmsg @@ -244,12 +251,14 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_ocn, semis ! - flux below the interface used by lnd/oc/ice models: ! down: sfcemis*adjsfcdlw; up: sfcemis*sigma*T**4 ! net = up - down = sfcemis * (sigma*T**4 - adjsfcdlw) + ! surface upwelling shortwave flux at current time is in adjsfcusw ! --- ... define the downward lw flux absorbed by ground do i=1,im if (dry(i)) gabsbdlw_lnd(i) = semis_lnd(i) * adjsfcdlw(i) if (icy(i)) gabsbdlw_ice(i) = semis_ice(i) * adjsfcdlw(i) if (wet(i)) gabsbdlw_ocn(i) = semis_ocn(i) * adjsfcdlw(i) + adjsfcusw(i) = adjsfcdsw(i) - adjsfcnsw(i) enddo end subroutine GFS_surface_composites_inter_run @@ -267,8 +276,7 @@ module GFS_surface_composites_post public GFS_surface_composites_post_init, GFS_surface_composites_post_finalize, GFS_surface_composites_post_run - real(kind=kind_phys), parameter :: one = 1.0d0 - real(kind=kind_phys), parameter :: zero = 0.0d0 + real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 contains @@ -284,7 +292,7 @@ end subroutine GFS_surface_composites_post_finalize !! #endif subroutine GFS_surface_composites_post_run ( & - im, cplflx, frac_grid, flag_cice, islmsk, dry, wet, icy, landfrac, lakefrac, oceanfrac, & + im, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, landfrac, lakefrac, oceanfrac, & zorl, zorlo, zorll, zorl_ocn, zorl_lnd, zorl_ice, & cd, cd_ocn, cd_lnd, cd_ice, cdq, cdq_ocn, cdq_lnd, cdq_ice, rb, rb_ocn, rb_lnd, rb_ice, stress, stress_ocn, stress_lnd, & stress_ice, ffmm, ffmm_ocn, ffmm_lnd, ffmm_ice, ffhh, ffhh_ocn, ffhh_lnd, ffhh_ice, uustar, uustar_ocn, uustar_lnd, & @@ -297,7 +305,7 @@ subroutine GFS_surface_composites_post_run ( implicit none integer, intent(in) :: im - logical, intent(in) :: cplflx, frac_grid + logical, intent(in) :: cplflx, frac_grid, cplwav2atm logical, dimension(im), intent(in) :: flag_cice, dry, wet, icy integer, dimension(im), intent(in) :: islmsk real(kind=kind_phys), dimension(im), intent(in) :: landfrac, lakefrac, oceanfrac, & @@ -320,8 +328,6 @@ subroutine GFS_surface_composites_post_run ( ! Local variables integer :: i real(kind=kind_phys) :: txl, txi, txo, tem - real(kind=kind_phys), parameter :: one = 1.0d0 - real(kind=kind_phys), parameter :: zero = 0.0d0 ! Initialize CCPP error handling variables errmsg = '' @@ -348,17 +354,17 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_ocn(i) fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_ocn(i) fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_ocn(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_ocn(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_ocn(i) ! not used again! Moorthi + !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_ocn(i) + !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_ocn(i) ! not used again! Moorthi cmm(i) = txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_ocn(i) chh(i) = txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_ocn(i) - !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_ocn(i) + !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_ocn(i) ep1d(i) = txl*ep1d_lnd(i) + txi*ep1d_ice(i) + txo*ep1d_ocn(i) - !weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + txo*weasd_ocn(i) - !snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) + txo*snowd_ocn(i) + !weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + txo*weasd_ocn(i) + !snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) + txo*snowd_ocn(i) weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) - !tprcp(i) = txl*tprcp_lnd(i) + txi*tprcp_ice(i) + txo*tprcp_ocn(i) + !tprcp(i) = txl*tprcp_lnd(i) + txi*tprcp_ice(i) + txo*tprcp_ocn(i) if (.not. flag_cice(i) .and. islmsk(i) == 2) then tem = one - txl @@ -373,7 +379,7 @@ subroutine GFS_surface_composites_post_run ( gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) + txo*gflx_ocn(i) endif tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_ocn(i) - !tsfc(i) = txl*tsfc_lnd(i) + txi*tsfc_ice(i) + txo*tsfc_ocn(i) + !tsfc(i) = txl*tsfc_lnd(i) + txi*tsfc_ice(i) + txo*tsfc_ocn(i) ! DH* NOTE THIS IS UNNECESSARY BECAUSE DONE BEFORE? Diag%cmm(i) = txl*cmm3(i,1) + txi*cmm3(i,2) + txo*cmm3(i,3) ! DH* NOTE THIS IS UNNECESSARY BECAUSE DONE BEFORE? Diag%chh(i) = txl*chh3(i,1) + txi*chh3(i,2) + txo*chh3(i,3) @@ -423,7 +429,7 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = uustar_lnd(i) fm10(i) = fm10_lnd(i) fh2(i) = fh2_lnd(i) - !tsurf(i) = tsurf_lnd(i) + !tsurf(i) = tsurf_lnd(i) tsfcl(i) = tsfc_lnd(i) cmm(i) = cmm_lnd(i) chh(i) = chh_lnd(i) @@ -431,13 +437,14 @@ subroutine GFS_surface_composites_post_run ( ep1d(i) = ep1d_lnd(i) weasd(i) = weasd_lnd(i) snowd(i) = snowd_lnd(i) - !tprcp(i) = tprcp_lnd(i) + !tprcp(i) = tprcp_lnd(i) evap(i) = evap_lnd(i) hflx(i) = hflx_lnd(i) qss(i) = qss_lnd(i) tsfc(i) = tsfc_lnd(i) - cmm(i) = cmm_lnd(i) - chh(i) = chh_lnd(i) + hice(i) = zero + cice(i) = zero + tisfc(i) = tsfc(i) elseif (islmsk(i) == 0) then zorl(i) = zorl_ocn(i) cd(i) = cd_ocn(i) @@ -449,7 +456,7 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = uustar_ocn(i) fm10(i) = fm10_ocn(i) fh2(i) = fh2_ocn(i) - !tsurf(i) = tsurf_ocn(i) + !tsurf(i) = tsurf_ocn(i) tsfco(i) = tsfc_ocn(i) cmm(i) = cmm_ocn(i) chh(i) = chh_ocn(i) @@ -457,13 +464,14 @@ subroutine GFS_surface_composites_post_run ( ep1d(i) = ep1d_ocn(i) weasd(i) = weasd_ocn(i) snowd(i) = snowd_ocn(i) - !tprcp(i) = tprcp_ocn(i) + !tprcp(i) = tprcp_ocn(i) evap(i) = evap_ocn(i) hflx(i) = hflx_ocn(i) qss(i) = qss_ocn(i) tsfc(i) = tsfc_ocn(i) - cmm(i) = cmm_ocn(i) - chh(i) = chh_ocn(i) + hice(i) = zero + cice(i) = zero + tisfc(i) = tsfc(i) else zorl(i) = zorl_ice(i) cd(i) = cd_ice(i) @@ -475,49 +483,34 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = uustar_ice(i) fm10(i) = fm10_ice(i) fh2(i) = fh2_ice(i) - !tsurf(i) = tsurf_ice(i) - if (.not. flag_cice(i)) then - tisfc(i) = tice(i) - endif + !tsurf(i) = tsurf_ice(i) cmm(i) = cmm_ice(i) chh(i) = chh_ice(i) gflx(i) = gflx_ice(i) ep1d(i) = ep1d_ice(i) weasd(i) = weasd_ice(i) snowd(i) = snowd_ice(i) - !tprcp(i) = cice(i)*tprcp_ice(i) + (one-cice(i))*tprcp_ocn(i) - evap(i) = evap_ice(i) - hflx(i) = hflx_ice(i) qss(i) = qss_ice(i) - tsfc(i) = tsfc_ice(i) - cmm(i) = cmm_ice(i) - chh(i) = chh_ice(i) + if (flag_cice(i)) then ! this was already done for lake ice in sfc_sice + txi = cice(i) + txo = one - txi + evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) + hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) + tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) + else + evap(i) = evap_ice(i) + hflx(i) = hflx_ice(i) + tsfc(i) = tsfc_ice(i) + tisfc(i) = tice(i) + endif endif zorll(i) = zorl_lnd(i) zorlo(i) = zorl_ocn(i) - if (flag_cice(i)) then ! this was already done for lake ice in sfc_sice - txi = cice(i) - txo = one - txi - evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) - hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) -! tsfc(i) = txi * tice(i) + txo * tsfc_ocn(i) - tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) - else ! return updated lake ice thickness & concentration to global array - if (islmsk(i) == 2) then - ! DH* NOT NEEDED ???? Sfcprop%hice(i) = zice(i) - ! DH* NOT NEEDED ???? cice(i) = fice(i) ! fice is fraction of lake area that is frozen - tisfc(i) = tice(i) - else ! this would be over open ocean or land (no ice fraction) - hice(i) = zero - cice(i) = zero - tisfc(i) = tsfc(i) - endif - endif - end do + enddo - end if ! if (frac_grid) + endif ! if (frac_grid) ! --- compositing done diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 74c6b9575..832d9227e 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -33,6 +33,14 @@ type = logical intent = in optional = F +[cplwav2atm] + standard_name = flag_for_wave_coupling_to_atm + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F [landfrac] standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land @@ -630,6 +638,33 @@ kind = kind_phys intent = inout optional = F +[adjsfcdsw] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcnsw] + standard_name = surface_net_downwelling_shortwave_flux + long_name = surface net downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcusw] + standard_name = surface_upwelling_shortwave_flux + long_name = surface upwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -668,6 +703,14 @@ type = logical intent = in optional = F +[cplwav2atm] + standard_name = flag_for_wave_coupling_to_atm + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F [frac_grid] standard_name = flag_for_fractional_grid long_name = flag for fractional grid diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 0b1e43e5c..95120a0b1 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -32,7 +32,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, pertz0, pertzt, pertshc, pertlai, pertvegf, z01d, zt1d, bexp1d, xlai1d, vegf1d, & cplflx, flag_cice, islmsk_cice,slimskin_cpl, dusfcin_cpl, dvsfcin_cpl, & dtsfcin_cpl, dqsfcin_cpl, ulwsfcin_cpl, ulwsfc_cice, dusfc_cice, dvsfc_cice, & - dtsfc_cice, dqsfc_cice, tisfc, tsfco, fice, hice, dry, icy, wet, & + dtsfc_cice, dqsfc_cice, tisfc, tsfco, fice, hice, & wind, u1, v1, cnvwind, errmsg, errflg) use surface_perturbation, only: cdfnor @@ -43,7 +43,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, integer, intent(in) :: im, levs, isot, ivegsrc integer, dimension(im), intent(in) :: islmsk integer, dimension(im), intent(inout) :: soiltyp, vegtype, slopetyp - logical, dimension(im), intent(in) :: dry, icy, wet real(kind=kind_phys), intent(in) :: con_g real(kind=kind_phys), dimension(im), intent(in) :: vfrac, stype, vtype, slope, prsik_1, prslk_1 @@ -87,7 +86,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(out) :: wind real(kind=kind_phys), dimension(im), intent(in ) :: u1, v1 ! surface wind enhancement due to convection - real(kind=kind_phys), dimension(im), intent(in ) :: cnvwind + real(kind=kind_phys), dimension(im), intent(inout ) :: cnvwind ! CCPP error handling character(len=*), intent(out) :: errmsg @@ -119,8 +118,8 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, if (do_sfcperts) then if (pertz0(1) > 0.) then z01d(:) = pertz0(1) * sfc_wts(:,1) - ! if (me == 0) print*,'sfc_wts(:,1) min and max',minval(sfc_wts(:,1)),maxval(sfc_wts(:,1)) - ! if (me == 0) print*,'z01d min and max ',minval(z01d),maxval(z01d) +! if (me == 0) print*,'sfc_wts(:,1) min and max',minval(sfc_wts(:,1)),maxval(sfc_wts(:,1)) +! if (me == 0) print*,'z01d min and max ',minval(z01d),maxval(z01d) endif if (pertzt(1) > 0.) then zt1d(:) = pertzt(1) * sfc_wts(:,2) @@ -131,13 +130,13 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, if (pertlai(1) > 0.) then xlai1d(:) = pertlai(1) * sfc_wts(:,4) endif - ! --- do the albedo percentile calculation in GFS_radiation_driver instead --- ! - ! if (pertalb(1) > 0.) then - ! do i=1,im - ! call cdfnor(sfc_wts(i,5),cdfz) - ! alb1d(i) = cdfz - ! enddo - ! endif +! --- do the albedo percentile calculation in GFS_radiation_driver instead --- ! +! if (pertalb(1) > 0.) then +! do i=1,im +! call cdfnor(sfc_wts(i,5),cdfz) +! alb1d(i) = cdfz +! enddo +! endif if (pertvegf(1) > 0.) then do i=1,im call cdfnor(sfc_wts(i,6),cdfz) @@ -172,9 +171,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, endif work3(i) = prsik_1(i) / prslk_1(i) - end do - do i=1,im !tsurf(i) = tsfc(i) zlvl(i) = phil(i,1) * onebg wind(i) = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & @@ -182,16 +179,18 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, !wind(i) = max(sqrt(Statein%ugrs(i,1)*Statein%ugrs(i,1) + & ! Statein%vgrs(i,1)*Statein%vgrs(i,1)) & ! + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0)), one) - end do + cnvwind(i) = zero - if(cplflx)then - write(*,*)'Fatal error: CCPP is not ready for cplflx=true!!' - stop - endif + enddo + +! if(cplflx)then +! write(*,*)'Fatal error: CCPP is not ready for cplflx=true!!' +! stop +! endif if (cplflx) then do i=1,im - islmsk_cice(i) = int(slimskin_cpl(i)+0.5) + islmsk_cice(i) = nint(slimskin_cpl(i)) if(islmsk_cice(i) == 4)then flag_cice(i) = .true. ulwsfc_cice(i) = ulwsfcin_cpl(i) @@ -218,8 +217,7 @@ module GFS_surface_generic_post public GFS_surface_generic_post_init, GFS_surface_generic_post_finalize, GFS_surface_generic_post_run - real(kind=kind_phys), parameter :: one = 1.0d0 - real(kind=kind_phys), parameter :: zero = 0.0d0 + real(kind=kind_phys), parameter :: zero = 0.0, one = 1.0d0 contains @@ -274,18 +272,18 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt errflg = 0 do i=1,im - epi(i) = ep1d(i) - gfluxi(i) = gflx(i) - t1(i) = tgrs_1(i) - q1(i) = qgrs_1(i) - u1(i) = ugrs_1(i) - v1(i) = vgrs_1(i) + epi(i) = ep1d(i) + gfluxi(i) = gflx(i) + t1(i) = tgrs_1(i) + q1(i) = qgrs_1(i) + u1(i) = ugrs_1(i) + v1(i) = vgrs_1(i) enddo if (cplflx .or. cplwav) then do i=1,im - u10mi_cpl (i) = u10m(i) - v10mi_cpl (i) = v10m(i) + u10mi_cpl(i) = u10m(i) + v10mi_cpl(i) = v10m(i) enddo endif diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index bccfa4e38..6bd18a3b8 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -509,30 +509,6 @@ kind = kind_phys intent = in optional = F -[dry] - standard_name = flag_nonzero_land_surface_fraction - long_name = flag indicating presence of some land surface area fraction - units = flag - dimensions = (horizontal_dimension) - type = logical - intent = in - optional = F -[icy] - standard_name = flag_nonzero_sea_ice_surface_fraction - long_name = flag indicating presence of some sea ice surface area fraction - units = flag - dimensions = (horizontal_dimension) - type = logical - intent = in - optional = F -[wet] - standard_name = flag_nonzero_wet_surface_fraction - long_name = flag indicating presence of some ocean or lake surface area fraction - units = flag - dimensions = (horizontal_dimension) - type = logical - intent = in - optional = F [wind] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level @@ -567,7 +543,7 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta index e1d6c3538..8d6ea6804 100644 --- a/physics/cs_conv.meta +++ b/physics/cs_conv.meta @@ -54,7 +54,7 @@ optional = F [clw1] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = mixing ratio of ice water in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -63,7 +63,7 @@ optional = F [clw2] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = mixing ratio of cloud water (condensate) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -144,7 +144,7 @@ optional = F [save_q2] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = mixing ratio of cloud water (condensate) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 1969f9464..5b0c45c3f 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -272,7 +272,7 @@ optional = F [cliw] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = mixing ratio of ice water in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -281,7 +281,7 @@ optional = F [clcw] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water in the convectively transported tracer array + long_name = mixing ratio of cloud water in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 92369d712..c7a1ddd59 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -313,17 +313,17 @@ subroutine dcyc2t3_run & if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) + & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) endif if (icy(i)) then tem2 = tsfc_ice(i) * tsfc_ice(i) adjsfculw_ice(i) = sfcemis_ice(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_ice(i)) * adjsfcdlw(i) + & + (one - sfcemis_ice(i)) * adjsfcdlw(i) endif if (wet(i)) then tem2 = tsfc_ocn(i) * tsfc_ocn(i) adjsfculw_ocn(i) = sfcemis_ocn(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_ocn(i)) * adjsfcdlw(i) + & + (one - sfcemis_ocn(i)) * adjsfcdlw(i) endif ! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) ! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) @@ -370,60 +370,3 @@ end subroutine dcyc2t3_run !> @} !----------------------------------- end module dcyc2t3 - - - - module dcyc2t3_post - - implicit none - - private - - public :: dcyc2t3_post_init,dcyc2t3_post_run,dcyc2t3_post_finalize - - contains - -!! \section arg_table_dcyc2t3_post_init Argument Table -!! - subroutine dcyc2t3_post_init() - end subroutine dcyc2t3_post_init - -!! \section arg_table_dcyc2t3_post_finalize Argument Table -!! - subroutine dcyc2t3_post_finalize() - end subroutine dcyc2t3_post_finalize - - -!> This subroutine contains CCPP-compliant dcyc2t3 that calulates -!! surface upwelling shortwave flux at current time. -!! -!! \section arg_table_dcyc2t3_post_run Argument Table -!! \htmlinclude dcyc2t3_post_run.html -!! - subroutine dcyc2t3_post_run( & - & im, adjsfcdsw, adjsfcnsw, adjsfcusw, & - & errmsg, errflg) - - use GFS_typedefs, only: GFS_diag_type - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: im - real(kind=kind_phys), dimension(im), intent(in) :: adjsfcdsw - real(kind=kind_phys), dimension(im), intent(in) :: adjsfcnsw - real(kind=kind_phys), dimension(im), intent(out) :: adjsfcusw - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - adjsfcusw(:) = adjsfcdsw(:) - adjsfcnsw(:) - - return - end subroutine dcyc2t3_post_run - - end module dcyc2t3_post - diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index 1f466c50d..f41b31225 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -24,29 +24,25 @@ end subroutine shoc_finalize !! \htmlinclude shoc_run.html !! #endif -subroutine shoc_run (ix, nx, nzm, do_shoc, shocaftcnv, mg3_as_mg2, imp_physics, imp_physics_gfdl, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_mg, fprcp, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, & - con_fvirt, gq0_cloud_ice, gq0_rain, gq0_snow, gq0_graupel, dtp, me, prsl, phii, phil, u, v, omega, rhc, supice, pcrit, & - cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & - skip_macro, clw_ice, clw_liquid, gq0_cloud_liquid, ncpl, ncpi, gt0, gq0_water_vapor, cld_sgs, tke, tkh, wthv_sec, & - errmsg, errflg) +subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & + dtp, me, prsl, delp, phii, phil, u, v, omega, rhc, & + supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & + gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & + cld_sgs, tke, tkh, wthv_sec, lprnt, ipr, errmsg, errflg) implicit none - integer, intent(in) :: ix, nx, nzm, imp_physics, imp_physics_gfdl, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_mg, fprcp, me - logical, intent(in) :: do_shoc, shocaftcnv, mg3_as_mg2 + integer, intent(in) :: ix, nx, nzm, me, ipr, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc + logical, intent(in) :: lprnt real(kind=kind_phys), intent(in) :: tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & - dtp, supice, pcrit, cefac, cesfac, tkef1, dis_opt + dtp, supice, pcrit, cefac, cesfac, tkef1, dis_opt ! - real(kind=kind_phys), intent(in), dimension(nx) :: hflx, evap - real(kind=kind_phys), intent(in), dimension(nx,nzm) :: gq0_cloud_ice, gq0_rain, gq0_snow, gq0_graupel, prsl, phil, & - u, v, omega, rhc, prnum + real(kind=kind_phys), intent(in), dimension(nx) :: hflx, evap + real(kind=kind_phys), intent(in), dimension(nx,nzm) :: prsl, delp, phil, u, v, omega, rhc, prnum real(kind=kind_phys), intent(in), dimension(nx,nzm+1) :: phii ! - logical, intent(inout) :: skip_macro - real(kind=kind_phys), intent(inout), dimension(nx,nzm) :: clw_ice, clw_liquid, gq0_cloud_liquid, ncpl, ncpi, gt0, & - gq0_water_vapor, cld_sgs, tke, tkh, wthv_sec + real(kind=kind_phys), intent(inout), dimension(nx,nzm) :: gt0, cld_sgs, tke, tkh, wthv_sec + real(kind=kind_phys), intent(inout), dimension(nx,nzm,ntrac) :: gq0 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -56,90 +52,64 @@ subroutine shoc_run (ix, nx, nzm, do_shoc, shocaftcnv, mg3_as_mg2, imp_physics, integer :: i, k real(kind=kind_phys) :: tem - real(kind=kind_phys), dimension(nx,nzm) :: qsnw ! qsnw can be local to this routine - real(kind=kind_phys), dimension(nx,nzm) :: qgl ! qgl can be local to this routine + real(kind=kind_phys), dimension(nx,nzm) :: qi ! local array of suspended cloud ice + real(kind=kind_phys), dimension(nx,nzm) :: qc ! local array of suspended cloud water + real(kind=kind_phys), dimension(nx,nzm) :: qsnw ! local array of suspended snowq + real(kind=kind_phys), dimension(nx,nzm) :: qrn ! local array of suepended rain + real(kind=kind_phys), dimension(nx,nzm) :: qgl ! local array of suspended graupel + real(kind=kind_phys), dimension(nx,nzm) :: ncpl ! local array of cloud water number concentration + real(kind=kind_phys), dimension(nx,nzm) :: ncpi ! local array of cloud ice number concentration ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (shocaftcnv) then - if (imp_physics == imp_physics_mg) then - if (abs(fprcp) == 1 .or. mg3_as_mg2) then - do k=1,nzm - do i=1,nx - !GF - gq0(ntrw) is passed in directly, no need to copy - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = 0.0 - enddo - enddo - elseif (fprcp > 1) then - do k=1,nzm - do i=1,nx - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) + gq0_graupel(i,k) - qgl(i,k) = 0.0 - enddo - enddo - endif - endif - else - if (imp_physics == imp_physics_mg) then - do k=1,nzm + if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme + do k=1,nzm do i=1,nx - !clw_ice(i,k) = gq0_cloud_ice(i,k) ! ice - !clw_liquid(i,k) = gq0_cloud_liquid(i,k) ! water - !GF - since gq0(ntlnc/ntinc) are passed in directly, no need to copy - !ncpl(i,k) = Stateout%gq0(i,k,ntlnc) - !ncpi(i,k) = Stateout%gq0(i,k,ntinc) + qc(i,k) = gq0(i,k,ntcw) + if (abs(qc(i,k)) < epsq) then + qc(i,k) = 0.0 + endif + tem = qc(i,k) * max(0.0, MIN(1.0, (tcr-gt0(i,k))*tcrf)) + qi(i,k) = tem ! ice + qc(i,k) = qc(i,k) - tem ! water + qrn(i,k) = 0.0 + qsnw(i,k) = 0.0 + ncpl(i,k) = 0 + ncpi(i,k) = 0 enddo enddo - if (abs(fprcp) == 1 .or. mg3_as_mg2) then - do k=1,nzm - do i=1,nx - !GF - gq0(ntrw) is passed in directly, no need to copy - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = 0.0 + else + if (ntgl > 0) then ! graupel exists - combine graupel with snow + do k=1,nzm + do i=1,nx + qc(i,k) = gq0(i,k,ntcw) + qi(i,k) = gq0(i,k,ntiw) + qrn(i,k) = gq0(i,k,ntrw) + qsnw(i,k) = gq0(i,k,ntsw) + gq0(i,k,ntgl) enddo enddo - elseif (fprcp > 1) then - do k=1,nzm - do i=1,nx - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) + gq0_graupel(i,k) - qgl(i,k) = 0.0 - !clw_ice(i,k) = clw_ice(i,k) + gq0_graupel(i,k) + else ! no graupel + do k=1,nzm + do i=1,nx + qc(i,k) = gq0(i,k,ntcw) + qi(i,k) = gq0(i,k,ntiw) + qrn(i,k) = gq0(i,k,ntrw) + qsnw(i,k) = gq0(i,k,ntsw) enddo enddo - endif - elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP - needs modify for condensation - do k=1,nzm - do i=1,nx - clw_ice(i,k) = gq0_cloud_ice(i,k) ! ice - clw_liquid(i,k) = gq0_cloud_liquid(i,k) ! water - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = 0.0 - enddo - enddo - elseif (imp_physics == imp_physics_zhao_carr .or. imp_physics == imp_physics_zhao_carr_pdf) then - do k=1,nzm - do i=1,nx - if (abs(gq0_cloud_liquid(i,k)) < epsq) then - gq0_cloud_liquid(i,k) = 0.0 - endif - tem = gq0_cloud_liquid(i,k) * max(0.0, MIN(1.0, (tcr-gt0(i,k))*tcrf)) - clw_ice(i,k) = tem ! ice - clw_liquid(i,k) = gq0_cloud_liquid(i,k) - tem ! water - qsnw(i,k) = 0.0 - qgl(i,k) = 0.0 - enddo - enddo endif - endif !shocaftcnv + if (ntlnc > 0) then + do k=1,nzm + do i=1,nx + ncpl(i,k) = gq0(i,k,ntlnc) + ncpi(i,k) = gq0(i,k,ntinc) + enddo + enddo + endif + endif ! phy_f3d(1,1,ntot3d-2) - shoc determined sgs clouds ! phy_f3d(1,1,ntot3d-1) - shoc determined diffusion coefficients @@ -148,37 +118,35 @@ subroutine shoc_run (ix, nx, nzm, do_shoc, shocaftcnv, mg3_as_mg2, imp_physics, !GFDL lat has no meaning inside of shoc - changed to "1" - ! DH* can we pass in gq0_graupel? is that zero? the original code - ! passes in qgl which is zero (always? sometimes?), in shoc_work - ! this qgl gets added to qpi, qpi = qpi_i + qgl with qpi_i = qsnw; - ! - with the above qsnw(i,k) = gq0_snow(i,k) + gq0_graupel(i,k), - ! would that be double counting? *DH - call shoc_work (ix, nx, 1, nzm, nzm+1, dtp, me, 1, prsl, & - phii, phil, u, v, omega, gt0, & - gq0_water_vapor, clw_ice, clw_liquid, qsnw, gq0_rain, & - qgl, rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & - cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, .false., 1, ncpl, ncpi, & - con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt) - - !if (.not.shocaftcnv) then - ! if (imp_physics == imp_physics_mg .and. fprcp > 1) then - ! do k=1,nzm - ! do i=1,nx - ! clw_ice(i,k) = clw_ice(i,k) - gq0_graupel(i,k) - ! enddo - ! enddo - ! endif - !endif ! .not. shocaftcnv - - !GF since gq0(ntlnc/ntinc) are passed in directly, no need to copy back - ! if (imp_physics == Model%imp_physics_mg) then - ! do k=1,nzm - ! do i=1,nx - ! Stateout%gq0(i,k,ntlnc) = ncpl(i,k) - ! Stateout%gq0(i,k,ntinc) = ncpi(i,k) - ! enddo - ! enddo - ! endif + call shoc_work (ix, nx, nzm, nzm+1, dtp, me, 1, prsl, delp, & + phii, phil, u, v, omega, gt0, gq0(:,:,1), qi, qc, qsnw, qrn, & + rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & + cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, lprnt, ipr, & + ntlnc, ncpl, ncpi, & + con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt) + + if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme + do k=1,nzm + do i=1,nx + gq0(i,k,ntcw) = qc(i,k) + qi(i,k) + enddo + enddo + else + do k=1,nzm + do i=1,nx + gq0(i,k,ntcw) = qc(i,k) + gq0(i,k,ntiw) = qi(i,k) + enddo + enddo + if (ntlnc > 0) then + do k=1,nzm + do i=1,nx + gq0(i,k,ntlnc) = ncpl(i,k) + gq0(i,k,ntinc) = ncpi(i,k) + enddo + enddo + endif + endif end subroutine shoc_run @@ -197,27 +165,29 @@ end subroutine shoc_run ! replacing fac_fus by fac_sub ! S.Moorthi - 00-00-17 - added an alternate option for near boundary cek following ! Scipion et. al., from U. Oklahoma. - subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & - prsl, phii, phil, u, v, omega, tabs, & - qwv, qi, qc, qpi_i, qpl, qgl, rhc, supice, & - pcrit, cefac, cesfac, tkef1, dis_opt, & - cld_sgs, tke, hflx, evap, prnum, tkh, & - wthv_sec, lprnt, ipr, ncpl, ncpi, & - cp, ggr, lcond, lfus, rv, rgas, pi, epsv) + subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & + prsl, delp, phii, phil, u, v, omega, tabs, & + qwv, qi, qc, qpi, qpl, rhc, supice, & + pcrit, cefac, cesfac, tkef1, dis_opt, & + cld_sgs, tke, hflx, evap, prnum, tkh, & + wthv_sec, lprnt, ipr, ntlnc, ncpl, ncpi, & + cp, ggr, lcond, lfus, rv, rgas, pi, epsv) use funcphys , only : fpvsl, fpvsi, fpvs ! saturation vapor pressure for water & ice implicit none - real, intent(in) :: cp, ggr, lcond, lfus, rv, rgas, pi, epsv + logical, intent(in) :: lprnt + integer, intent(in) :: ipr + real, intent(in) :: cp, ggr, lcond, lfus, rv, rgas, pi, epsv integer, intent(in) :: ix ! max number of points in the physics window in the x integer, intent(in) :: nx ! Number of points in the physics window in the x - integer, intent(in) :: ny ! and y directions integer, intent(in) :: me ! MPI rank integer, intent(in) :: lat ! latitude integer, intent(in) :: nzm ! Number of vertical layers integer, intent(in) :: nz ! Number of layer interfaces (= nzm + 1) + integer, intent(in) :: ntlnc ! index of liquid water number concentration real, intent(in) :: dtn ! Physics time step, s real, intent(in) :: pcrit ! pressure in Pa below which additional tke dissipation is applied @@ -231,58 +201,61 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & ! The interface is talored to GFS in a sense that input variables are 2D - real, intent(in) :: prsl (ix,ny,nzm) ! mean layer presure - real, intent(in) :: phii (ix,ny,nz ) ! interface geopotential height - real, intent(in) :: phil (ix,ny,nzm) ! layer geopotential height - real, intent(in) :: u (ix,ny,nzm) ! u-wind, m/s - real, intent(in) :: v (ix,ny,nzm) ! v-wind, m/s - real, intent(in) :: omega (ix,ny,nzm) ! omega, Pa/s - real, intent(inout) :: tabs (ix,ny,nzm) ! temperature, K - real, intent(inout) :: qwv (ix,ny,nzm) ! water vapor mixing ratio, kg/kg - real, intent(inout) :: qc (ix,ny,nzm) ! cloud water mixing ratio, kg/kg - real, intent(inout) :: qi (ix,ny,nzm) ! cloud ice mixing ratio, kg/kg + real, intent(in) :: prsl (ix,nzm) ! mean layer presure + real, intent(in) :: delp (ix,nzm) ! layer presure depth + real, intent(in) :: phii (ix,nz ) ! interface geopotential height + real, intent(in) :: phil (ix,nzm) ! layer geopotential height + real, intent(in) :: u (ix,nzm) ! u-wind, m/s + real, intent(in) :: v (ix,nzm) ! v-wind, m/s + real, intent(in) :: omega (ix,nzm) ! omega, Pa/s + real, intent(inout) :: tabs (ix,nzm) ! temperature, K + real, intent(inout) :: qwv (ix,nzm) ! water vapor mixing ratio, kg/kg + real, intent(inout) :: qc (ix,nzm) ! cloud water mixing ratio, kg/kg + real, intent(inout) :: qi (ix,nzm) ! cloud ice mixing ratio, kg/kg ! Anning Cheng 03/11/2016 SHOC feedback to number concentration - real, intent(inout) :: ncpl (nx,ny,nzm) ! cloud water number concentration,/m^3 - real, intent(inout) :: ncpi (nx,ny,nzm) ! cloud ice number concentration,/m^3 - real, intent(in) :: qpl (nx,ny,nzm) ! rain mixing ratio, kg/kg - not used at this time - real, intent(in) :: qpi_i (nx,ny,nzm) ! snow mixing ratio, kg/kg - not used at this time - real, intent(in) :: qgl (nx,ny,nzm) ! graupel mixing ratio, kg/kg - not used at this time - real, intent(in) :: rhc (nx,ny,nzm) ! critical relative humidity - real, intent(in) :: supice ! ice supersaturation parameter - real, intent(inout) :: cld_sgs(ix,ny,nzm) ! sgs cloud fraction -! real, intent(inout) :: cld_sgs(nx,ny,nzm) ! sgs cloud fraction - real, intent(inout) :: tke (ix,ny,nzm) ! turbulent kinetic energy. m**2/s**2 -! real, intent(inout) :: tk (nx,ny,nzm) ! eddy viscosity - real, intent(inout) :: tkh (ix,ny,nzm) ! eddy diffusivity - real, intent(in) :: prnum (nx,ny,nzm) ! turbulent Prandtl number - real, intent(inout) :: wthv_sec (ix,ny,nzm) ! Buoyancy flux, K*m/s - - real, parameter :: zero=0.0, one=1.0, half=0.5, two=2.0, eps=0.622, & - three=3.0, oneb3=one/three, twoby3=two/three - real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.0, & - skew_facw=1.2, skew_fact=0.0, & - tkhmax=300.0 - real :: lsub, fac_cond, fac_fus, cpolv, fac_sub, ggri, kapa, gocp, rog, sqrtpii, & - epsterm, onebeps, onebrvcp + real, intent(inout) :: ncpl (nx,nzm) ! cloud water number concentration,/m^3 + real, intent(inout) :: ncpi (nx,nzm) ! cloud ice number concentration,/m^3 + real, intent(in) :: qpl (nx,nzm) ! rain mixing ratio, kg/kg + real, intent(in) :: qpi (nx,nzm) ! snow mixing ratio, kg/kg + + real, intent(in) :: rhc (nx,nzm) ! critical relative humidity + real, intent(in) :: supice ! ice supersaturation parameter + real, intent(out) :: cld_sgs(ix,nzm) ! sgs cloud fraction +! real, intent(inout) :: cld_sgs(nx,nzm) ! sgs cloud fraction + real, intent(inout) :: tke (ix,nzm) ! turbulent kinetic energy. m**2/s**2 +! real, intent(inout) :: tk (nx,nzm) ! eddy viscosity + real, intent(inout) :: tkh (ix,nzm) ! eddy diffusivity + real, intent(in) :: prnum (nx,nzm) ! turbulent Prandtl number + real, intent(inout) :: wthv_sec (ix,nzm) ! Buoyancy flux, K*m/s + + real, parameter :: zero=0.0d0, one=1.0d0, half=0.5d0, two=2.0d0, eps=0.622d0, & + three=3.0d0, oneb3=one/three, twoby3=two/three, fourb3=twoby3+twoby3 + real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.d0, & + nmin = 1.0d0, RI_cub = 6.4d-14, RL_cub = 1.0d-15, & + skew_facw=1.2d0, skew_fact=0.d0, & + tkhmax=300.d0, qcmin=1.0d-9 + real :: lsub, fac_cond, fac_fus, cpolv, fac_sub, ggri, kapa, gocp, & + rog, sqrtpii, epsterm, onebeps, onebrvcp ! SHOC tunable parameters - real, parameter :: lambda = 0.04 -! real, parameter :: min_tke = 1e-6 ! Minumum TKE value, m**2/s**2 - real, parameter :: min_tke = 1e-4 ! Minumum TKE value, m**2/s**2 -! real, parameter :: max_tke = 100.0 ! Maximum TKE value, m**2/s**2 - real, parameter :: max_tke = 40.0 ! Maximum TKE value, m**2/s**2 + real, parameter :: lambda = 0.04d0 +! real, parameter :: min_tke = 1.0d-6 ! Minumum TKE value, m**2/s**2 + real, parameter :: min_tke = 1.0d-4 ! Minumum TKE value, m**2/s**2 +! real, parameter :: max_tke = 100.0d0 ! Maximum TKE value, m**2/s**2 + real, parameter :: max_tke = 40.0d0 ! Maximum TKE value, m**2/s**2 ! Maximum turbulent eddy length scale, m -! real, parameter :: max_eddy_length_scale = 2000. - real, parameter :: max_eddy_length_scale = 1000. +! real, parameter :: max_eddy_length_scale = 2000.0d0 + real, parameter :: max_eddy_length_scale = 1000.0d0 ! Maximum "return-to-isotropy" time scale, s - real, parameter :: max_eddy_dissipation_time_scale = 2000. - real, parameter :: Pr = 1.0 ! Prandtl number + real, parameter :: max_eddy_dissipation_time_scale = 2000.d0 + real, parameter :: Pr = 1.0d0 ! Prandtl number ! Constants for the TKE dissipation term based on Deardorff (1980) - real, parameter :: pt19=0.19, pt51=0.51, pt01=0.01, atmin=0.01, atmax=one-atmin - real, parameter :: Cs = 0.15, epsln=1.0e-6 - real, parameter :: Ck = 0.1 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 + real, parameter :: pt19=0.19d0, pt51=0.51d0, pt01=0.01d0, atmin=0.01d0, atmax=one-atmin + real, parameter :: Cs = 0.15d0, epsln=1.0d-6 +! real, parameter :: Ck = 0.2d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 + real, parameter :: Ck = 0.1d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 ! real, parameter :: Ce = Ck**3/(0.7*Cs**4) ! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 2.2 @@ -295,79 +268,75 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & real, parameter :: Ce = Ck**3/Cs**4, Ces = Ce ! real, parameter :: Ce = Ck**3/Cs**4, Ces = Ce*3.0/0.7 -! real, parameter :: vonk=0.35 ! Von Karman constant - real, parameter :: vonk=0.4 ! Von Karman constant Moorthi - as in GFS - real, parameter :: tscale=400.! time scale set based off of similarity results of BK13, s - real, parameter :: w_tol_sqd = 4.0e-04 ! Min vlaue of second moment of w +! real, parameter :: vonk=0.35 ! Von Karman constant + real, parameter :: vonk=0.4d0 ! Von Karman constant Moorthi - as in GFS + real, parameter :: tscale=400.0d0 ! time scale set based off of similarity results of BK13, s + real, parameter :: w_tol_sqd = 4.0d-04 ! Min vlaue of second moment of w ! real, parameter :: w_tol_sqd = 1.0e-04 ! Min vlaue of second moment of w - real, parameter :: w_thresh = 0.0, thresh = 0.0 - real, parameter :: w3_tol = 1.0e-20 ! Min vlaue of third moment of w + real, parameter :: w_thresh = 0.0d0, thresh = 0.0d0 + real, parameter :: w3_tol = 1.0d-20 ! Min vlaue of third moment of w ! These parameters are a tie-in with a microphysical scheme ! Double check their values for the Zhao-Carr scheme. - real, parameter :: tbgmin = 233.16 ! Minimum temperature for cloud water., K (ZC) -! real, parameter :: tbgmin = 258.16 ! Minimum temperature for cloud water., K (ZC) -! real, parameter :: tbgmin = 253.16 ! Minimum temperature for cloud water., K - real, parameter :: tbgmax = 273.16 ! Maximum temperature for cloud ice, K + real, parameter :: tbgmin = 233.16d0 ! Minimum temperature for cloud water., K (ZC) +! real, parameter :: tbgmin = 258.16d0 ! Minimum temperature for cloud water., K (ZC) +! real, parameter :: tbgmin = 253.16d0 ! Minimum temperature for cloud water., K + real, parameter :: tbgmax = 273.16d0 ! Maximum temperature for cloud ice, K real, parameter :: a_bg = one/(tbgmax-tbgmin) ! ! Parameters to tune the second order moments- No tuning is performed currently - real, parameter :: thl2tune = 1.0, qw2tune = 1.0, qwthl2tune = 1.0, & -! thl_tol = 1.e-4, rt_tol = 1.e-8, basetemp = 300.0 - thl_tol = 1.e-2, rt_tol = 1.e-4, basetemp = 300.0 +! real, parameter :: thl2tune = 2.0d0, qw2tune = 2.0d0, qwthl2tune = 2.0d0, & + real, parameter :: thl2tune = 1.0d0, qw2tune = 1.0d0, qwthl2tune = 1.0d0, & +! thl_tol = 1.0d-4, rt_tol = 1.0d-8, basetemp = 300.0d0 + thl_tol = 1.0d-2, rt_tol = 1.0d-4 integer, parameter :: nitr=6 ! Local variables. Note that pressure is in millibars in the SHOC code. - logical lprnt - integer ipr + real zl (nx,nzm) ! height of the pressure levels above surface, m + real zi (nx,nz) ! height of the interface levels, m + real adzl (nx,nzm) ! layer thickness i.e. zi(k+1)-zi(k) - defined at levels + real adzi (nx,nz) ! level thickness i.e. zl(k)-zl(k-1) - defined at interface - real zl (nx,ny,nzm) ! height of the pressure levels above surface, m - real zi (nx,ny,nz) ! height of the interface levels, m - real adzl (nx,ny,nzm) ! layer thickness i.e. zi(k+1)-zi(k) - defined at levels - real adzi (nx,ny,nz) ! level thickness i.e. zl(k)-zl(k-1) - defined at interface - - real hl (nx,ny,nzm) ! liquid/ice water static energy , K - real qv (nx,ny,nzm) ! water vapor, kg/kg - real qcl (nx,ny,nzm) ! liquid water (condensate), kg/kg - real qci (nx,ny,nzm) ! ice water (condensate), kg/kg - real w (nx,ny,nzm) ! z-wind, m/s - real bet (nx,ny,nzm) ! ggr/tv0 - real gamaz (nx,ny,nzm) ! ggr/cp*z - real qpi (nx,ny,nzm) ! snow + graupel mixing ratio, kg/kg -! real qpl (nx,ny,nzm) ! rain mixing ratio, kg/kg + real hl (nx,nzm) ! liquid/ice water static energy , K + real qv (nx,nzm) ! water vapor, kg/kg + real qcl (nx,nzm) ! liquid water (condensate), kg/kg + real qci (nx,nzm) ! ice water (condensate), kg/kg + real w (nx,nzm) ! z-wind, m/s + real bet (nx,nzm) ! ggr/tv0 + real gamaz (nx,nzm) ! ggr/cp*z ! Moments of the trivariate double Gaussian PDF for the SGS total water mixing ratio ! SGS liquid/ice static energy, and vertical velocity - real qw_sec (nx,ny,nzm) ! Second moment total water mixing ratio, kg^2/kg^2 - real thl_sec (nx,ny,nzm) ! Second moment liquid/ice static energy, K^2 - real qwthl_sec(nx,ny,nzm) ! Covariance tot. wat. mix. ratio and static energy, K*kg/kg - real wqw_sec (nx,ny,nzm) ! Turbulent flux of tot. wat. mix., kg/kg*m/s - real wthl_sec (nx,ny,nzm) ! Turbulent flux of liquid/ice static energy, K*m/s - real w_sec (nx,ny,nzm) ! Second moment of vertical velocity, m**2/s**2 - real w3 (nx,ny,nzm) ! Third moment of vertical velocity, m**3/s**3 - real wqp_sec (nx,ny,nzm) ! Turbulent flux of precipitation, kg/kg*m/s + real qw_sec (nx,nzm) ! Second moment total water mixing ratio, kg^2/kg^2 + real thl_sec (nx,nzm) ! Second moment liquid/ice static energy, K^2 + real qwthl_sec(nx,nzm) ! Covariance tot. wat. mix. ratio and static energy, K*kg/kg + real wqw_sec (nx,nzm) ! Turbulent flux of tot. wat. mix., kg/kg*m/s + real wthl_sec (nx,nzm) ! Turbulent flux of liquid/ice static energy, K*m/s + real w_sec (nx,nzm) ! Second moment of vertical velocity, m**2/s**2 + real w3 (nx,nzm) ! Third moment of vertical velocity, m**3/s**3 + real wqp_sec (nx,nzm) ! Turbulent flux of precipitation, kg/kg*m/s ! Eddy length formulation - real smixt (nx,ny,nzm) ! Turbulent length scale, m - real isotropy (nx,ny,nzm) ! "Return-to-isotropy" eddy dissipation time scale, s -! real isotropy_debug (nx,ny,nzm) ! Return to isotropy scale, s without artificial limits - real brunt (nx,ny,nzm) ! Moist Brunt-Vaisalla frequency, s^-1 - real conv_vel2(nx,ny,nzm) ! Convective velocity scale cubed, m^3/s^3 + real smixt (nx,nzm) ! Turbulent length scale, m + real isotropy (nx,nzm) ! "Return-to-isotropy" eddy dissipation time scale, s +! real isotropy_debug (nx,nzm) ! Return to isotropy scale, s without artificial limits + real brunt (nx,nzm) ! Moist Brunt-Vaisalla frequency, s^-1 + real conv_vel2(nx,nzm) ! Convective velocity scale cubed, m^3/s^3 - real cek(nx,ny) + real cek(nx) ! Output of SHOC real diag_frac, diag_qn, diag_qi, diag_ql -! real diag_frac(nx,ny,nzm) ! SGS cloud fraction -! real diag_qn (nx,ny,nzm) ! SGS cloud+ice condensate, kg/kg -! real diag_qi (nx,ny,nzm) ! SGS ice condensate, kg/kg -! real diag_ql (nx,ny,nzm) ! SGS liquid condensate, kg/kg +! real diag_frac(nx,nzm) ! SGS cloud fraction +! real diag_qn (nx,nzm) ! SGS cloud+ice condensate, kg/kg +! real diag_qi (nx,nzm) ! SGS ice condensate, kg/kg +! real diag_ql (nx,nzm) ! SGS liquid condensate, kg/kg ! Horizontally averaged variables @@ -380,156 +349,132 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & ! Local variables -! real, dimension(nx,ny,nzm) :: tkesbbuoy, tkesbshear, tkesbdiss, tkesbbuoy_debug & +! real, dimension(nx,nzm) :: tkesbbuoy, tkesbshear, tkesbdiss, tkesbbuoy_debug & ! tkebuoy_sgs, total_water, tscale1_debug, brunt2 - real, dimension(nx,ny,nzm) :: total_water, brunt2, thv, tkesbdiss - real, dimension(nx,ny,nzm) :: def2 - real, dimension(nx,ny) :: denom, numer, l_inf, cldarr, thedz, thedz2 + real, dimension(nx,nzm) :: total_water, brunt2, thv, tkesbdiss + real, dimension(nx,nzm) :: def2 + real, dimension(nx) :: denom, numer, l_inf, cldarr, thedz, thedz2 real lstarn, depth, omn, betdz, bbb, term, qsatt, dqsat, & - conv_var, tkes, skew_w, skew_qw, aterm, w1_1, w1_2, w2_1, & + conv_var, tkes, skew_w, skew_qw, aterm, w1_1, w1_2, w2_1, & w2_2, w3var, thl1_1, thl1_2, thl2_1, thl2_2, qw1_1, qw1_2, qw2_1, & qw2_2, ql1, ql2, w_ql1, w_ql2, & - r_qwthl_1, r_wqw_1, r_wthl_1, testvar, s1, s2, std_s1, std_s2, C1, C2, & + r_qwthl_1, r_wqw_1, r_wthl_1, testvar, s1, s2, std_s1, std_s2, C1, C2, & thl_first, qw_first, w_first, Tl1_1, Tl1_2, betatest, pval, pkap, & w2thl, w2qw,w2ql, w2ql_1, w2ql_2, & thec, thlsec, qwsec, qwthlsec, wqwsec, wthlsec, thestd,dum, & cqt1, cthl1, cqt2, cthl2, qn1, qn2, qi1, qi2, omn1, omn2, & basetemp2, beta1, beta2, qs1, qs2, & - esval1_1, esval2_1, esval1_2, esval2_2, om1, om2, & + esval, esval2, om1, om2, epss, & lstarn1, lstarn2, sqrtw2, sqrtthl, sqrtqt, & - sqrtstd1, sqrtstd2, tsign, tvar, sqrtw2t, wqls, wqis, & - sqrtqw2_1, sqrtqw2_2, sqrtthl2_1, sqrtthl2_2, sm, prespot, & - corrtest1, corrtest2, wrk, wrk1, wrk2, wrk3, onema, pfac + sqrtstd1, sqrtstd2, tsign, tvar, sqrtw2t, wqls, wqis, & + sqrtqw2_1, sqrtqw2_2, sqrtthl2_1, sqrtthl2_2, sm, prespot, & + corrtest1, corrtest2, wrk, wrk1, wrk2, wrk3, onema, pfac + + integer i,k,km1,ku,kd,ka,kb - integer i,j,k,km1,ku,kd,ka,kb !calculate derived constants - lsub = lcond+lfus + lsub = lcond+lfus fac_cond = lcond/cp - fac_fus = lfus/cp - cpolv = cp/lcond - fac_sub = lsub/cp - ggri = 1.0/ggr - kapa = rgas/cp - gocp = ggr/cp - rog = rgas*ggri - sqrtpii = one/sqrt(pi+pi) - epsterm = rgas/rv - onebeps = one/epsterm - onebrvcp= one/(rv*cp) + fac_fus = lfus/cp + cpolv = cp/lcond + fac_sub = lsub/cp + ggri = one/ggr + kapa = rgas/cp + gocp = ggr/cp + rog = rgas*ggri + sqrtpii = one/sqrt(pi+pi) + epsterm = rgas/rv + onebeps = one/epsterm + onebrvcp = one/(rv*cp) + epss = eps * supice ! Map GFS variables to those of SHOC - SHOC operates on 3D fields ! Here a Y-dimension is added to the input variables, along with some unit conversions do k=1,nz - do j=1,ny - do i=1,nx - zi(i,j,k) = phii(i,j,k) * ggri - enddo + do i=1,nx + zi(i,k) = phii(i,k) * ggri enddo enddo - -! if (lprnt) write(0,*)' tabsin=',tabs(ipr,1,1:40) -! if (lprnt) write(0,*)' qcin=',qc(ipr,1,1:40) -! if (lprnt) write(0,*)' qwvin=',qwv(ipr,1,1:40) -! if (lprnt) write(0,*)' qiin=',qi(ipr,1,1:40) -! if (lprnt) write(0,*)' qplin=',qpl(ipr,1,1:40) -! if (lprnt) write(0,*)' qpiin=',qpi(ipr,1,1:40) ! ! move water from vapor to condensate if the condensate is negative ! do k=1,nzm - do j=1,ny - do i=1,nx - if (qc(i,j,k) < zero) then - wrk = qwv(i,j,k) + qc(i,j,k) - if (wrk >= zero) then - qwv(i,j,k) = wrk - tabs(i,j,k) = tabs(i,j,k) - fac_cond * qc(i,j,k) - qc(i,j,k) = zero - else - qc(i,j,k) = zero - tabs(i,j,k) = tabs(i,j,k) + fac_cond * qwv(i,j,k) - qwv(i,j,k) = zero - endif - endif - if (qi(i,j,k) < zero) then - wrk = qwv(i,j,k) + qi(i,j,k) - if (wrk >= zero) then - qwv(i,j,k) = wrk - tabs(i,j,k) = tabs(i,j,k) - fac_sub * qi(i,j,k) - qi(i,j,k) = zero - else - qi(i,j,k) = zero - tabs(i,j,k) = tabs(i,j,k) + fac_sub * qwv(i,j,k) - qwv(i,j,k) = zero - endif - endif - enddo + do i=1,nx + if (qc(i,k) < zero) then + qwv(i,k) = qwv(i,k) + qc(i,k) + tabs(i,k) = tabs(i,k) - fac_cond * qc(i,k) + qc(i,k) = zero + endif + if (qi(i,k) < zero) then + qwv(i,k) = qwv(i,k) + qi(i,k) + tabs(i,k) = tabs(i,k) - fac_sub * qi(i,k) + qi(i,k) = zero + endif + enddo + enddo +! fill negative water vapor from below + do k=nzm,2,-1 + km1 = k - 1 + do i=1,nx + if (qwv(i,k) < zero) then + qwv(i,k) = qwv(i,km1) + qwv(i,k) * delp(i,k) / delp(i,km1) + endif enddo enddo - -! if (lprnt) write(0,*)' tabsin2=',tabs(ipr,1,1:40) do k=1,nzm - do j=1,ny - do i=1,nx - zl(i,j,k) = phil(i,j,k) * ggri - wrk = one / prsl(i,j,k) - qv(i,j,k) = max(qwv(i,j,k), zero) - thv(i,j,k) = tabs(i,j,k) * (one+epsv*qv(i,j,k)) - w(i,j,k) = - rog * omega(i,j,k) * thv(i,j,k) * wrk - qcl(i,j,k) = max(qc(i,j,k), zero) - qci(i,j,k) = max(qi(i,j,k), zero) - qpi(i,j,k) = qpi_i(i,j,k) + qgl(i,j,k) ! add snow and graupel together + do i=1,nx + zl(i,k) = phil(i,k) * ggri + wrk = one / prsl(i,k) + qv(i,k) = max(qwv(i,k), zero) + thv(i,k) = tabs(i,k) * (one+epsv*qv(i,k)) + w(i,k) = - rog * omega(i,k) * thv(i,k) * wrk + qcl(i,k) = max(qc(i,k), zero) + qci(i,k) = max(qi(i,k), zero) ! -! qpl(i,j,k) = zero ! comment or remove when using with prognostic rain/snow -! qpi(i,j,k) = zero ! comment or remove when using with prognostic rain/snow +! qpl(i,k) = zero ! comment or remove when using with prognostic rain/snow +! qpi(i,k) = zero ! comment or remove when using with prognostic rain/snow - wqp_sec(i,j,k) = zero ! Turbulent flux of precipiation + wqp_sec(i,k) = zero ! Turbulent flux of precipiation ! - total_water(i,j,k) = qcl(i,j,k) + qci(i,j,k) + qv(i,j,k) + total_water(i,k) = qcl(i,k) + qci(i,k) + qv(i,k) - prespot = (100000.0*wrk) ** kapa ! Exner function - bet(i,j,k) = ggr/(tabs(i,j,k)*prespot) ! Moorthi - thv(i,j,k) = thv(i,j,k)*prespot ! Moorthi + prespot = (100000.0d0*wrk) ** kapa ! Exner function + bet(i,k) = ggr/(tabs(i,k)*prespot) ! Moorthi + thv(i,k) = thv(i,k)*prespot ! Moorthi ! ! Lapse rate * height = reference temperature - gamaz(i,j,k) = gocp * zl(i,j,k) + gamaz(i,k) = gocp * zl(i,k) ! Liquid/ice water static energy - ! Note the the units are degrees K - hl(i,j,k) = tabs(i,j,k) + gamaz(i,j,k) - fac_cond*(qcl(i,j,k)+qpl(i,j,k)) & - - fac_sub *(qci(i,j,k)+qpi(i,j,k)) - w3(i,j,k) = zero - enddo + hl(i,k) = tabs(i,k) + gamaz(i,k) - fac_cond*(qcl(i,k)+qpl(i,k)) & + - fac_sub *(qci(i,k)+qpi(i,k)) + w3(i,k) = zero enddo enddo -! if (lprnt) write(0,*)' hlin=',hl(ipr,1,1:40) ! Define vertical grid increments for later use in the vertical differentiation do k=2,nzm km1 = k - 1 - do j=1,ny - do i=1,nx - adzi(i,j,k) = zl(i,j,k) - zl(i,j,km1) - adzl(i,j,km1) = zi(i,j,k) - zi(i,j,km1) - enddo + do i=1,nx + adzi(i,k) = zl(i,k) - zl(i,km1) + adzl(i,km1) = zi(i,k) - zi(i,km1) enddo enddo - do j=1,ny - do i=1,nx - adzi(i,j,1) = (zl(i,j,1)-zi(i,j,1)) ! unused in the code - adzi(i,j,nz) = adzi(i,j,nzm) ! at the top - probably unused - adzl(i,j,nzm) = zi(i,j,nz) - zi(i,j,nzm) + do i=1,nx + adzi(i,1) = (zl(i,1)-zi(i,1)) ! unused in the code + adzi(i,nz) = adzi(i,nzm) ! at the top - probably unused + adzl(i,nzm) = zi(i,nz) - zi(i,nzm) ! - wthl_sec(i,j,1) = hflx(i) - wqw_sec(i,j,1) = evap(i) - enddo + wthl_sec(i,1) = hflx(i) + wqw_sec(i,1) = evap(i) enddo @@ -558,77 +503,69 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & ku = k ka = kb endif - do j=1,ny - do i=1,nx - if (tke(i,j,k) > zero) then -! wrk = half*(tkh(i,j,ka)+tkh(i,j,kb))*(w(i,j,ku) - w(i,j,kd)) & - wrk = half*(tkh(i,j,ka)*prnum(i,j,ka)+tkh(i,j,kb)*prnum(i,j,kb))*(w(i,j,ku) - w(i,j,kd)) & - * sqrt(tke(i,j,k)) / (zl(i,j,ku) - zl(i,j,kd)) - w_sec(i,j,k) = max(twoby3 * tke(i,j,k) - twoby15 * wrk, zero) -! w_sec(i,j,k) = max(twoby3 * tke(i,j,k), zero) -! if(lprnt .and. i == ipr .and. k <40) write(0,*)' w_sec=',w_sec(i,j,k),' tke=r',tke(i,j,k),& -! ' tkh=',tkh(i,j,ka),tkh(i,j,kb),' w=',w(i,j,ku),w(i,j,kd),' prnum=',prnum(i,j,ka),prnum(i,j,kb) - else - w_sec(i,j,k) = zero - endif - enddo + do i=1,nx + if (tke(i,k) > zero) then +! wrk = half*(tkh(i,ka)+tkh(i,kb))*(w(i,ku) - w(i,kd)) & + wrk = half*(tkh(i,ka)*prnum(i,ka)+tkh(i,kb)*prnum(i,kb))*(w(i,ku) - w(i,kd)) & + * sqrt(tke(i,k)) / (zl(i,ku) - zl(i,kd)) + w_sec(i,k) = max(twoby3 * tke(i,k) - twoby15 * wrk, zero) +! w_sec(i,k) = max(twoby3 * tke(i,k), zero) + else + w_sec(i,k) = zero + endif enddo enddo do k=2,nzm km1 = k - 1 - do j=1,ny - do i=1,nx + do i=1,nx ! Use backward difference in the vertical, use averaged values of "return-to-isotropy" ! time scale and diffusion coefficient - wrk1 = one / adzi(i,j,k) ! adzi(k) = (zl(k)-zl(km1)) -! wrk3 = max(tkh(i,j,k),pt01) * wrk1 - wrk3 = max(tkh(i,j,k),epsln) * wrk1 + wrk1 = one / adzi(i,k) ! adzi(k) = (zl(k)-zl(km1)) +! wrk3 = max(tkh(i,k),pt01) * wrk1 + wrk3 = max(tkh(i,k),epsln) * wrk1 - sm = half*(isotropy(i,j,k)+isotropy(i,j,km1))*wrk1*wrk3 ! Tau*Kh/dz^2 + sm = half*(isotropy(i,k)+isotropy(i,km1))*wrk1*wrk3 ! Tau*Kh/dz^2 ! SGS vertical flux liquid/ice water static energy. Eq 1 in BK13 ! No rain, snow or graupel in pdf (Annig, 08/29/2018) - wrk1 = hl(i,j,k) - hl(i,j,km1) & - + (qpl(i,j,k) - qpl(i,j,km1)) * fac_cond & - + (qpi(i,j,k) - qpi(i,j,km1)) * fac_sub - wthl_sec(i,j,k) = - wrk3 * wrk1 + wrk1 = hl(i,k) - hl(i,km1) & + + (qpl(i,k) - qpl(i,km1)) * fac_cond & + + (qpi(i,k) - qpi(i,km1)) * fac_sub + wthl_sec(i,k) = - wrk3 * wrk1 ! SGS vertical flux of total water. Eq 2 in BK13 - wrk2 = total_water(i,j,k) - total_water(i,j,km1) - wqw_sec(i,j,k) = - wrk3 * wrk2 + wrk2 = total_water(i,k) - total_water(i,km1) + wqw_sec(i,k) = - wrk3 * wrk2 ! Second moment of liquid/ice water static energy. Eq 4 in BK13 - thl_sec(i,j,k) = thl2tune * sm * wrk1 * wrk1 + thl_sec(i,k) = thl2tune * sm * wrk1 * wrk1 ! Second moment of total water mixing ratio. Eq 3 in BK13 - qw_sec(i,j,k) = qw2tune * sm * wrk2 * wrk2 + qw_sec(i,k) = qw2tune * sm * wrk2 * wrk2 ! Covariance of total water mixing ratio and liquid/ice water static energy. ! Eq 5 in BK13 - qwthl_sec(i,j,k) = qwthl2tune * sm * wrk1 * wrk2 + qwthl_sec(i,k) = qwthl2tune * sm * wrk1 * wrk2 - enddo ! i loop - enddo ! j loop + enddo ! i loop enddo ! k loop ! These would be at the surface - do we need them? - do j=1,ny - do i=1,nx -! wthl_sec(i,j,1) = wthl_sec(i,j,2) -! wqw_sec(i,j,1) = wqw_sec(i,j,2) - thl_sec(i,j,1) = thl_sec(i,j,2) - qw_sec(i,j,1) = qw_sec(i,j,2) - qwthl_sec(i,j,1) = qwthl_sec(i,j,2) - enddo + do i=1,nx +! wthl_sec(i,1) = wthl_sec(i,2) +! wqw_sec(i,1) = wqw_sec(i,2) + thl_sec(i,1) = thl_sec(i,2) + qw_sec(i,1) = qw_sec(i,2) + qwthl_sec(i,1) = qwthl_sec(i,2) enddo ! Diagnose the third moment of SGS vertical velocity @@ -648,10 +585,10 @@ subroutine tke_shoc() ! This subroutine solves the TKE equation, ! Heavily based on SAM's tke_full.f90 by Marat Khairoutdinov - real grd,betdz,Cee,lstarn, lstarp, bbb, omn, omp,qsatt,dqsat, smix, & + real grd,betdz,Cee,lstarn, lstarp, bbb, omn, omp,qsatt,dqsat, smix, & buoy_sgs,ratio,a_prod_sh,a_prod_bu,a_diss,a_prod_bu_debug, buoy_sgs_debug, & tscale1, wrk, wrk1, wtke, wtk2, rdtn, tkef2 - integer i,j,k,ku,kd,itr,k1 + integer i,k,ku,kd,itr,k1 rdtn = one / dtn @@ -660,13 +597,11 @@ subroutine tke_shoc() ! Ensure values of TKE are reasonable do k=1,nzm - do j=1,ny - do i=1,nx - tke(i,j,k) = max(min_tke,tke(i,j,k)) - tkesbdiss(i,j,k) = zero -! tkesbshear(i,j,k) = zero -! tkesbbuoy(i,j,k) = zero - enddo + do i=1,nx + tke(i,k) = max(min_tke,tke(i,k)) + tkesbdiss(i,k) = zero +! tkesbshear(i,k) = zero +! tkesbbuoy(i,k) = zero enddo enddo @@ -691,11 +626,9 @@ subroutine tke_shoc() endif if (dis_opt > 0) then - do j=1,ny - do i=1,nx - wrk = (zl(i,j,k)-zi(i,j,1)) / adzl(i,j,1) + 1.5 - cek(i,j) = 1.0 + 2.0 / max((wrk*wrk - 3.3), 0.5) - enddo + do i=1,nx + wrk = (zl(i,k)-zi(i,1)) / adzl(i,1) + 1.5d0 + cek(i) = (one + two / max((wrk*wrk - 3.3d0), 0.5d0)) * cefac enddo else if (k == 1) then @@ -705,111 +638,97 @@ subroutine tke_shoc() endif endif - do j=1,ny - do i=1,nx - grd = adzl(i,j,k) ! adzl(k) = zi(k+1)-zi(k) + do i=1,nx + grd = adzl(i,k) ! adzl(k) = zi(k+1)-zi(k) ! TKE boyancy production term. wthv_sec (buoyancy flux) is calculated in ! assumed_pdf(). The value used here is from the previous time step - a_prod_bu = ggr / thv(i,j,k) * wthv_sec(i,j,k) + a_prod_bu = ggr / thv(i,k) * wthv_sec(i,k) ! If wthv_sec from subgrid PDF is not available use Brunt-Vaisalla frequency from eddy_length() !Obtain Brunt-Vaisalla frequency from diagnosed SGS buoyancy flux !Presumably it is more precise than BV freq. calculated in eddy_length()? - buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,j,ku)+tkh(i,j,kd) + 0.0001) ! tkh is eddy thermal diffussivity + buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001) ! tkh is eddy thermal diffussivity !Compute $c_k$ (variable Cee) for the TKE dissipation term following Deardorff (1980) - if (buoy_sgs <= zero) then - smix = grd - else - smix = min(grd,max(0.1*grd, 0.76*sqrt(tke(i,j,k)/(buoy_sgs+1.e-10)))) - endif + if (buoy_sgs <= zero) then + smix = grd + else + smix = min(grd,max(0.1d0*grd, 0.76d0*sqrt(tke(i,k)/(buoy_sgs+1.0d-10)))) + endif - ratio = smix/grd - Cee = Cek(i,j) * (pt19 + pt51*ratio) * max(one, sqrt(pcrit/prsl(i,j,k))) + ratio = smix/grd + Cee = Cek(i) * (pt19 + pt51*ratio) * max(one, sqrt(pcrit/prsl(i,k))) ! TKE shear production term - a_prod_sh = half*(def2(i,j,ku)*tkh(i,j,ku)*prnum(i,j,ku) & - + def2(i,j,kd)*tkh(i,j,kd)*prnum(i,j,kd)) + a_prod_sh = half*(def2(i,ku)*tkh(i,ku)*prnum(i,ku) & + + def2(i,kd)*tkh(i,kd)*prnum(i,kd)) -! smixt (turb. mixing lenght) is calculated in eddy_length() +! smixt (turb. mixing lenght) is calculated in eddy_length() ! Explicitly integrate TKE equation forward in time -! a_diss = Cee/smixt(i,j,k)*tke(i,j,k)**1.5 ! TKE dissipation term -! tke(i,j,k) = max(zero,tke(i,j,k)+dtn*(max(zero,a_prod_sh+a_prod_bu)-a_diss)) +! a_diss = Cee/smixt(i,k)*tke(i,k)**1.5 ! TKE dissipation term +! tke(i,k) = max(zero,tke(i,k)+dtn*(max(zero,a_prod_sh+a_prod_bu)-a_diss)) ! Semi-implicitly integrate TKE equation forward in time - wtke = tke(i,j,k) - wtk2 = wtke -! wrk = (dtn*Cee)/smixt(i,j,k) - wrk = (dtn*Cee) / smixt(i,j,k) - wrk1 = wtke + dtn*(a_prod_sh+a_prod_bu) - -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wrk1=',wrk1,& -! ' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu,' dtn=',dtn,' smixt=',& -! smixt(i,j,k),' tkh=',tkh(i,j,ku),tkh(i,j,kd),' def2=',def2(i,j,ku),def2(i,j,kd)& -! ,' prnum=',prnum(i,j,ku),prnum(i,j,kd),' wthv_sec=',wthv_sec(i,j,k),' thv=',thv(i,j,k) - - do itr=1,nitr ! iterate for implicit solution - wtke = min(max(min_tke, wtke), max_tke) - a_diss = wrk*sqrt(wtke) ! Coefficient in the TKE dissipation term - wtke = wrk1 / (one+a_diss) - wtke = tkef1*wtke + tkef2*wtk2 ! tkef1+tkef2 = 1.0 + wtke = tke(i,k) + wtk2 = wtke +! wrk = (dtn*Cee)/smixt(i,k) + wrk = (dtn*Cee) / smixt(i,k) + wrk1 = wtke + dtn*(a_prod_sh+a_prod_bu) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wtk2=',wtk2,& -! ' a_diss=',a_diss,' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu,& -! ' wrk1=',wrk1,' itr=',itr,' k=',k + do itr=1,nitr ! iterate for implicit solution + wtke = min(max(min_tke, wtke), max_tke) + a_diss = wrk*sqrt(wtke) ! Coefficient in the TKE dissipation term + wtke = wrk1 / (one+a_diss) + wtke = tkef1*wtke + tkef2*wtk2 ! tkef1+tkef2 = 1.0 - wtk2 = wtke + wtk2 = wtke - enddo + enddo - tke(i,j,k) = min(max(min_tke, wtke), max_tke) - a_diss = wrk*sqrt(tke(i,j,k)) + tke(i,k) = min(max(min_tke, wtke), max_tke) + a_diss = wrk*sqrt(tke(i,k)) - tscale1 = (dtn+dtn) / a_diss ! corrected Eq 8 in BK13 -- tau = 2*tke/eps + tscale1 = (dtn+dtn) / a_diss ! corrected Eq 8 in BK13 -- tau = 2*tke/eps - tkesbdiss(i,j,k) = rdtn*a_diss*tke(i,j,k) ! TKE dissipation term, epsilon + tkesbdiss(i,k) = rdtn*a_diss*tke(i,k) ! TKE dissipation term, epsilon ! Calculate "return-to-isotropy" eddy dissipation time scale, see Eq. 8 in BK13 - if (buoy_sgs <= zero) then - isotropy(i,j,k) = min(max_eddy_dissipation_time_scale,tscale1) - else - isotropy(i,j,k) = min(max_eddy_dissipation_time_scale, & - tscale1/(one+lambda*buoy_sgs*tscale1*tscale1)) - endif + if (buoy_sgs <= zero) then + isotropy(i,k) = min(max_eddy_dissipation_time_scale, tscale1) + else + isotropy(i,k) = min(max_eddy_dissipation_time_scale, & + tscale1/(one+lambda*buoy_sgs*tscale1*tscale1)) + endif ! TKE budget terms -! tkesbdiss(i,j,k) = a_diss -! tkesbshear(i,j,k) = a_prod_sh -! tkesbbuoy(i,j,k) = a_prod_bu -! tkesbbuoy_debug(i,j,k) = a_prod_bu_debug -! tkebuoy_sgs(i,j,k) = buoy_sgs +! tkesbdiss(i,k) = a_diss +! tkesbshear(i,k) = a_prod_sh +! tkesbbuoy(i,k) = a_prod_bu +! tkesbbuoy_debug(i,k) = a_prod_bu_debug +! tkebuoy_sgs(i,k) = buoy_sgs - enddo ! i loop - enddo ! j loop - enddo ! k -! + enddo ! i loop + enddo ! k loop wrk = half * ck do k=2,nzm k1 = k - 1 - do j=1,ny - do i=1,nx - tkh(i,j,k) = min(tkhmax, wrk * (isotropy(i,j,k) * tke(i,j,k) & - + isotropy(i,j,k1) * tke(i,j,k1))) ! Eddy thermal diffusivity - enddo ! i - enddo ! j - enddo ! k + do i=1,nx + tkh(i,k) = min(tkhmax, wrk * (isotropy(i,k) * tke(i,k) & + + isotropy(i,k1) * tke(i,k1))) ! Eddy thermal diffusivity + enddo ! i + enddo ! k end subroutine tke_shoc @@ -819,31 +738,26 @@ subroutine tke_shear_prod(def2) ! Calculate TKE shear production term - real, intent(out) :: def2(nx,ny,nzm) + real, intent(out) :: def2(nx,nzm) real rdzw, wrku, wrkv, wrkw - integer i,j,k,k1 + integer i,k,k1 ! Calculate TKE shear production term at layer interface do k=2,nzm k1 = k - 1 - do j=1,ny - do i=1,nx - rdzw = one / adzi(i,j,k) - wrku = (u(i,j,k)-u(i,j,k1)) * rdzw - wrkv = (v(i,j,k)-v(i,j,k1)) * rdzw -! wrkw = (w(i,j,k)-w(i,j,k1)) * rdzw - def2(i,j,k) = wrku*wrku + wrkv*wrkv !+ 2*wrkw(1) * wrkw(1) - enddo - enddo - enddo ! k loop - do j=1,ny do i=1,nx -! def2(i,j,1) = def2(i,j,2) - def2(i,j,1) = (u(i,j,1)*u(i,j,1) + v(i,j,1)*v(i,j,1)) & - / (zl(i,j,1)*zl(i,j,1)) + rdzw = one / adzi(i,k) + wrku = (u(i,k)-u(i,k1)) * rdzw + wrkv = (v(i,k)-v(i,k1)) * rdzw +! wrkw = (w(i,k)-w(i,k1)) * rdzw + def2(i,k) = wrku*wrku + wrkv*wrkv !+ 2*wrkw(1) * wrkw(1) enddo + enddo ! k loop + do i=1,nx +! def2(i,1) = def2(i,2) + def2(i,1) = (u(i,1)*u(i,1) + v(i,1)*v(i,1)) / (zl(i,1)*zl(i,1)) enddo end subroutine tke_shear_prod @@ -855,51 +769,45 @@ subroutine eddy_length() ! Local variables real wrk, wrk1, wrk2, wrk3 - integer i, j, k, kk, kl, ku, kb, kc, kli, kui + integer i, k, kk, kl, ku, kb, kc, kli, kui - do j=1,ny - do i=1,nx - cldarr(i,j) = zero - numer(i,j) = zero - denom(i,j) = zero - enddo + do i=1,nx + cldarr(i) = zero + numer(i) = zero + denom(i) = zero enddo ! Find the length scale outside of clouds, that includes boundary layers. do k=1,nzm - do j=1,ny - do i=1,nx + do i=1,nx ! Reinitialize the mixing length related arrays to zero -! smixt(i,j,k) = one ! shoc_mod module variable smixt - smixt(i,j,k) = epsln ! shoc_mod module variable smixt - brunt(i,j,k) = zero +! smixt(i,k) = one ! shoc_mod module variable smixt + smixt(i,k) = epsln ! shoc_mod module variable smixt + brunt(i,k) = zero !Eq. 11 in BK13 (Eq. 4.13 in Pete's dissertation) !Outside of cloud, integrate from the surface to the cloud base !Should the 'if' below check if the cloud liquid < a small constant instead? - if (qcl(i,j,k)+qci(i,j,k) <= zero) then - tkes = sqrt(tke(i,j,k)) * adzl(i,j,k) - numer(i,j) = numer(i,j) + tkes*zl(i,j,k) ! Numerator in Eq. 11 in BK13 - denom(i,j) = denom(i,j) + tkes ! Denominator in Eq. 11 in BK13 - else - cldarr(i,j) = one ! Take note of columns containing cloud. - endif - enddo + if (qcl(i,k)+qci(i,k) <= qcmin) then + tkes = sqrt(tke(i,k)) * adzl(i,k) + numer(i) = numer(i) + tkes*zl(i,k) ! Numerator in Eq. 11 in BK13 + denom(i) = denom(i) + tkes ! Denominator in Eq. 11 in BK13 + else + cldarr(i) = one ! Take note of columns containing cloud. + endif enddo enddo ! Calculate the measure of PBL depth, Eq. 11 in BK13 (Is this really PBL depth?) - do j=1,ny - do i=1,nx - if (denom(i,j) > zero .and. numer(i,j) > zero) then - l_inf(i,j) = min(0.1 * (numer(i,j)/denom(i,j)), 100.0) - else - l_inf(i,j) = 100.0 - endif - enddo + do i=1,nx + if (denom(i) > zero .and. numer(i) > zero) then + l_inf(i) = min(0.1d0 * (numer(i)/denom(i)), 100.0d0) + else + l_inf(i) = 100.0d0 + endif enddo !Calculate length scale outside of cloud, Eq. 10 in BK13 (Eq. 4.12 in Pete's dissertation) @@ -910,81 +818,80 @@ subroutine eddy_length() if (k == 1) then kb = 1 kc = 2 - thedz(:,:) = adzi(:,:,kc) + thedz(:) = adzi(:,kc) elseif (k == nzm) then kb = nzm-1 kc = nzm - thedz(:,:) = adzi(:,:,k) + thedz(:) = adzi(:,k) else - thedz(:,:) = adzi(:,:,kc) + adzi(:,:,k) ! = (z(k+1)-z(k-1)) + thedz(:) = adzi(:,kc) + adzi(:,k) ! = (z(k+1)-z(k-1)) endif - do j=1,ny - do i=1,nx + do i=1,nx ! vars module variable bet (=ggr/tv0) ; grid module variable adzi - betdz = bet(i,j,k) / thedz(i,j) + betdz = bet(i,k) / thedz(i) - tkes = sqrt(tke(i,j,k)) + tkes = sqrt(tke(i,k)) ! Compute local Brunt-Vaisalla frequency - wrk = qcl(i,j,k) + qci(i,j,k) - if (wrk > zero) then ! If in the cloud + wrk = qcl(i,k) + qci(i,k) + if (wrk > zero) then ! If in the cloud ! Find the in-cloud Brunt-Vaisalla frequency - omn = qcl(i,j,k) / (wrk+1.e-20) ! Ratio of liquid water to total water + omn = qcl(i,k) / (wrk+1.e-20) ! Ratio of liquid water to total water ! Latent heat of phase transformation based on relative water phase content ! fac_cond = lcond/cp, fac_fus = lfus/cp - lstarn = fac_cond + (one-omn)*fac_fus + lstarn = fac_cond + (one-omn)*fac_fus ! Derivative of saturation mixing ratio over water/ice wrt temp. based on relative water phase content - dqsat = omn * dtqsatw(tabs(i,j,k),prsl(i,j,k)) & - + (one-omn) * dtqsati(tabs(i,j,k),prsl(i,j,k)) + dqsat = omn * dtqsatw(tabs(i,k),prsl(i,k)) & + + (one-omn) * dtqsati(tabs(i,k),prsl(i,k)) ! Saturation mixing ratio over water/ice wrt temp based on relative water phase content - qsatt = omn * qsatw(tabs(i,j,k),prsl(i,j,k)) & - + (one-omn) * qsati(tabs(i,j,k),prsl(i,j,k)) + qsatt = omn * qsatw(tabs(i,k),prsl(i,k)) & + + (one-omn) * qsati(tabs(i,k),prsl(i,k)) ! liquid/ice moist static energy static energy divided by cp? - bbb = (one + epsv*qsatt-wrk-qpl(i,j,k)-qpi(i,j,k) & - + 1.61*tabs(i,j,k)*dqsat) / (one+lstarn*dqsat) + bbb = (one + epsv*qsatt-wrk-qpl(i,k)-qpi(i,k) & + + 1.61d0*tabs(i,k)*dqsat) / (one+lstarn*dqsat) ! Calculate Brunt-Vaisalla frequency using centered differences in the vertical - brunt(i,j,k) = betdz*(bbb*(hl(i,j,kc)-hl(i,j,kb)) & - + (bbb*lstarn - (one+lstarn*dqsat)*tabs(i,j,k)) & - * (total_water(i,j,kc)-total_water(i,j,kb)) & - + (bbb*fac_cond - (one+fac_cond*dqsat)*tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & - + (bbb*fac_sub - (one+fac_sub*dqsat)*tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) + brunt(i,k) = betdz*(bbb*(hl(i,kc)-hl(i,kb)) & + + (bbb*lstarn - (one+lstarn*dqsat)*tabs(i,k)) & + * (total_water(i,kc)-total_water(i,kb)) & + + (bbb*fac_cond - (one+fac_cond*dqsat)*tabs(i,k))*(qpl(i,kc)-qpl(i,kb)) & + + (bbb*fac_sub - (one+fac_sub*dqsat)*tabs(i,k))*(qpi(i,kc)-qpi(i,kb)) ) - else ! outside of cloud + else ! outside of cloud ! Find outside-of-cloud Brunt-Vaisalla frequency ! Only unsaturated air, rain and snow contribute to virt. pot. temp. ! liquid/ice moist static energy divided by cp? - bbb = one + epsv*qv(i,j,k) - qpl(i,j,k) - qpi(i,j,k) - brunt(i,j,k) = betdz*( bbb*(hl(i,j,kc)-hl(i,j,kb)) & - + epsv*tabs(i,j,k)*(total_water(i,j,kc)-total_water(i,j,kb)) & - + (bbb*fac_cond-tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & - + (bbb*fac_sub -tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) - endif + bbb = one + epsv*qv(i,k) - qpl(i,k) - qpi(i,k) + brunt(i,k) = betdz*( bbb*(hl(i,kc)-hl(i,kb)) & + + epsv*tabs(i,k)*(total_water(i,kc)-total_water(i,kb)) & + + (bbb*fac_cond-tabs(i,k))*(qpl(i,kc)-qpl(i,kb)) & + + (bbb*fac_sub -tabs(i,k))*(qpi(i,kc)-qpi(i,kb)) ) + endif ! Reduction of mixing length in the stable regions (where B.-V. freq. > 0) is required. ! Here we find regions of Brunt-Vaisalla freq. > 0 for later use. - if (brunt(i,j,k) >= zero) then - brunt2(i,j,k) = brunt(i,j,k) - else - brunt2(i,j,k) = zero - endif + if (brunt(i,k) >= zero) then + brunt2(i,k) = brunt(i,k) + else + brunt2(i,k) = zero + endif ! Calculate turbulent length scale in the boundary layer. ! See Eq. 10 in BK13 (Eq. 4.12 in Pete's dissertation) @@ -992,36 +899,34 @@ subroutine eddy_length() ! Keep the length scale adequately small near the surface following Blackadar (1984) ! Note that this is not documented in BK13 and was added later for SP-CAM runs -! if (k == 1) then -! term = 600.*tkes -! smixt(i,j,k) = term + (0.4*zl(i,j,k)-term)*exp(-zl(i,j,k)*0.01) -! else +! if (k == 1) then +! term = 600.*tkes +! smixt(i,k) = term + (0.4*zl(i,k)-term)*exp(-zl(i,k)*0.01) +! else ! tscale is the eddy turnover time scale in the boundary layer and is ! an empirically derived constant - if (tkes > zero .and. l_inf(i,j) > zero) then - wrk1 = one / (tscale*tkes*vonk*zl(i,j,k)) - wrk2 = one / (tscale*tkes*l_inf(i,j)) - wrk1 = wrk1 + wrk2 + pt01 * brunt2(i,j,k) / tke(i,j,k) - wrk1 = sqrt(one / max(wrk1,1.0e-8)) * (one/0.3) -! smixt(i,j,k) = min(max_eddy_length_scale, 2.8284*sqrt(wrk1)/0.3) - smixt(i,j,k) = min(max_eddy_length_scale, wrk1) - -! smixt(i,j,k) = min(max_eddy_length_scale,(2.8284*sqrt(1./((1./(tscale*tkes*vonk*zl(i,j,k))) & -! + (1./(tscale*tkes*l_inf(i,j)))+0.01*(brunt2(i,j,k)/tke(i,j,k)))))/0.3) -! else -! smixt(i,j,k) = zero - endif + if (tkes > zero .and. l_inf(i) > zero) then + wrk1 = one / (tscale*tkes*vonk*zl(i,k)) + wrk2 = one / (tscale*tkes*l_inf(i)) + wrk1 = wrk1 + wrk2 + pt01 * brunt2(i,k) / tke(i,k) + wrk1 = sqrt(one / max(wrk1,1.0d-8)) * (one/0.3d0) +! smixt(i,k) = min(max_eddy_length_scale, 2.8284*sqrt(wrk1)/0.3) + smixt(i,k) = min(max_eddy_length_scale, wrk1) + +! smixt(i,k) = min(max_eddy_length_scale,(2.8284*sqrt(1./((1./(tscale*tkes*vonk*zl(i,k))) & +! + (1./(tscale*tkes*l_inf(i)))+0.01*(brunt2(i,k)/tke(i,k)))))/0.3) +! else +! smixt(i,k) = zero + endif ! endif - enddo enddo enddo - ! Now find the in-cloud turbulence length scale ! See Eq. 13 in BK13 (Eq. 4.18 in Pete's disseration) @@ -1034,83 +939,78 @@ subroutine eddy_length() ! call conv_scale() ! inlining the relevant code -! do j=1,ny -! do i=1,nx -! conv_vel2(i,j,1) = zero ! Convective velocity scale cubed -! enddo +! do i=1,nx +! conv_vel2(i,1) = zero ! Convective velocity scale cubed ! enddo ! Integrate velocity scale in the vertical ! do k=2,nzm -! do j=1,ny -! do i=1,nx -! conv_vel2(i,j,k) = conv_vel2(i,j,k-1) & -! + 2.5*adzi(i,j,k)*bet(i,j,k)*wthv_sec(i,j,k) -! enddo +! do i=1,nx +! conv_vel2(i,k) = conv_vel2(i,k-1) & +! + 2.5*adzi(i,k)*bet(i,k)*wthv_sec(i,k) ! enddo ! enddo - do j=1,ny - do i=1,nx + do i=1,nx - if (cldarr(i,j) == 1) then ! If there's a cloud in this column + if (cldarr(i) == 1) then ! If there's a cloud in this column - kl = 0 - ku = 0 - do k=2,nzm-3 + kl = 0 + ku = 0 + do k=2,nzm-3 -! Look for the cloud base in this column +! Look for the cloud base in this column ! thresh (=0) is a variable local to eddy_length(). Should be a module constant. - wrk = qcl(i,j,k) + qci(i,j,k) - if (wrk > thresh .and. kl == 0) then - kl = k + wrk = qcl(i,k) + qci(i,k) + if (wrk > qcmin) then + if (kl == 0) then + kl = k endif ! Look for the cloud top in this column - if (wrk > thresh .and. qcl(i,j,k+1)+qci(i,j,k+1) <= thresh) then + if (qcl(i,k+1)+qci(i,k+1) <= qcmin) then ku = k ! conv_vel2 (Cubed convective velocity scale) is calculated in conv_scale() -! Use the value of conv_vel2 at the top of the cloud. -! conv_var = conv_vel2(i,j,k)**(oneb3) +! Use the value of conv_vel2 at the top of the cloud. +! conv_var = conv_vel2(i,k)** oneb3 endif + endif ! Compute the mixing length scale for the cloud layer that we just found -! if (kl > 0 .and. ku > 0 .and. ku-kl > 1) then - if (kl > 0 .and. ku > 0 .and. ku-kl > 0) then - +! if (kl > 0 .and. ku > 0 .and. ku-kl > 1) then +! if (kl > 0 .and. ku > 0 .and. ku-kl > 0) then + if (kl > 0 .and. ku >= kl) then ! The calculation below finds the integral in the Eq. 10 in BK13 for the current cloud - conv_var = zero - do kk=kl,ku - conv_var = conv_var+ 2.5*adzi(i,j,kk)*bet(i,j,kk)*wthv_sec(i,j,kk) - enddo - conv_var = conv_var ** oneb3 - - if (conv_var > 0) then ! If convective vertical velocity scale > 0 + conv_var = zero + do kk=kl,ku + conv_var = conv_var+ 2.5d0*adzi(i,kk)*bet(i,kk)*wthv_sec(i,kk) + enddo + conv_var = conv_var ** oneb3 - depth = (zl(i,j,ku)-zl(i,j,kl)) + adzl(i,j,kl) + if (conv_var > 0) then ! If convective vertical velocity scale > 0 + depth = (zl(i,ku)-zl(i,kl)) + adzl(i,kl) - do kk=kl,ku + do kk=kl,ku ! in-cloud turbulence length scale, Eq. 13 in BK13 (Eq. 4.18) -! wrk = conv_var/(depth*sqrt(tke(i,j,kk))) -! wrk = wrk * wrk + pt01*brunt2(i,j,kk)/tke(i,j,kk) +! wrk = conv_var/(depth*sqrt(tke(i,kk))) +! wrk = wrk * wrk + pt01*brunt2(i,kk)/tke(i,kk) - wrk = conv_var/(depth*depth*sqrt(tke(i,j,kk))) & - + pt01*brunt2(i,j,kk)/tke(i,j,kk) + wrk = conv_var/(depth*depth*sqrt(tke(i,kk))) & + + pt01*brunt2(i,kk)/tke(i,kk) - smixt(i,j,kk) = min(max_eddy_length_scale, (one/0.3)*sqrt(one/wrk)) + smixt(i,kk) = min(max_eddy_length_scale, (one/0.3d0)*sqrt(one/wrk)) - enddo + enddo - endif ! If convective vertical velocity scale > 0 - kl = zero - ku = zero - endif ! if inside the cloud layer + endif ! If convective vertical velocity scale > 0 + kl = zero + ku = zero + endif ! if inside the cloud layer - enddo ! k=2,nzm-3 - endif ! if in the cloudy column - enddo ! i=1,nx - enddo ! j=1,ny + enddo ! k=2,nzm-3 + endif ! if in the cloudy column + enddo ! i=1,nx end subroutine eddy_length @@ -1122,7 +1022,7 @@ subroutine conv_scale() ! for the definition of the length scale in clouds ! See Eq. 16 in BK13 (Eq. 4.21 in Pete's dissertation) - integer i, j, k + integer i, k !!!!!!!!! !! A bug in formulation of conv_vel @@ -1130,27 +1030,23 @@ subroutine conv_scale() !!!!!!!!!! ! conv_vel(1)=zero ! Horizontally averaged convective velocity scale cubed - do j=1,ny - do i=1,nx - conv_vel2(i,j,1) = zero ! Convective velocity scale cubed - enddo + do i=1,nx + conv_vel2(i,1) = zero ! Convective velocity scale cubed enddo ! Integrate velocity scale in the vertical do k=2,nzm ! conv_vel(k)=conv_vel(k-1) - do j=1,ny - do i=1,nx + do i=1,nx !********************************************************************** !Do not include grid-scale contribution to convective velocity scale in GCM applications -! conv_vel(k)=conv_vel(k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+tvws(k)) -! conv_vel(k)=conv_vel(k)+2.5*adzi(i,j,k)*bet(i,j,k)*(tvws(k)) +! conv_vel(k)=conv_vel(k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+tvws(k)) +! conv_vel(k)=conv_vel(k)+2.5*adzi(i,k)*bet(i,k)*(tvws(k)) !Do not include grid-scale contribution to convective velocity scale in GCM applications -! conv_vel2(i,j,k)=conv_vel2(i,j,k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+wthv_sec(i,j,k)) +! conv_vel2(i,k)=conv_vel2(i,k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+wthv_sec(i,k)) !********************************************************************** - conv_vel2(i,j,k) = conv_vel2(i,j,k-1) & - + 2.5*adzi(i,j,k)*bet(i,j,k)*wthv_sec(i,j,k) - enddo + conv_vel2(i,k) = conv_vel2(i,k-1) & + + 2.5*adzi(i,k)*bet(i,k)*wthv_sec(i,k) enddo enddo @@ -1161,7 +1057,7 @@ subroutine check_eddy() ! This subroutine checks eddy length values - integer i, j, k, kb, ks, zend + integer i, k, kb, ks, zend real wrk ! real zstart, zthresh, qthresh @@ -1179,25 +1075,23 @@ subroutine check_eddy() kb = k+1 endif - do j=1,ny - do i=1,nx + do i=1,nx - wrk = 0.1*adzl(i,j,k) + wrk = 0.1*adzl(i,k) ! Minimum 0.1 of local dz - smixt(i,j,k) = max(wrk, min(max_eddy_length_scale,smixt(i,j,k))) + smixt(i,k) = max(wrk, min(max_eddy_length_scale,smixt(i,k))) -! If chracteristic grid dimension in the horizontal< 1000m, set lengthscale to +! If chracteristic grid dimension in the horizontal< 1000m, set lengthscale to ! be not larger that that. -! if (sqrt(dx*dy) .le. 1000.) smixt(i,j,k)=min(sqrt(dx*dy),smixt(i,j,k)) +! if (sqrt(dx*dy) .le. 1000.) smixt(i,k)=min(sqrt(dx*dy),smixt(i,k)) - if (qcl(i,j,kb) == 0 .and. qcl(i,j,k) > 0 .and. brunt(i,j,k) > 1.e-4) then + if (qcl(i,kb) == 0 .and. qcl(i,k) > 0 .and. brunt(i,k) > 1.0d-4) then !If just above the cloud top and atmosphere is stable, set to 0.1 of local dz - smixt(i,j,k) = wrk - endif + smixt(i,k) = wrk + endif - enddo ! i - enddo ! j - enddo ! k + enddo ! i + enddo ! k end subroutine check_eddy @@ -1209,7 +1103,7 @@ subroutine canuto() ! Result is returned in a global variable w3 defined at the interface levels. ! Local variables - integer i, j, k, kb, kc + integer i, k, kb, kc real bet2, f0, f1, f2, f3, f4, f5, iso, isosqr, & omega0, omega1, omega2, X0, Y0, X1, Y1, AA0, AA1, buoy_sgs2, & @@ -1217,10 +1111,10 @@ subroutine canuto() ! cond, wrk, wrk1, wrk2, wrk3, avew ! ! See Eq. 7 in C01 (B.7 in Pete's dissertation) - real, parameter :: c=7.0, a0=0.52/(c*c*(c-2.)), a1=0.87/(c*c), & - a2=0.5/c, a3=0.6/(c*(c-2.)), a4=2.4/(3.*c+5.), & - a5=0.6/(c*(3.*c+5)) -!Moorthi a5=0.6/(c*(3.+5.*c)) + real, parameter :: c=7.0d0, a0=0.52d0/(c*c*(c-2.0d0)), a1=0.87d0/(c*c), & + a2=0.5d0/c, a3=0.6d0/(c*(c-2.0d0)), a4=2.4d0/(3.0d0*c+5.0d0), & + a5=0.6d0/(c*(3.0d0*c+5.0d0)) +!Moorthi a5=0.6d0/(c*(3.0d0+5.0d0*c)) ! do k=1,nzm do k=2,nzm @@ -1231,55 +1125,47 @@ subroutine canuto() ! if(k == 1) then ! kb = 1 ! kc = 2 -! do j=1,ny -! do i=1,nx -! thedz(i,j) = one / adzl(i,j,kc) -! thedz2(i,j) = thedz(i,j) -! enddo +! do i=1,nx +! thedz(i) = one / adzl(i,kc) +! thedz2(i) = thedz(i) ! enddo ! elseif(k == nzm) then - if (k == nzm) then + if(k == nzm) then kb = nzm-1 kc = nzm - do j=1,ny - do i=1,nx - thedz(i,j) = one / adzi(i,j,k) - thedz2(i,j) = one / adzl(i,j,kb) - enddo + do i=1,nx + thedz(i) = one / adzi(i,k) + thedz2(i) = one / adzl(i,kb) enddo else - do j=1,ny - do i=1,nx - thedz(i,j) = one / adzi(i,j,k) - thedz2(i,j) = one / (adzl(i,j,k)+adzl(i,j,kb)) - enddo + do i=1,nx + thedz(i) = one / adzi(i,k) + thedz2(i) = one / (adzl(i,k)+adzl(i,kb)) enddo endif + do i=1,nx - do j=1,ny - do i=1,nx - - iso = half*(isotropy(i,j,k)+isotropy(i,j,kb)) - isosqr = iso*iso ! Two-level average of "return-to-isotropy" time scale squared - buoy_sgs2 = isosqr*half*(brunt(i,j,k)+brunt(i,j,kb)) - bet2 = half*(bet(i,j,k)+bet(i,j,kb)) !Two-level average of BV frequency squared + iso = half*(isotropy(i,k)+isotropy(i,kb)) + isosqr = iso*iso ! Two-level average of "return-to-isotropy" time scale squared + buoy_sgs2 = isosqr*half*(brunt(i,k)+brunt(i,kb)) + bet2 = half*(bet(i,k)+bet(i,kb)) !Two-level average of BV frequency squared ! Compute functions f0-f5, see Eq, 8 in C01 (B.8 in Pete's dissertation) - avew = half*(w_sec(i,j,k)+w_sec(i,j,kb)) + avew = half*(w_sec(i,k)+w_sec(i,kb)) + !aab ! - wrk1 = bet2*iso - wrk2 = thedz2(i,j)*wrk1*wrk1*iso - wrk3 = thl_sec(i,j,kc) - thl_sec(i,j,kb) - f0 = wrk2 * wrk1 * wthl_sec(i,j,k) * wrk3 + wrk1 = bet2*iso + wrk2 = thedz2(i)*wrk1*wrk1*iso + wrk3 = thl_sec(i,kc) - thl_sec(i,kb) + + f0 = wrk2 * wrk1 * wthl_sec(i,k) * wrk3 - wrk = wthl_sec(i,j,kc) - wthl_sec(i,j,kb) + wrk = wthl_sec(i,kc) - wthl_sec(i,kb) - f1 = wrk2 * (wrk*wthl_sec(i,j,k) + half*avew*wrk3) + f1 = wrk2 * (wrk*wthl_sec(i,k) + half*avew*wrk3) - wrk1 = bet2*isosqr - f2 = thedz(i,j)*wrk1*wthl_sec(i,j,k)*(w_sec(i,j,k)-w_sec(i,j,kb)) & - + (thedz2(i,j)+thedz2(i,j))*bet(i,j,k)*isosqr*wrk + wrk1 = bet2*isosqr + f2 = thedz(i)*wrk1*wthl_sec(i,k)*(w_sec(i,k)-w_sec(i,kb)) & + + (thedz2(i)+thedz2(i))*bet(i,k)*isosqr*wrk - f3 = thedz2(i,j)*wrk1*wrk + thedz(i,j)*bet2*isosqr*(wthl_sec(i,j,k)*(tke(i,j,k)-tke(i,j,kb))) + f3 = thedz2(i)*wrk1*wrk + thedz(i)*bet2*isosqr*(wthl_sec(i,k)*(tke(i,k)-tke(i,kb))) - wrk1 = thedz(i,j)*iso*avew - f4 = wrk1*(w_sec(i,j,k)-w_sec(i,j,kb) + tke(i,j,k)-tke(i,j,kb)) + wrk1 = thedz(i)*iso*avew + f4 = wrk1*(w_sec(i,k)-w_sec(i,kb) + tke(i,k)-tke(i,kb)) - f5 = wrk1*(w_sec(i,j,k)-w_sec(i,j,kb)) + f5 = wrk1*(w_sec(i,k)-w_sec(i,kb)) ! Compute the "omega" terms, see Eq. 6 in C01 (B.6 in Pete's dissertation) - omega0 = a4 / (one-a5*buoy_sgs2) - omega1 = omega0 / (c+c) - omega2 = omega1*f3+(5./4.)*omega0*f4 + omega0 = a4 / (one-a5*buoy_sgs2) + omega1 = omega0 / (c+c) + omega2 = omega1*f3+(5./4.)*omega0*f4 ! Compute the X0, Y0, X1, Y1 terms, see Eq. 5 a-b in C01 (B.5 in Pete's dissertation) - wrk1 = one / (one-(a1+a3)*buoy_sgs2) - wrk2 = one / (one-a3*buoy_sgs2) - X0 = wrk1 * (a2*buoy_sgs2*(one-a3*buoy_sgs2)) - Y0 = wrk2 * (two*a2*buoy_sgs2*X0) - X1 = wrk1 * (a0*f0+a1*f1+a2*(one-a3*buoy_sgs2)*f2) - Y1 = wrk2 * (two*a2*(buoy_sgs2*X1+(a0/a1)*f0+f1)) + wrk1 = one / (one-(a1+a3)*buoy_sgs2) + wrk2 = one / (one-a3*buoy_sgs2) + X0 = wrk1 * (a2*buoy_sgs2*(one-a3*buoy_sgs2)) + Y0 = wrk2 * (two*a2*buoy_sgs2*X0) + X1 = wrk1 * (a0*f0+a1*f1+a2*(one-a3*buoy_sgs2)*f2) + Y1 = wrk2 * (two*a2*(buoy_sgs2*X1+(a0/a1)*f0+f1)) ! Compute the A0, A1 terms, see Eq. 5d in C01 (B.5 in Pete's dissertation) - AA0 = omega0*X0 + omega1*Y0 - AA1 = omega0*X1 + omega1*Y1 + omega2 + AA0 = omega0*X0 + omega1*Y0 + AA1 = omega0*X1 + omega1*Y1 + omega2 ! Finally, we have the third moment of w, see Eq. 4c in C01 (B.4 in Pete's dissertation) -! cond is an estimate of third moment from second oment - If the third moment is larger +! cond_w is an estimate of third moment from second oment - If the third moment is larger ! than the estimate - limit w3. !aab ! Implemetation of the C01 approach in this subroutine is nearly complete ! (the missing part are Eqs. 5c and 5e which are very simple) -! therefore it's easy to diagnose other third order moments obtained in C01 using this code. +! therefore it's easy to diagnose other third order moments obtained in C01 using this code. - enddo enddo enddo - do j=1,ny - do i=1,nx - w3(i,j,1) = w3(i,j,2) - enddo + do i=1,nx + w3(i,1) = w3(i,2) enddo end subroutine canuto @@ -1370,7 +1254,7 @@ subroutine assumed_pdf() ! Local variables - integer i,j,k,ku,kd + integer i,k,ku,kd real wrk, wrk1, wrk2, wrk3, wrk4, bastoeps, eps_ss1, eps_ss2, cond_w ! bastoeps = basetemp / epsterm @@ -1388,477 +1272,441 @@ subroutine assumed_pdf() ku = k + 1 ! if (k == nzm) ku = k - DO j=1,ny - DO i=1,nx + DO i=1,nx ! Initialize cloud variables to zero - diag_qn = zero - diag_frac = zero - diag_ql = zero - diag_qi = zero + diag_qn = zero + diag_frac = zero + diag_ql = zero + diag_qi = zero - pval = prsl(i,j,k) - pfac = pval * 1.0e-5 - pkap = pfac ** kapa + pval = prsl(i,k) + pfac = pval * 1.0d-5 + pkap = pfac ** kapa -! Read in liquid/ice static energy, total water mixing ratio, +! Read in liquid/ice static energy, total water mixing ratio, ! and vertical velocity to variables PDF needs - - thl_first = hl(i,j,k) + fac_cond*qpl(i,j,k) & - + fac_sub*qpi(i,j,k) - - qw_first = total_water(i,j,k) -! w_first = half*(w(i,j,kd)+w(i,j,ku)) - w_first = w(i,j,k) + thl_first = hl(i,k) + fac_cond*qpl(i,k) + fac_sub*qpi(i,k) + qw_first = total_water(i,k) +! w_first = half*(w(i,kd)+w(i,ku)) + w_first = w(i,k) ! GET ALL INPUT VARIABLES ON THE SAME GRID ! Points to be computed with relation to thermo point ! Read in points that need to be averaged - if (k < nzm) then - w3var = half*(w3(i,j,kd)+w3(i,j,ku)) - thlsec = max(zero, half*(thl_sec(i,j,kd)+thl_sec(i,j,ku)) ) - qwsec = max(zero, half*(qw_sec(i,j,kd)+qw_sec(i,j,ku)) ) - qwthlsec = half * (qwthl_sec(i,j,kd) + qwthl_sec(i,j,ku)) - wqwsec = half * (wqw_sec(i,j,kd) + wqw_sec(i,j,ku)) - wthlsec = half * (wthl_sec(i,j,kd) + wthl_sec(i,j,ku)) - else ! at the model top assuming zeros - w3var = half*w3(i,j,k) - thlsec = max(zero, half*thl_sec(i,j,k)) - qwsec = max(zero, half*qw_sec(i,j,k)) - qwthlsec = half * qwthl_sec(i,j,k) - wqwsec = half * wqw_sec(i,j,k) - wthlsec = half * wthl_sec(i,j,k) - endif + if (k < nzm) then + w3var = half*(w3(i,kd)+w3(i,ku)) + thlsec = max(zero, half*(thl_sec(i,kd)+thl_sec(i,ku)) ) + qwsec = max(zero, half*(qw_sec(i,kd)+qw_sec(i,ku)) ) + qwthlsec = half * (qwthl_sec(i,kd) + qwthl_sec(i,ku)) + wqwsec = half * (wqw_sec(i,kd) + wqw_sec(i,ku)) + wthlsec = half * (wthl_sec(i,kd) + wthl_sec(i,ku)) + else ! at the model top assuming zeros + w3var = half*w3(i,k) + thlsec = max(zero, half*thl_sec(i,k)) + qwsec = max(zero, half*qw_sec(i,k)) + qwthlsec = half * qwthl_sec(i,k) + wqwsec = half * wqw_sec(i,k) + wthlsec = half * wthl_sec(i,k) + endif -! w3var = w3(i,j,k) -! thlsec = max(zero,thl_sec(i,j,k)) -! qwsec = max(zero,qw_sec(i,j,k)) -! qwthlsec = qwthl_sec(i,j,k) -! wqwsec = wqw_sec(i,j,k) -! wthlsec = wthl_sec(i,j,k) +! w3var = w3(i,k) +! thlsec = max(zero,thl_sec(i,k)) +! qwsec = max(zero,qw_sec(i,k)) +! qwthlsec = qwthl_sec(i,k) +! wqwsec = wqw_sec(i,k) +! wthlsec = wthl_sec(i,k) ! Compute square roots of some variables so we don't have to do it again -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' w_sec=',w_sec(i,j,k),' k=',k - if (w_sec(i,j,k) > zero) then - sqrtw2 = sqrt(w_sec(i,j,k)) - else - sqrtw2 = zero - endif - if (thlsec > zero) then - sqrtthl = sqrt(thlsec) - else - sqrtthl = zero - endif - if (qwsec > zero) then - sqrtqt = sqrt(qwsec) - else - sqrtqt = zero - endif + if (w_sec(i,k) > zero) then + sqrtw2 = sqrt(w_sec(i,k)) + else + sqrtw2 = zero + endif + if (thlsec > zero) then + sqrtthl = sqrt(thlsec) + else + sqrtthl = zero + endif + if (qwsec > zero) then + sqrtqt = sqrt(qwsec) + else + sqrtqt = zero + endif ! Find parameters of the double Gaussian PDF of vertical velocity ! Skewness of vertical velocity -! Skew_w = w3var / w_sec(i,j,k)**(3./2.) -! Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi - - IF (w_sec(i,j,k) <= w_tol_sqd) THEN ! If variance of w is too small then - ! PDF is a sum of two delta functions - Skew_w = zero - w1_1 = w_first - w1_2 = w_first - w2_1 = zero - w2_2 = zero - aterm = half - onema = half - ELSE - +! Skew_w = w3var / w_sec(i,k)**(3./2.) +! Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi + + IF (w_sec(i,k) <= w_tol_sqd) THEN ! If variance of w is too small then + ! PDF is a sum of two delta functions + Skew_w = zero + w1_1 = w_first + w1_2 = w_first + w2_1 = zero + w2_2 = zero + aterm = half + onema = half + ELSE !aab - - Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi -! Proportionality coefficients between widths of each vertical velocity + + Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi +! Proportionality coefficients between widths of each vertical velocity ! gaussian and the sqrt of the second moment of w - w2_1 = 0.4 - w2_2 = 0.4 + w2_1 = 0.4 + w2_2 = 0.4 -! Compute realtive weight of the first PDF "plume" +! Compute realtive weight of the first PDF "plume" ! See Eq A4 in Pete's dissertaion - Ensure 0.01 < a < 0.99 - wrk = one - w2_1 - aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) - onema = one - aterm + wrk = one - w2_1 + aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) + onema = one - aterm - sqrtw2t = sqrt(wrk) + sqrtw2t = sqrt(wrk) ! Eq. A.5-A.6 - wrk = sqrt(onema/aterm) - w1_1 = sqrtw2t * wrk - w1_2 = - sqrtw2t / wrk + wrk = sqrt(onema/aterm) + w1_1 = sqrtw2t * wrk + w1_2 = - sqrtw2t / wrk - w2_1 = w2_1 * w_sec(i,j,k) - w2_2 = w2_2 * w_sec(i,j,k) + w2_1 = w2_1 * w_sec(i,k) + w2_2 = w2_2 * w_sec(i,k) - ENDIF + ENDIF ! Find parameters of the PDF of liquid/ice static energy -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thlsec=',thlsec,' w1_2=',w1_2,' w1_1=',w1_1,& -! ' thl_first=',thl_first,' k=',k,' wthlsec=',wthlsec,sqrtw2,sqrtthl - IF (thlsec <= thl_tol*thl_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN - thl1_1 = thl_first - thl1_2 = thl_first - thl2_1 = zero - thl2_2 = zero - sqrtthl2_1 = zero - sqrtthl2_2 = zero - ELSE - - corrtest1 = max(-one,min(one,wthlsec/(sqrtw2*sqrtthl))) - - thl1_1 = -corrtest1 / w1_2 ! A.7 - thl1_2 = -corrtest1 / w1_1 ! A.8 - - wrk1 = thl1_1 * thl1_1 - wrk2 = thl1_2 * thl1_2 - wrk3 = three * (one - aterm*wrk1 - onema*wrk2) - wrk4 = -skew_facw*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi -! wrk4 = -skew_fact*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi -! wrk4 = - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 - wrk = three * (thl1_2-thl1_1) - if (wrk /= zero) then - thl2_1 = thlsec * min(100.,max(zero,( thl1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 - thl2_2 = thlsec * min(100.,max(zero,(-thl1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 - else - thl2_1 = zero - thl2_2 = zero - endif + IF (thlsec <= thl_tol*thl_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN + thl1_1 = thl_first + thl1_2 = thl_first + thl2_1 = zero + thl2_2 = zero + sqrtthl2_1 = zero + sqrtthl2_2 = zero + ELSE + + corrtest1 = max(-one,min(one,wthlsec/(sqrtw2*sqrtthl))) + + thl1_1 = -corrtest1 / w1_2 ! A.7 + thl1_2 = -corrtest1 / w1_1 ! A.8 + + wrk1 = thl1_1 * thl1_1 + wrk2 = thl1_2 * thl1_2 + wrk3 = three * (one - aterm*wrk1 - onema*wrk2) + wrk4 = -skew_facw*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi +! wrk4 = -skew_fact*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi +! wrk4 = - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 + wrk = three * (thl1_2-thl1_1) + if (wrk /= zero) then + thl2_1 = thlsec * min(100.0d0,max(zero,(thl1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 + thl2_2 = thlsec * min(100.0d0,max(zero,(-thl1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 + else + thl2_1 = zero + thl2_2 = zero + endif ! -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thl1_1=',thl1_1,' sqrtthl=',sqrtthl,' thl_first=',thl_first,& -! ' thl1_2=',thl1_2,' corrtest1=',corrtest1,' w1_2=',w1_2,' w1_1=',w1_1 + thl1_1 = thl1_1*sqrtthl + thl_first + thl1_2 = thl1_2*sqrtthl + thl_first - thl1_1 = thl1_1*sqrtthl + thl_first - thl1_2 = thl1_2*sqrtthl + thl_first + sqrtthl2_1 = sqrt(thl2_1) + sqrtthl2_2 = sqrt(thl2_2) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thl1_1=',thl1_1,' thl1_2=',thl1_2 - - sqrtthl2_1 = sqrt(thl2_1) - sqrtthl2_2 = sqrt(thl2_2) - - ENDIF + ENDIF ! FIND PARAMETERS FOR TOTAL WATER MIXING RATIO - IF (qwsec <= rt_tol*rt_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN - qw1_1 = qw_first - qw1_2 = qw_first - qw2_1 = zero - qw2_2 = zero - sqrtqw2_1 = zero - sqrtqw2_2 = zero - ELSE + IF (qwsec <= rt_tol*rt_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN + qw1_1 = qw_first + qw1_2 = qw_first + qw2_1 = zero + qw2_2 = zero + sqrtqw2_1 = zero + sqrtqw2_2 = zero + ELSE - corrtest2 = max(-one,min(one,wqwsec/(sqrtw2*sqrtqt))) + corrtest2 = max(-one,min(one,wqwsec/(sqrtw2*sqrtqt))) - qw1_1 = - corrtest2 / w1_2 ! A.7 - qw1_2 = - corrtest2 / w1_1 ! A.8 + qw1_1 = - corrtest2 / w1_2 ! A.7 + qw1_2 = - corrtest2 / w1_1 ! A.8 - tsign = abs(qw1_2-qw1_1) + tsign = abs(qw1_2-qw1_1) -! Skew_qw = skew_facw*Skew_w +! Skew_qw = skew_facw*Skew_w - IF (tsign > 0.4) THEN - Skew_qw = skew_facw*Skew_w - ELSEIF (tsign <= 0.2) THEN - Skew_qw = zero - ELSE - Skew_qw = (skew_facw/0.2) * Skew_w * (tsign-0.2) - ENDIF + IF (tsign > 0.4) THEN + Skew_qw = skew_facw*Skew_w + ELSEIF (tsign <= 0.2) THEN + Skew_qw = zero + ELSE + Skew_qw = (skew_facw/0.2) * Skew_w * (tsign-0.2) + ENDIF - wrk1 = qw1_1 * qw1_1 - wrk2 = qw1_2 * qw1_2 - wrk3 = three * (one - aterm*wrk1 - onema*wrk2) - wrk4 = Skew_qw - aterm*wrk1*qw1_1 - onema*wrk2*qw1_2 - wrk = three * (qw1_2-qw1_1) + wrk1 = qw1_1 * qw1_1 + wrk2 = qw1_2 * qw1_2 + wrk3 = three * (one - aterm*wrk1 - onema*wrk2) + wrk4 = Skew_qw - aterm*wrk1*qw1_1 - onema*wrk2*qw1_2 + wrk = three * (qw1_2-qw1_1) - if (wrk /= zero) then - qw2_1 = qwsec * min(100.,max(zero,( qw1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 - qw2_2 = qwsec * min(100.,max(zero,(-qw1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 - else - qw2_1 = zero - qw2_2 = zero - endif + if (wrk /= zero) then + qw2_1 = qwsec * min(100.0d0,max(zero,( qw1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 + qw2_2 = qwsec * min(100.0d0,max(zero,(-qw1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 + else + qw2_1 = zero + qw2_2 = zero + endif ! - qw1_1 = qw1_1*sqrtqt + qw_first - qw1_2 = qw1_2*sqrtqt + qw_first + qw1_1 = qw1_1*sqrtqt + qw_first + qw1_2 = qw1_2*sqrtqt + qw_first - sqrtqw2_1 = sqrt(qw2_1) - sqrtqw2_2 = sqrt(qw2_2) + sqrtqw2_1 = sqrt(qw2_1) + sqrtqw2_2 = sqrt(qw2_2) - ENDIF + ENDIF ! CONVERT FROM TILDA VARIABLES TO "REAL" VARIABLES - w1_1 = w1_1*sqrtw2 + w_first - w1_2 = w1_2*sqrtw2 + w_first + w1_1 = w1_1*sqrtw2 + w_first + w1_2 = w1_2*sqrtw2 + w_first -! FIND WITHIN-PLUME CORRELATIONS +! FIND WITHIN-PLUME CORRELATIONS - testvar = aterm*sqrtqw2_1*sqrtthl2_1 + onema*sqrtqw2_2*sqrtthl2_2 + testvar = aterm*sqrtqw2_1*sqrtthl2_1 + onema*sqrtqw2_2*sqrtthl2_2 - IF (testvar == 0) THEN - r_qwthl_1 = zero - ELSE - r_qwthl_1 = max(-one,min(one,(qwthlsec-aterm*(qw1_1-qw_first)*(thl1_1-thl_first) & - -onema*(qw1_2-qw_first)*(thl1_2-thl_first))/testvar)) ! A.12 - ENDIF + IF (testvar == 0) THEN + r_qwthl_1 = zero + ELSE + r_qwthl_1 = max(-one,min(one,(qwthlsec-aterm*(qw1_1-qw_first)*(thl1_1-thl_first) & + -onema*(qw1_2-qw_first)*(thl1_2-thl_first))/testvar)) ! A.12 + ENDIF ! BEGIN TO COMPUTE CLOUD PROPERTY STATISTICS -! wrk1 = gamaz(i,j,k) - fac_cond * qpl(i,j,k) - fac_sub * qpi(i,j,k) -! Tl1_1 = thl1_1 - wrk1 -! Tl1_2 = thl1_2 - wrk1 +! wrk1 = gamaz(i,k) - fac_cond*qpl(i,k) - fac_sub*qpi(i,k) +! Tl1_1 = thl1_1 - wrk1 +! Tl1_2 = thl1_2 - wrk1 - Tl1_1 = thl1_1 - gamaz(i,j,k) - Tl1_2 = thl1_2 - gamaz(i,j,k) - -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' Tl1_1=',Tl1_1,' Tl1_2=',Tl1_2,& -! ' wrk1=',wrk1,' thl1_1=',thl1_1,' thl1_2=',thl1_2,' qpl=',qpl(i,j,k),' qpi=',qpi(i,j,k) + Tl1_1 = thl1_1 - gamaz(i,k) + Tl1_2 = thl1_2 - gamaz(i,k) ! Now compute qs - esval1_1 = zero - esval2_1 = zero - eps_ss1 = eps - eps_ss2 = eps - om1 = one - ! Partition based on temperature for the first plume - IF (Tl1_1 >= tbgmax) THEN - esval1_1 = min(fpvsl(Tl1_1), pval) -! esval1_1 = esatw(Tl1_1) - lstarn1 = lcond - ELSE IF (Tl1_1 <= tbgmin) THEN - esval1_1 = min(fpvsi(Tl1_1), pval) -! esval1_1 = esati(Tl1_1) - lstarn1 = lsub - eps_ss1 = eps * supice - ELSE - esval1_1 = min(fpvsl(Tl1_1), pval) - esval2_1 = min(fpvsi(Tl1_1), pval) -! esval1_1 = esatw(Tl1_1) -! esval2_1 = esati(Tl1_1) - om1 = max(zero, min(one, a_bg*(Tl1_1-tbgmin))) - lstarn1 = lcond + (one-om1)*lfus - eps_ss2 = eps * supice - - ENDIF - qs1 = om1 * eps_ss1*esval1_1/(pval-0.378*esval1_1) & - + (one-om1) * eps_ss2*esval2_1/(pval-0.378*esval2_1) - -! beta1 = (rgas/rv)*(lstarn1/(rgas*Tl1_1))*(lstarn1/(cp*Tl1_1)) - beta1 = (lstarn1*lstarn1*onebrvcp) / (Tl1_1*Tl1_1) ! A.18 + IF (Tl1_1 >= tbgmax) THEN + lstarn1 = lcond + esval = min(fpvsl(Tl1_1), pval) + qs1 = eps * esval / (pval-0.378d0*esval) + ELSE IF (Tl1_1 <= tbgmin) THEN + lstarn1 = lsub + esval = min(fpvsi(Tl1_1), pval) + qs1 = epss * esval / (pval-0.378d0*esval) + ELSE + om1 = max(zero, min(one, a_bg*(Tl1_1-tbgmin))) + lstarn1 = lcond + (one-om1)*lfus + esval = min(fpvsl(Tl1_1), pval) + esval2 = min(fpvsi(Tl1_1), pval) + qs1 = om1 * eps * esval / (pval-0.378d0*esval) & + + (one-om1) * epss * esval2 / (pval-0.378d0*esval2) + ENDIF + +! beta1 = (rgas/rv)*(lstarn1/(rgas*Tl1_1))*(lstarn1/(cp*Tl1_1)) +! beta1 = (lstarn1*lstarn1*onebrvcp) / (Tl1_1*Tl1_1) ! A.18 + + beta1 = lstarn1 / Tl1_1 + beta1 = beta1 * beta1 * onebrvcp ! Are the two plumes equal? If so then set qs and beta ! in each column to each other to save computation - IF (Tl1_1 == Tl1_2) THEN - qs2 = qs1 - beta2 = beta1 + IF (Tl1_1 == Tl1_2) THEN + qs2 = qs1 + beta2 = beta1 + ELSE + IF (Tl1_2 >= tbgmax) THEN + lstarn2 = lcond + esval = min(fpvsl(Tl1_2), pval) + qs2 = eps * esval / (pval-0.378d0*esval) + ELSE IF (Tl1_2 <= tbgmin) THEN + lstarn2 = lsub + esval = min(fpvsi(Tl1_2), pval) + qs2 = epss * esval / (pval-0.378d0*esval) ELSE - - esval1_2 = zero - esval2_2 = zero - eps_ss1 = eps - eps_ss2 = eps - om2 = one - - IF (Tl1_2 >= tbgmax) THEN - esval1_2 = min(fpvsl(Tl1_2), pval) -! esval1_2 = esatw(Tl1_2) - lstarn2 = lcond - ELSE IF (Tl1_2 <= tbgmin) THEN - esval1_2 = min(fpvsi(Tl1_2), pval) -! esval1_2 = esati(Tl1_2) - lstarn2 = lsub - eps_ss1 = eps * supice - ELSE - esval1_2 = min(fpvsl(Tl1_2), pval) - esval2_2 = min(fpvsi(Tl1_2), pval) -! esval1_2 = esatw(Tl1_2) -! esval2_2 = esati(Tl1_2) - om2 = max(zero, min(one, a_bg*(Tl1_2-tbgmin))) - lstarn2 = lcond + (one-om2)*lfus - eps_ss2 = eps * supice - ENDIF - - qs2 = om2 * eps_ss1*esval1_2/(pval-0.378*esval1_2) & - + (one-om2) * eps_ss2*esval2_2/(pval-0.378*esval2_2) - -! beta2 = (rgas/rv)*(lstarn2/(rgas*Tl1_2))*(lstarn2/(cp*Tl1_2)) ! A.18 - beta2 = (lstarn2*lstarn2*onebrvcp) / (Tl1_2*Tl1_2) ! A.18 - + om2 = max(zero, min(one, a_bg*(Tl1_2-tbgmin))) + lstarn2 = lcond + (one-om2)*lfus + esval = min(fpvsl(Tl1_2), pval) + esval2 = min(fpvsi(Tl1_2), pval) + qs2 = om2 * eps * esval / (pval-0.378d0*esval) & + + (one-om2) * epss * esval2 / (pval-0.378d0*esval2) ENDIF - qs1 = qs1 * rhc(i,j,k) - qs2 = qs2 * rhc(i,j,k) +! beta2 = (rgas/rv)*(lstarn2/(rgas*Tl1_2))*(lstarn2/(cp*Tl1_2)) ! A.18 +! beta2 = (lstarn2*lstarn2*onebrvcp) / (Tl1_2*Tl1_2) ! A.18 -! Now compute cloud stuff - compute s term + beta2 = lstarn2 / Tl1_2 + beta2 = beta2 * beta2 * onebrvcp - cqt1 = one / (one+beta1*qs1) ! A.19 - wrk = qs1 * (one+beta1*qw1_1) * cqt1 - s1 = qw1_1 - wrk ! A.17 - cthl1 = cqt1*wrk*cpolv*beta1*pkap ! A.20 - wrk1 = cthl1 * cthl1 - wrk2 = cqt1 * cqt1 -! std_s1 = sqrt(max(zero,wrk1*thl2_1+wrk2*qw2_1-2.*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) - std_s1 = sqrt(max(zero, wrk1*thl2_1+wrk2*qw2_1 & - - two*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) + ENDIF - qn1 = zero - C1 = zero + qs1 = qs1 * rhc(i,k) + qs2 = qs2 * rhc(i,k) - IF (std_s1 > zero) THEN - wrk = s1 / (std_s1*sqrt2) - C1 = max(zero, min(one, half*(one+erf(wrk)))) ! A.15 +! Now compute cloud stuff - compute s term -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc wrk=',wrk,' s1=','std=',std_s1,& -! ' c1=',c1*100,' qs1=',qs1,' qw1_1=',qw1_1,' k=',k + cqt1 = one / (one+beta1*qs1) ! A.19 + wrk = qs1 * (one+beta1*qw1_1) * cqt1 + s1 = qw1_1 - wrk ! A.17 + cthl1 = cqt1*wrk*cpolv*beta1*pkap ! A.20 -! IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 - qn1 = max(zero, s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk)) ! A.16 - ELSEIF (s1 > zero) THEN - C1 = one - qn1 = s1 - ENDIF + wrk1 = cthl1 * cthl1 + wrk2 = cqt1 * cqt1 +! std_s1 = sqrt(max(zero,wrk1*thl2_1+wrk2*qw2_1-2.*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) + std_s1 = sqrt(max(zero, wrk1*thl2_1+wrk2*qw2_1 & + - two*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) -! now compute non-precipitating cloud condensate + qn1 = zero + C1 = zero -! If two plumes exactly equal, then just set many of these -! variables to themselves to save on computation. - IF (qw1_1 == qw1_2 .and. thl2_1 == thl2_2 .and. qs1 == qs2) THEN - s2 = s1 - cthl2 = cthl1 - cqt2 = cqt1 - std_s2 = std_s1 - C2 = C1 - qn2 = qn1 - ELSE + IF (std_s1 > zero) THEN + wrk = s1 / (std_s1*sqrt2) + C1 = max(zero, min(one, half*(one+erf(wrk)))) ! A.15 - cqt2 = one / (one+beta2*qs2) - wrk = qs2 * (one+beta2*qw1_2) * cqt2 - s2 = qw1_2 - wrk - cthl2 = wrk*cqt2*cpolv*beta2*pkap - wrk1 = cthl2 * cthl2 - wrk2 = cqt2 * cqt2 -! std_s2 = sqrt(max(zero,wrk1*thl2_2+wrk2*qw2_2-2.*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) - std_s2 = sqrt(max(zero, wrk1*thl2_2+wrk2*qw2_2 & - - two*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) - - qn2 = zero - C2 = zero - - IF (std_s2 > zero) THEN - wrk = s2 / (std_s2*sqrt2) - C2 = max(zero, min(one, half*(one+erf(wrk)))) -! IF (C2 > zero) qn2 = s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk) - qn2 = max(zero, s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk)) - ELSEIF (s2 > zero) THEN - C2 = one - qn2 = s2 - ENDIF + IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 +!! ELSEIF (s1 >= qcmin) THEN +!! C1 = one +!! qn1 = s1 + ENDIF - ENDIF +! now compute non-precipitating cloud condensate -! finally, compute the SGS cloud fraction - diag_frac = aterm*C1 + onema*C2 +! If two plumes exactly equal, then just set many of these +! variables to themselves to save on computation. + IF (qw1_1 == qw1_2 .and. thl2_1 == thl2_2 .and. qs1 == qs2) THEN + s2 = s1 + cthl2 = cthl1 + cqt2 = cqt1 + std_s2 = std_s1 + C2 = C1 + qn2 = qn1 + ELSE + + cqt2 = one / (one+beta2*qs2) + wrk = qs2 * (one+beta2*qw1_2) * cqt2 + s2 = qw1_2 - wrk + cthl2 = wrk*cqt2*cpolv*beta2*pkap + wrk1 = cthl2 * cthl2 + wrk2 = cqt2 * cqt2 +! std_s2 = sqrt(max(zero,wrk1*thl2_2+wrk2*qw2_2-2.*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) + std_s2 = sqrt(max(zero, wrk1*thl2_2+wrk2*qw2_2 & + - two*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) + + qn2 = zero + C2 = zero + + IF (std_s2 > zero) THEN + wrk = s2 / (std_s2*sqrt2) + C2 = max(zero, min(one, half*(one+erf(wrk)))) + IF (C2 > zero) qn2 = s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk) +!! ELSEIF (s2 >= qcmin) THEN +!! C2 = one +!! qn2 = s2 + ENDIF - om1 = max(zero, min(one, (Tl1_1-tbgmin)*a_bg)) - om2 = max(zero, min(one, (Tl1_2-tbgmin)*a_bg)) + ENDIF - qn1 = min(qn1,qw1_1) - qn2 = min(qn2,qw1_2) +! finally, compute the SGS cloud fraction + diag_frac = aterm*C1 + onema*C2 - ql1 = qn1*om1 - ql2 = qn2*om2 + om1 = max(zero, min(one, (Tl1_1-tbgmin)*a_bg)) + om2 = max(zero, min(one, (Tl1_2-tbgmin)*a_bg)) - qi1 = qn1 - ql1 - qi2 = qn2 - ql2 + qn1 = min(qn1,qw1_1) + qn2 = min(qn2,qw1_2) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc qi=',qi1,qi2,' ql=',ql1,ql2,& -! ' c1=',c1,' c2=',c2,' s1=',s1,' s2=',s2,' k=',k,' tl1=',tl1_1,tl1_2,' om1=',om1,'om2=',om2& -! ,' tbgmin=',tbgmin,'a_bg=',a_bg + ql1 = qn1*om1 + ql2 = qn2*om2 + qi1 = qn1 - ql1 + qi2 = qn2 - ql2 - diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,j,k)) - diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) - diag_qi = diag_qn - diag_ql + diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,k)) + diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) + diag_qi = diag_qn - diag_ql ! Update temperature variable based on diagnosed cloud properties - om1 = max(zero, min(one, (tabs(i,j,k)-tbgmin)*a_bg)) - lstarn1 = lcond + (one-om1)*lfus - tabs(i,j,k) = hl(i,j,k) - gamaz(i,j,k) + fac_cond*(diag_ql+qpl(i,j,k)) & - + fac_sub *(diag_qi+qpi(i,j,k)) & - + tkesbdiss(i,j,k) * (dtn/cp) ! tke dissipative heating - -! if (lprnt .and. i == ipr .and. k < 40) write(0,*)' tabsout=',tabs(ipr,1,k),' k=',k& -! ,' hl=',hl(i,j,k),' gamaz=',gamaz(i,j,k),' diag_ql=',diag_ql,' qpl=',qpl(i,j,k)& -! ,' diag_qi=',diag_qi,' qpi=',qpi(i,j,k),' diag_qn =',diag_qn ,' aterm=',aterm,' onema=',onema& -! ,' qn1=',qn1 ,' qn2=',qn2,' ql1=',ql1,' ql2=',ql2 + om1 = max(zero, min(one, (tabs(i,k)-tbgmin)*a_bg)) + lstarn1 = lcond + (one-om1)*lfus + tabs(i,k) = hl(i,k) - gamaz(i,k) + fac_cond*(diag_ql+qpl(i,k)) & + + fac_sub *(diag_qi+qpi(i,k)) & + + tkesbdiss(i,k) * (dtn/cp) ! tke dissipative heating + ! Update moisture fields ! Update ncpl and ncpi Anning Cheng 03/11/2016 -! ncpl(i,j,k) = diag_ql/max(qc(i,j,k),1.e-10)*ncpl(i,j,k) -! The following commneted by Moorthi on April 26, 2017 to test blowing up -! ncpl(i,j,k) = (1.0-diag_ql/max(qc(i,j,k),1.e-10)) * ncpl(i,j,k) -! ncpi(i,j,k) = (1.0-diag_qi/max(qi(i,j,k),1.e-10)) * ncpi(i,j,k) - qc(i,j,k) = diag_ql - qi(i,j,k) = diag_qi - qwv(i,j,k) = total_water(i,j,k) - diag_qn - cld_sgs(i,j,k) = diag_frac +! ncpl(i,k) = diag_ql/max(qc(i,k),1.e-10)*ncpl(i,k) + + qc(i,k) = diag_ql + qi(i,k) = diag_qi + qwv(i,k) = total_water(i,k) - diag_qn + cld_sgs(i,k) = diag_frac +! Update ncpl and ncpi Moorthi 12/12/2018 + if (ntlnc > 0) then ! liquid and ice number concentrations predicted + if (ncpl(i,k) > nmin) then + ncpl(i,k) = diag_ql/max(qc(i,k),1.0d-10)*ncpl(i,k) + else + ncpl(i,k) = max(diag_ql/(fourb3*pi*RL_cub*997.0d0), nmin) + endif + if (ncpi(i,k) > nmin) then + ncpi(i,k) = diag_qi/max(qi(i,k),1.0d-10)*ncpi(i,k) + else + ncpi(i,k) = max(diag_qi/(fourb3*pi*RI_cub*500.0d0), nmin) + endif + endif ! Compute the liquid water flux - wqls = aterm * ((w1_1-w_first)*ql1) + onema * ((w1_2-w_first)*ql2) - wqis = aterm * ((w1_1-w_first)*qi1) + onema * ((w1_2-w_first)*qi2) + wqls = aterm * ((w1_1-w_first)*ql1) + onema * ((w1_2-w_first)*ql2) + wqis = aterm * ((w1_1-w_first)*qi1) + onema * ((w1_2-w_first)*qi2) ! Compute statistics for the fluxes so we don't have to save these variables - wqlsb(k) = wqlsb(k) + wqls - wqisb(k) = wqisb(k) + wqis + wqlsb(k) = wqlsb(k) + wqls + wqisb(k) = wqisb(k) + wqis ! diagnostic buoyancy flux. Includes effects from liquid water, ice ! condensate, liquid & ice precipitation -! wrk = epsv * basetemp - wrk = epsv * thv(i,j,k) +! wrk = epsv * basetemp + wrk = epsv * thv(i,k) - bastoeps = onebeps * thv(i,j,k) + bastoeps = onebeps * thv(i,k) - if (k < nzm) then - wthv_sec(i,j,k) = wthlsec + wrk*wqwsec & - + (fac_cond-bastoeps)*wqls & - + (fac_sub-bastoeps) *wqis & - + ((lstarn1/cp)-thv(i,j,k))*half*(wqp_sec(i,j,kd)+wqp_sec(i,j,ku)) - else - wthv_sec(i,j,k) = wthlsec + wrk*wqwsec & - + (fac_cond-bastoeps)*wqls & - + (fac_sub-bastoeps) *wqis & - + ((lstarn1/cp)-thv(i,j,k))*half*wqp_sec(i,j,k) - endif + if (k < nzm) then + wthv_sec(i,k) = wthlsec + wrk*wqwsec & + + (fac_cond-bastoeps)*wqls & + + (fac_sub-bastoeps) *wqis & + + ((lstarn1/cp)-thv(i,k))*half*(wqp_sec(i,kd)+wqp_sec(i,ku)) + else + wthv_sec(i,k) = wthlsec + wrk*wqwsec & + + (fac_cond-bastoeps)*wqls & + + (fac_sub-bastoeps) *wqis & + + ((lstarn1/cp)-thv(i,k))*half*wqp_sec(i,k) + endif -! wthv_sec(i,j,k) = wthlsec + wrk*wqwsec & -! + (fac_cond-bastoeps)*wqls & -! + (fac_sub-bastoeps)*wqis & -! + ((lstarn1/cp)-basetemp)*half*(wqp_sec(i,j,kd)+wqp_sec(i,j,ku)) +! wthv_sec(i,k) = wthlsec + wrk*wqwsec & +! + (fac_cond-bastoeps)*wqls & +! + (fac_sub-bastoeps)*wqis & +! + ((lstarn1/cp)-basetemp)*half*(wqp_sec(i,kd)+wqp_sec(i,ku)) - ENDDO ENDDO ENDDO @@ -1872,7 +1720,7 @@ end subroutine assumed_pdf real function esatw(t) - real t ! temperature (K) + real t ! temperature (K) real a0,a1,a2,a3,a4,a5,a6,a7,a8 data a0,a1,a2,a3,a4,a5,a6,a7,a8 / & 6.11239921, 0.443987641, 0.142986287e-1, & @@ -1885,8 +1733,8 @@ end function esatw real function qsatw(t,p) ! implicit none - real t ! temperature (K) - real p ! pressure (Pa) + real t ! temperature (K) + real p ! pressure (Pa) real esat ! esat = fpvs(t) esat = fpvsl(t) @@ -1897,7 +1745,7 @@ end function qsatw real function esati(t) - real t ! temperature (K) + real t ! temperature (K) real a0,a1,a2,a3,a4,a5,a6,a7,a8 data a0,a1,a2,a3,a4,a5,a6,a7,a8 / & 6.11147274, 0.503160820, 0.188439774e-1, & diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index 9fb5cb38d..fb4d7e515 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -25,78 +25,6 @@ type = integer intent = in optional = F -[do_shoc] - standard_name = flag_for_shoc - long_name = flag for SHOC - units = flag - dimensions = () - type = logical - intent = in - optional = F -[shocaftcnv] - standard_name = flag_for_shoc_after_convection - long_name = flag to execute SHOC after convection - units = flag - dimensions = () - type = logical - intent = in - optional = F -[mg3_as_mg2] - standard_name = flag_mg3_as_mg2 - long_name = flag for controlling prep for Morrison-Gettelman microphysics - units = flag - dimensions = () - type = logical - intent = in - optional = F -[imp_physics] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imp_physics_gfdl] - standard_name = flag_for_gfdl_microphysics_scheme - long_name = choice of GFDL microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imp_physics_zhao_carr] - standard_name = flag_for_zhao_carr_microphysics_scheme - long_name = choice of Zhao-Carr microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imp_physics_zhao_carr_pdf] - standard_name = flag_for_zhao_carr_pdf_microphysics_scheme - long_name = choice of Zhao-Carr microphysics scheme with PDF clouds - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imp_physics_mg] - standard_name = flag_for_morrison_gettelman_microphysics_scheme - long_name = choice of Morrison-Gettelman microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[fprcp] - standard_name = number_of_frozen_precipitation_species - long_name = number of frozen precipitation species - units = count - dimensions = () - type = integer - intent = in - optional = F [tcr] standard_name = cloud_phase_transition_threshold_temperature long_name = threshold temperature below which cloud starts to freeze @@ -187,42 +115,6 @@ kind = kind_phys intent = in optional = F -[gq0_cloud_ice] - standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[gq0_rain] - standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[gq0_snow] - standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[gq0_graupel] - standard_name = graupel_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [dtp] standard_name = time_step_for_physics long_name = time step for physics @@ -249,6 +141,15 @@ kind = kind_phys intent = in optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [phii] standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces @@ -384,76 +285,95 @@ kind = kind_phys intent = in optional = F -[skip_macro] - standard_name = flag_skip_macro - long_name = flag to skip cloud macrophysics in Morrison scheme - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[clw_ice] - standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array - units = kg kg-1 +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = inout optional = F -[clw_liquid] - standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout optional = F -[gq0_cloud_liquid] - standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in optional = F -[ncpl] - standard_name = cloud_droplet_number_concentration_updated_by_physics - long_name = number concentration of cloud droplets updated by physics - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in optional = F -[ncpi] - standard_name = ice_number_concentration_updated_by_physics - long_name = number concentration of ice updated by physics - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in optional = F -[gt0] - standard_name = air_temperature_updated_by_physics - long_name = temperature updated by physics - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in optional = F -[gq0_water_vapor] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in optional = F [cld_sgs] standard_name = subgrid_scale_cloud_fraction_from_shoc @@ -491,6 +411,22 @@ kind = kind_phys intent = inout optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/gscond.meta b/physics/gscond.meta index a317b8529..a25c268b3 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -82,7 +82,7 @@ optional = F [clw1] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = mixing ratio of ice water in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -91,7 +91,7 @@ optional = F [clw2] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = mixing ratio of cloud water (condensate) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 40025a898..1ee4eeeb5 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -50,7 +50,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, if (is_initialized) return - if (imp_physics/=imp_physics_mg) then + if (imp_physics /= imp_physics_mg) then write(errmsg,'(*(a))') "Logic error: namelist choice of microphysics is different from Morrison-Gettelman MP" errflg = 1 return @@ -67,10 +67,10 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, hetfrz_classnuc, & mg_precip_frac_method, & mg_berg_eff_factor, & - sed_supersat, do_sb_physics, & + sed_supersat, do_sb_physics, & mg_do_ice_gmao, mg_do_liq_liu, & - mg_nccons, mg_nicons, & - mg_ncnst, mg_ninst) + mg_nccons, mg_nicons, & + mg_ncnst, mg_ninst) elseif (fprcp == 2) then call micro_mg_init3_0(kind_phys, gravit, rair, rh2o, cpair, & tmelt, latvap, latice, mg_rhmini, & @@ -81,11 +81,11 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, hetfrz_classnuc, & mg_precip_frac_method, & mg_berg_eff_factor, & - sed_supersat, do_sb_physics, & + sed_supersat, do_sb_physics, & mg_do_ice_gmao, mg_do_liq_liu, & - mg_nccons, mg_nicons, & - mg_ncnst, mg_ninst, & - mg_ngcons, mg_ngnst) + mg_nccons, mg_nicons, & + mg_ncnst, mg_ninst, & + mg_ngcons, mg_ngnst) else write(0,*)' fprcp = ',fprcp,' is not a valid option - aborting' stop @@ -138,7 +138,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & &, skip_macro & &, lprnt, alf_fac, qc_min, pdfflag & &, ipr, kdt, xlat, xlon, rhc_i, & - & errmsg, errflg) + & me, errmsg, errflg) use machine , only: kind_phys use physcons, grav => con_g, pi => con_pi, & @@ -182,7 +182,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & fourb3=4.0/3.0, RL_cub=1.0e-15, nmin=1.0 integer, parameter :: ncolmicro = 1 - integer,intent(in) :: im, ix,lm, ipr, kdt, fprcp, pdfflag + integer,intent(in) :: im, ix,lm, ipr, kdt, fprcp, pdfflag, me logical,intent(in) :: flipv, aero_in, skip_macro, lprnt, iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) @@ -643,7 +643,6 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! deallocate (vmip) ! endif - do l=lm-1,1,-1 do i=1,im tx1 = 0.5 * (temp(i,l+1) + temp(i,l)) @@ -1674,14 +1673,21 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !TVQX1 = SUM( ( Q1 + QL_TOT + QI_TOT(1:im,:,:))*DM, 3) & - if (skip_macro) then do k=1,lm do i=1,im + QLCN(i,k) = QL_TOT(i,k) * FQA(i,k) + QLLS(i,k) = QL_TOT(i,k) - QLCN(i,k) + QICN(i,k) = QI_TOT(i,k) * FQA(i,k) + QILS(i,k) = QI_TOT(i,k) - QICN(i,k) + CALL fix_up_clouds_2M(Q1(I,K), TEMP(i,k), QLLS(I,K), & & QILS(I,K), CLLS(I,K), QLCN(I,K), & & QICN(I,K), CLCN(I,K), NCPL(I,K), & & NCPI(I,K), qc_min) + + QL_TOT(I,K) = QLLS(I,K) + QLCN(I,K) + QI_TOT(I,K) = QILS(I,K) + QICN(I,K) if (rnw(i,k) <= qc_min(1)) then ncpl(i,k) = 0.0 elseif (ncpl(i,k) <= nmin) then ! make sure NL > 0 if Q >0 diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 91b0c1df0..b3a42c709 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -380,7 +380,7 @@ optional = F [qlls_i] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = mixing ratio of cloud water (condensate) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -398,7 +398,7 @@ optional = F [qils_i] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = mixing ratio of ice water in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -587,7 +587,7 @@ optional = F [lwm_o] standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics + long_name = mixing ratio of cloud condensed water updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -596,7 +596,7 @@ optional = F [qi_o] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics + long_name = mixing ratio of ice water updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -658,7 +658,7 @@ optional = F [rnw_io] standard_name = local_rain_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water local to physics + long_name = mixing ratio of rain water local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -667,7 +667,7 @@ optional = F [snw_io] standard_name = local_snow_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water local to physics + long_name = mixing ratio of snow water local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -676,7 +676,7 @@ optional = F [qgl_io] standard_name = local_graupel_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel local to physics + long_name = mixing ratio of graupel local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -900,6 +900,14 @@ kind = kind_phys intent = in optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/m_micro_interstitial.F90 b/physics/m_micro_interstitial.F90 index 2ab2b68db..930b32b3d 100644 --- a/physics/m_micro_interstitial.F90 +++ b/physics/m_micro_interstitial.F90 @@ -23,7 +23,7 @@ end subroutine m_micro_pre_init #endif subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq0_ice, gq0_water, gq0_rain, & gq0_snow, gq0_graupel, gq0_rain_nc, gq0_snow_nc, gq0_graupel_nc, cld_shoc, cnvc, cnvw, tcr, tcrf, gt0, & - qrn, qsnw, qgl, ncpr, ncps, ncgl, cld_frc_MG, qlcn, qicn, cf_upi, clw_water, clw_ice, clcn, errmsg, errflg ) + qrn, qsnw, qgl, ncpr, ncps, ncgl, cld_frc_MG, clw_water, clw_ice, clcn, errmsg, errflg ) use machine, only : kind_phys implicit none @@ -41,7 +41,7 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq real(kind=kind_phys), intent(inout) :: & qrn(:,:), qsnw(:,:), qgl(:,:), ncpr(:,:), ncps(:,:), ncgl(:,:), & - cld_frc_MG(:,:), cf_upi(:,:), qlcn(:,:), qicn(:,:) + cld_frc_MG(:,:) real(kind=kind_phys), intent(out) :: clw_ice(:,:), clw_water(:,:) @@ -62,39 +62,39 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq ! in other procceses too. August 28/2015; Hope that can be done next ! year. I believe this will make the physical interaction more reasonable ! Anning 12/5/2015 changed ntcw hold liquid only + skip_macro = do_shoc if (do_shoc) then - skip_macro = do_shoc if (fprcp == 0) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) + clw_ice(i,k) = gq0_ice(i,k) + clw_water(i,k) = gq0_water(i,k) cld_frc_MG(i,k) = cld_shoc(i,k) enddo enddo else if ((abs(fprcp) == 1) .or. mg3_as_mg2) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) + clw_ice(i,k) = gq0_ice(i,k) + clw_water(i,k) = gq0_water(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) cld_frc_MG(i,k) = cld_shoc(i,k) enddo enddo else do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = gq0_graupel(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) - ncgl(i,k) = gq0_graupel_nc(i,k) + clw_ice(i,k) = gq0_ice(i,k) + clw_water(i,k) = gq0_water(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + qgl(i,k) = gq0_graupel(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) + ncgl(i,k) = gq0_graupel_nc(i,k) cld_frc_MG(i,k) = cld_shoc(i,k) enddo enddo @@ -103,32 +103,32 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq if (fprcp == 0 ) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) + clw_ice(i,k) = gq0_ice(i,k) clw_water(i,k) = gq0_water(i,k) enddo enddo elseif (abs(fprcp) == 1 .or. mg3_as_mg2) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) + clw_ice(i,k) = gq0_ice(i,k) clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) enddo enddo else do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) + clw_ice(i,k) = gq0_ice(i,k) clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = gq0_graupel(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) - ncgl(i,k) = gq0_graupel_nc(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + qgl(i,k) = gq0_graupel(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) + ncgl(i,k) = gq0_graupel_nc(i,k) enddo enddo endif @@ -243,8 +243,8 @@ subroutine m_micro_post_run( & do i=1,im if (abs(qrn(i,k)) < qsmall) qrn(i,k) = 0.0 if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = 0.0 - gq0_rain(i,k) = qrn(i,k) - gq0_snow(i,k) = qsnw(i,k) + gq0_rain(i,k) = qrn(i,k) + gq0_snow(i,k) = qsnw(i,k) gq0_rain_nc(i,k) = ncpr(i,k) gq0_snow_nc(i,k) = ncps(i,k) enddo @@ -259,11 +259,11 @@ subroutine m_micro_post_run( & if (abs(qrn(i,k)) < qsmall) qrn(i,k) = 0.0 if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = 0.0 if (abs(qgl(i,k)) < qsmall) qgl(i,k) = 0.0 - gq0_rain(i,k) = qrn(i,k) - gq0_snow(i,k) = qsnw(i,k) - gq0_graupel(i,k) = qgl(i,k) - gq0_rain_nc(i,k) = ncpr(i,k) - gq0_snow_nc(i,k) = ncps(i,k) + gq0_rain(i,k) = qrn(i,k) + gq0_snow(i,k) = qsnw(i,k) + gq0_graupel(i,k) = qgl(i,k) + gq0_rain_nc(i,k) = ncpr(i,k) + gq0_snow_nc(i,k) = ncps(i,k) gq0_graupel_nc(i,k) = ncgl(i,k) enddo enddo diff --git a/physics/m_micro_interstitial.meta b/physics/m_micro_interstitial.meta index 17358de83..4749ff128 100644 --- a/physics/m_micro_interstitial.meta +++ b/physics/m_micro_interstitial.meta @@ -56,7 +56,7 @@ optional = F [gq0_ice] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics + long_name = mixing ratio of ice water updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -65,7 +65,7 @@ optional = F [gq0_water] standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics + long_name = mixing ratio of cloud condensed water updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -74,7 +74,7 @@ optional = F [gq0_rain] standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics + long_name = mixing ratio of rain water updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -83,7 +83,7 @@ optional = F [gq0_snow] standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water updated by physics + long_name = mixing ratio of snow water updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -92,7 +92,7 @@ optional = F [gq0_graupel] standard_name = graupel_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics + long_name = mixing ratio of graupel updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -182,7 +182,7 @@ optional = F [qrn] standard_name = local_rain_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water local to physics + long_name = mixing ratio of rain water local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -191,7 +191,7 @@ optional = F [qsnw] standard_name = local_snow_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water local to physics + long_name = mixing ratio of snow water local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -200,7 +200,7 @@ optional = F [qgl] standard_name = local_graupel_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel local to physics + long_name = mixing ratio of graupel local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -243,36 +243,9 @@ kind = kind_phys intent = inout optional = F -[qlcn] - standard_name = mass_fraction_of_convective_cloud_liquid_water - long_name = mass fraction of convective cloud liquid water - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qicn] - standard_name = mass_fraction_of_convective_cloud_ice - long_name = mass fraction of convective cloud ice water - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cf_upi] - standard_name = convective_cloud_fraction_for_microphysics - long_name = convective cloud fraction for microphysics - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [clw_water] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = mixing ratio of cloud water (condensate) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -281,7 +254,7 @@ optional = F [clw_ice] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = mixing ratio of ice water in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -390,7 +363,7 @@ optional = F [qrn] standard_name = local_rain_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water local to physics + long_name = mixing ratio of rain water local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -399,7 +372,7 @@ optional = F [qsnw] standard_name = local_snow_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water local to physics + long_name = mixing ratio of snow water local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -408,7 +381,7 @@ optional = F [qgl] standard_name = local_graupel_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel local to physics + long_name = mixing ratio of graupel local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -417,7 +390,7 @@ optional = F [gq0_ice] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics + long_name = mixing ratio of ice water updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -426,7 +399,7 @@ optional = F [gq0_rain] standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics + long_name = mixing ratio of rain water updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -435,7 +408,7 @@ optional = F [gq0_snow] standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water updated by physics + long_name = mixing ratio of snow water updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -444,7 +417,7 @@ optional = F [gq0_graupel] standard_name = graupel_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics + long_name = mixing ratio of graupel updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index d9d47a347..c707ba9da 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -251,8 +251,10 @@ module micro_mg3_0 subroutine micro_mg_init( & kind, gravit, rair, rh2o, cpair, & tmelt_in, latvap, latice, & - rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & !++ag - micro_mg_do_hail_in, micro_mg_do_graupel_in, &!--ag + rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & +!++ag + micro_mg_do_hail_in, micro_mg_do_graupel_in, & +!--ag microp_uniform_in, do_cldice_in, use_hetfrz_classnuc_in, & micro_mg_precip_frac_method_in, micro_mg_berg_eff_factor_in, & allow_sed_supersat_in, do_sb_physics_in, & @@ -437,8 +439,10 @@ subroutine micro_mg_tend ( & qcn, qin, & ncn, nin, & qrn, qsn, & - nrn, nsn, &!++ag - qgr, ngr, &!--ag + nrn, nsn, & +!++ag + qgr, ngr, & +!--ag relvar, accre_enhan_i, & p, pdel, & cldn, liqcldf, icecldf, qsatfac, & @@ -449,8 +453,10 @@ subroutine micro_mg_tend ( & qctend, qitend, & nctend, nitend, & qrtend, qstend, & - nrtend, nstend, &!++ag - qgtend, ngtend, &!--ag + nrtend, nstend, & +!++ag + qgtend, ngtend, & +!--ag effc, effc_fn, effi, & sadice, sadsnow, & prect, preci, & @@ -459,30 +465,42 @@ subroutine micro_mg_tend ( & prain, prodsnow, & cmeout, deffi, & pgamrad, lamcrad, & - qsout, dsout, &!++ag - qgout, ngout, dgout, &!--ag - lflx, iflx, &!++ag - gflx, &!--ag - rflx, sflx, qrout, &!++ag - reff_rain, reff_snow, reff_grau, &!--ag + qsout, dsout, & +!++ag + qgout, ngout, dgout, & +!--ag + lflx, iflx, & +!++ag + gflx, & +!--ag + rflx, sflx, qrout, & +!++ag + reff_rain, reff_snow, reff_grau, & +!--ag qcsevap, qisevap, qvres, & cmeitot, vtrmc, vtrmi, & - umr, ums, &!++ag - umg, qgsedten, &!--ag + umr, ums, & +!++ag + umg, qgsedten, & +!--ag qcsedten, qisedten, & qrsedten, qssedten, & pratot, prctot, & mnuccctot, mnuccttot, msacwitot, & psacwstot, bergstot, bergtot, & melttot, homotot, & - qcrestot, prcitot, praitot, &!++ag - qirestot, mnuccrtot, mnuccritot, pracstot, &!--ag - meltsdttot, frzrdttot, mnuccdtot, &!++ag + qcrestot, prcitot, praitot, & +!++ag + qirestot, mnuccrtot, mnuccritot, pracstot, & +!--ag + meltsdttot, frzrdttot, mnuccdtot, & +!++ag pracgtot, psacwgtot, pgsacwtot, & pgracstot, prdgtot, & qmultgtot, qmultrgtot, psacrtot, & npracgtot, nscngtot, ngracstot, & - nmultgtot, nmultrgtot, npsacwgtot, &!--ag + nmultgtot, nmultrgtot, npsacwgtot, & +!--ag nrout, nsout, & refl, arefl, areflz, & frefl, csrfl, acsrfl, & @@ -490,8 +508,10 @@ subroutine micro_mg_tend ( & ncai, ncal, & qrout2, qsout2, & nrout2, nsout2, & - drout2, dsout2, &!++ag - qgout2, ngout2, dgout2, freqg, &!--ag + drout2, dsout2, & +!++ag + qgout2, ngout2, dgout2, freqg, & +!--ag freqs, freqr, & nfice, qcrat, & prer_evap, xlat, xlon, lprnt, iccn, aero_in, nlball) diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 61a9ccb70..a202b4bef 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -157,7 +157,7 @@ optional = F [qgrs_liquid_cloud] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = mixing ratio of cloud water (condensate) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -166,7 +166,7 @@ optional = F [qgrs_ice_cloud] standard_name = ice_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water + long_name = mixing ratio of ice water units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 2f877075c..3cd1781a3 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -105,7 +105,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = mixing ratio of cloud water (condensate) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_MYNNrad_post.meta b/physics/module_MYNNrad_post.meta index b09abe01e..49eebdf09 100644 --- a/physics/module_MYNNrad_post.meta +++ b/physics/module_MYNNrad_post.meta @@ -27,7 +27,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = no condensates) mixing ratio of cloud water (condensate) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -36,7 +36,7 @@ optional = F [qi] standard_name = ice_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water + long_name = mixing ratio of ice water units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -45,7 +45,7 @@ optional = F [qc_save] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = mixing ratio of cloud water (condensate) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -54,7 +54,7 @@ optional = F [qi_save] standard_name = ice_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water before entering a physics scheme + long_name = mixing ratio of ice water before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_MYNNrad_pre.meta b/physics/module_MYNNrad_pre.meta index 617ee3f31..0f6d97b11 100644 --- a/physics/module_MYNNrad_pre.meta +++ b/physics/module_MYNNrad_pre.meta @@ -27,7 +27,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = mixing ratio of cloud water (condensate) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -36,7 +36,7 @@ optional = F [qi] standard_name = ice_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water + long_name = mixing ratio of ice water units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -54,7 +54,7 @@ optional = F [qc_save] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = mixing ratio of cloud water (condensate) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -63,7 +63,7 @@ optional = F [qi_save] standard_name = ice_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water before entering a physics scheme + long_name = mixing ratio of ice water before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/moninshoc.f b/physics/moninshoc.f index df123958a..4ab08e47e 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -25,15 +25,15 @@ end subroutine moninshoc_finalize !! \htmlinclude moninshoc_run.html !! subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, - & u1,v1,t1,q1,tkh,prnum,ntke, - & psk,rbsoil,zorl,u10m,v10m,fm,fh, - & tsea,heat,evap,stress,spd1,kpbl, - & prsi,del,prsl,prslk,phii,phil,delt, - & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, - & kinver,xkzm_m,xkzm_h,xkzm_s,xkzminv, - & lprnt,ipr,me, - & grav, rd, cp, hvap, fv, - & errmsg,errflg) + & u1,v1,t1,q1,tkh,prnum,ntke, + & psk,rbsoil,zorl,u10m,v10m,fm,fh, + & tsea,heat,evap,stress,spd1,kpbl, + & prsi,del,prsl,prslk,phii,phil,delt, + & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, + & kinver,xkzm_m,xkzm_h,xkzm_s,xkzminv, + & lprnt,ipr,me, + & grav, rd, cp, hvap, fv, + & errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -59,12 +59,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, real(kind=kind_phys), dimension(ix,km,ntrac), intent(in) :: q1 real(kind=kind_phys), dimension(im,km), intent(inout) :: du, dv, - & tau, prnum + & tau real(kind=kind_phys), dimension(im,km,ntrac), intent(inout) :: rtg integer, dimension(im), intent(out) :: kpbl real(kind=kind_phys), dimension(im), intent(out) :: dusfc, & dvsfc, dtsfc, dqsfc, hpbl + real(kind=kind_phys), dimension(im,km), intent(out) :: prnum real(kind=kind_phys), dimension(im,km-1), intent(out) :: dkt character(len=*), intent(out) :: errmsg @@ -93,14 +94,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, &, spdk2, rbint, ri, zol1, robn, bvf2 ! real(kind=kind_phys), parameter :: zolcr=0.2, - & zolcru=-0.5, rimin=-100., sfcfrac=0.1, - & crbcon=0.25, crbmin=0.15, crbmax=0.35, - & qmin=1.e-8, zfmin=1.e-8, qlmin=1.e-12, - & aphi5=5., aphi16=16., f0=1.e-4 + & zolcru=-0.5, rimin=-100., sfcfrac=0.1, + & crbcon=0.25, crbmin=0.15, crbmax=0.35, + & qmin=1.e-8, zfmin=1.e-8, qlmin=1.e-12, + & aphi5=5., aphi16=16., f0=1.e-4 &, dkmin=0.0, dkmax=1000. -! &, dkmin=0.0, dkmax=1000., xkzminv=0.3 - &, prmin=0.25, prmax=4.0 - &, vk=0.4, cfac=6.5 +! &, dkmin=0.0, dkmax=1000., xkzminv=0.3 + &, prmin=0.25, prmax=4.0, vk=0.4, cfac=6.5 real(kind=kind_phys) :: gravi, cont, conq, conw, gocp gravi = 1.0/grav @@ -119,7 +119,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! if (ix < im) stop ! -! if (lprnt) write(0,*)' in moninshoc tsea=',tsea(ipr) + if (lprnt) write(0,*)' in moninshoc tsea=',tsea(ipr) + &, ' grav=',grav, rd, cp, hvap, fv,' ipr=',ipr + &,' ntke=',ntke,' ntcw=',ntcw + if (lprnt) write(0,*)' in moninshoc tin=',t1(ipr,:) + if (lprnt) write(0,*)' in moninshoc qin=',q1(ipr,:,1) + if (lprnt) write(0,*)' in moninshoc qwin=',q1(ipr,:,2) + if (lprnt) write(0,*)' in moninshoc qiin=',q1(ipr,:,3) dt2 = delt rdt = 1. / dt2 km1 = km - 1 @@ -162,8 +168,9 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo enddo ! if (lprnt) then -! print *,' xkzo=',(xkzo(ipr,k),k=1,km1) -! print *,' xkzmo=',(xkzmo(ipr,k),k=1,km1) +! write(0,*)' tx1=',tx1(ipr),' kinver=',kinver(ipr) +! write(0,*)' xkzo=',xkzo(ipr,:) +! write(0,*)' xkzmo=',xkzmo(ipr,:) ! endif ! ! diffusivity in the inversion layer is set to be xkzminv (m^2/s) @@ -543,6 +550,8 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo endif ! +! if (lprnt) write(0,*)' in moninshoc tau=',tau(ipr,:)*86400 + return end subroutine moninshoc_run diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index f506b6ab0..480cc419d 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -137,7 +137,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = inout + intent = out optional = F [ntke] standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 84f271eff..8ba7591c3 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -11,13 +11,12 @@ module rascnv &, rv => con_rv, cvap => con_cvap & &, cliq => con_cliq, csol => con_csol, ttp=> con_ttp & &, eps => con_eps, epsm1 => con_epsm1 - USE FUNCPHYS , ONLY : fpvs implicit none public :: rascnv_init, rascnv_run, rascnv_finalize private logical :: is_initialized = .False. ! -! integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s + integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s integer, parameter :: idnmax=999 real (kind=kind_phys), parameter :: delt_c=1800.0/3600.0 & @@ -38,7 +37,7 @@ module rascnv &, ONE_M2=1.E-2, ONE_M1=1.E-1 & &, oneolog10=one/log(10.0) & &, deg2rad=pi/180.d0 & ! conversion factor from degree to radians -! &, pa2mb = 0.01 !& ! conversion factor from Pa to hPa (or mb) + &, facmb = 0.01 & ! conversion factor from Pa to hPa (or mb) &, cmb2pa = 100.0 ! Conversion from hPa to Pa ! real(kind=kind_phys), parameter :: & @@ -363,9 +362,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & real(kind=kind_phys) CFAC, TEM, sgc, ccwfac, tem1, tem2, rain & &, wfnc,tla,pl,qiid,qlid, c0, c0i, dlq_fac, sumq& &, rainp - integer :: nrcmax ! Maximum # of random clouds per 1200s +! integer :: nrcmax ! Maximum # of random clouds per 1200s ! - Integer KCR, KFX, NCMX, NC, KTEM, I, L, lm1 & + Integer KCR, KFX, NCMX, NC, KTEM, I, ii, L, lm1 & &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & &, kblmn, ksfc, ncrnd @@ -386,7 +385,8 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & endif trcmin = -99999.0 if (ntk-2 > 0) trcmin(ntk-2) = 1.0d-4 - nrcmax = nrcm +! nrcmax = nrcm +! nrcmax = 32 !> - Initialize CCPP error handling variables @@ -397,9 +397,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! if (me == 0) write(0,*)' in ras tke=',ccin(1,:,ntk),' kdt=',kdt & ! &, ' ntk=',ntk ! if (me == 0) write(0,*)' rann=',rannum(1,:),' kdt=',kdt - if (lprnt) write(0,*)' in RAS fscav=',fscav_, ' mp_phys=',mp_phys & - &, ' fscav=',fscav,' ntr=',ntr & - &, ' rannum=',rannum(1,:) +! if (lprnt) write(0,*)' in RAS fscav=',fscav_, ' mp_phys=',mp_phys & +! &, ' fscav=',fscav,' ntr=',ntr & +! &, ' rannum=',rannum(1,:) ! km1 = k - 1 kp1 = k + 1 @@ -408,6 +408,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & else ksfc = kp1 endif + ia = ipr ! ntrc = ntr IF (CUMFRC) THEN @@ -452,14 +453,16 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! do l=1,k do i=1,im - ud_mf(i,l) = zero - dd_mf(i,l) = zero - dt_mf(i,l) = zero + ud_mf(i,l) = zero + dd_mf(i,l) = zero + dt_mf(i,l) = zero enddo enddo DO IPT=1,IM - tem1 = (log(area(ipt)) - dxmin) * dxinv + lprint = lprnt .and. ipt == ipr + + tem1 = max(zero, min(one, (log(area(ipt)) - dxmin) * dxinv)) tem2 = one - tem1 ccwfac = ccwf(1)*tem1 + ccwf(2)*tem2 dlq_fac = dlqf(1)*tem1 + dlqf(2)*tem2 @@ -502,7 +505,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & krmin = max(krmin,2) ! if (kdt == 1 .and. ipt == 1) write(0,*)' kblmn=',kblmn,kblmx -! if (lprnt .and. ipt == ipr) write(0,*)' krmin=',krmin,' krmax=', +! if (lprint) write(0,*)' krmin=',krmin,' krmax=', & ! &krmax,' kfmax=',kfmax,' tem=',tem ! if (fix_ncld_hr) then @@ -525,8 +528,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & KTEM = MIN(K,KFMAX) KFX = KTEM - KCR -! if(lprnt)write(0,*)' enter RASCNV k=',k,' ktem=',ktem & +! if(lprint)write(0,*)' enter RASCNV k=',k,' ktem=',ktem & ! &, ' krmax=',krmax,' kfmax=',kfmax & +! &, ' krmin=',krmin,' ncrnd=',ncrnd & ! &, ' kcr=',kcr, ' cdrag=',cdrag(ipr) IF (KFX > 0) THEN @@ -544,7 +548,8 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & NCMX = KFX + NCRND IF (NCRND > 0) THEN DO I=1,NCRND - IRND = (RANNUM(ipt,I)-0.0005)*(KCR-KRMIN+1) + II = mod(i-1,nrcm) + 1 + IRND = (RANNUM(ipt,II)-0.0005)*(KCR-KRMIN+1) IC(KFX+I) = IRND + KRMIN ENDDO ENDIF @@ -552,14 +557,17 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ia = ipr ! ! if (me == 0) write(0,*)' in rascnv: k=',k,' lprnt=',lprnt - if (lprnt) then +! if (lprint) then ! if (me == 0) then - write(0,*)' tin',(tin(ia,l),l=k,1,-1) - write(0,*)' qin',(qin(ia,l),l=k,1,-1) - endif +! write(0,*)' ic=',ic(1:kfx+ncrnd) +! write(0,*)' tin',(tin(ia,l),l=k,1,-1),' kdt=',kdt,' me=',me +! write(0,*)' qin',(qin(ia,l),l=k,1,-1),' kdt=',kdt,' me=',me +! write(0,*)' qwin',(ccin(ia,l,2),l=k,1,-1) +! write(0,*)' qiin',(ccin(ia,l,1),l=k,1,-1) +! endif ! ! - lprint = lprnt .and. ipt == ipr +! lprint = lprnt .and. ipt == ipr do l=1,k CLW(l) = zero @@ -588,7 +596,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & toi(l) = tin(ipt,ll) qoi(l) = qin(ipt,ll) - PRSM(L) = prsl(ipt,ll) * Pa2mb + PRSM(L) = prsl(ipt,ll) * facmb PSJM(L) = prslk(ipt,ll) phi_l(L) = phil(ipt,ll) rhc_l(L) = rhc(ipt,ll) @@ -607,7 +615,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & enddo do l=1,kp1 ll = kp1 + 1 - l ! Input variables are bottom to top! - PRS(LL) = prsi(ipt,L) * Pa2mb + PRS(LL) = prsi(ipt,L) * facmb PSJ(LL) = prsik(ipt,L) phi_h(LL) = phii(ipt,L) enddo @@ -637,7 +645,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & toi(l) = tin(ipt,l) qoi(l) = qin(ipt,l) - PRSM(L) = prsl(ipt, L) * Pa2mb + PRSM(L) = prsl(ipt, L) * facmb PSJM(L) = prslk(ipt,L) phi_l(L) = phil(ipt,L) rhc_l(L) = rhc(ipt,L) @@ -655,7 +663,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & endif enddo DO L=1,kp1 - PRS(L) = prsi(ipt,L) * Pa2mb + PRS(L) = prsi(ipt,L) * facmb PSJ(L) = prsik(ipt,L) phi_h(L) = phii(ipt,L) ENDDO @@ -679,9 +687,10 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! endif ! end of if (flipv) then ! - if (lprnt .and. ipt == ipr) write(0,*)' phi_h=',phi_h(:) - if(lprint) write(0,*)' PRS=',PRS - if(lprint) write(0,*)' PRSM=',PRSM +! if (lprint) write(0,*)' phi_h=',phi_h(:) +! lprint = kdt == 1 .and. me == 0 .and. ipt == 1 +! if(lprint) write(0,*)' PRS=',PRS +! if(lprint) write(0,*)' PRSM=',PRSM ! if (lprint) then ! write(0,*)' qns=',qns(ia),' qoi=',qn0(ia,k),'qin=',qin(ia,1) ! if (me == 0) then @@ -822,9 +831,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! lprint = lprnt .and. ipt == ipr .and. ib == 57 ! -! if (lprint) write(0,*)' calling cloud type ib=',ib,' kbl=',kbl -! *, ' kpbl=',kpbl,' alfint=',alfint,' frac=',frac -! *, ' ntrc=',ntrc,' ipt=',ipt +! if (lprint) write(0,*)' calling cloud type ib=',ib,' kbl=',kbl& +! &, ' kpbl=',kpbl,' alfint=',alfint,' frac=',frac & +! &, ' ntrc=',ntrc,' ipt=',ipt ! !**************************************************************************** ! if (advtvd) then ! TVD flux limiter scheme for updraft @@ -925,7 +934,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! qli_l(ib:k) = qli(ib:k) ! qii_l(ib:k) = qii(ib:k) ! endif -! rainp = rain + rainp = rain CALL CLOUD(K, KP1, IB, ntrc, kblmx, kblmn & &, FRAC, MAX_NEG_BOUY, vsmooth, do_aw & @@ -1032,13 +1041,11 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & RAINC(ipt) = rain * 0.001 ! Output rain is in meters ! if (lprint) then -! write(0,*) ' convective precip=',rain*86400/dt,' mm/day' -! 1, ' ipt=',ipt +! write(0,*) ' convective precip=',rain*86400/dt,' mm/day' & +! &, ' ipt=',ipt,' kdt=',kdt ! write(0,*) ' toi',(tn0(imax,l),l=1,k) ! write(0,*) ' qoi',(qn0(imax,l),l=1,k) ! endif -! - ! ktop(ipt) = kp1 kbot(ipt) = 0 @@ -1130,10 +1137,10 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & else do l=1,k - tin(ipt,l) = toi(l) ! Temperature - qin(ipt,l) = qoi(l) ! Specific humidity - uin(ipt,l) = uvi(l,ntr+1) ! U momentum - vin(ipt,l) = uvi(l,ntr+2) ! V momentum + tin(ipt,l) = toi(l) ! Temperature + qin(ipt,l) = qoi(l) ! Specific humidity + uin(ipt,l) = uvi(l,ntr+1) ! U momentum + vin(ipt,l) = uvi(l,ntr+2) ! V momentum !! for 2M microphysics, always output these variables if (mp_phys == 10) then @@ -1175,17 +1182,25 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ccin(ipt,l,2) = ccin(ipt,l,2) + clw(l) enddo endif + endif ! -! if (lprint) then -! write(0,*) ' tin',(tin(ia,l),l=k,1,-1) -! write(0,*) ' qin',(qin(ia,l),l=k,1,-1) -! endif +! if (lprint) then +! write(0,*) ' endtin',(tin(ia,l),l=k,1,-1) +! write(0,*) ' endqin',(qin(ia,l),l=k,1,-1) +! write(0,*) ' endqwin',(ccin(ia,l,2),l=k,1,-1) +! write(0,*) ' endqiin',(ccin(ia,l,1),l=k,1,-1) +! endif ! - endif ! ! Velocity scale from the downdraft! ! +! if (lprint) write(0,*)' ddvelbef=',ddvel(ipt),' ddfac=',ddfac & +! &, 'grav=',grav,' k=',k,'kp1=',kp1,'prs=',prs(k),prs(kp1) + DDVEL(ipt) = DDVEL(ipt) * DDFAC * GRAV / (prs(KP1)-prs(K)) + +! if (lprint) write(0,*)' ddvel=',ddvel(ipt) + ! ENDDO ! End of the IPT Loop! @@ -1369,7 +1384,7 @@ SUBROUTINE CLOUD( & ! &, CLFRAC, DT, clf, clvfr, delzkm, fnoscav, delp ! &, almin1, almin2 - INTEGER I, L, N, KD1, II, idh, lcon & + INTEGER I, L, N, KD1, II, iwk, idh, lcon & &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1, kbls, kmxh & &, kblh, kblm, kblpmn, kmax, kmaxm1, kmaxp1, klcl, kmin, kmxb ! @@ -1386,15 +1401,15 @@ SUBROUTINE CLOUD( & qcd(L) = zero enddo ! - if (lprnt) then - write(0,*) ' IN CLOUD for KD=',kd - write(0,*) ' prs=',prs(Kd:KP1) - write(0,*) ' phil=',phil(KD:K) +! if (lprnt) then +! write(0,*) ' IN CLOUD for KD=',kd +! write(0,*) ' prs=',prs(Kd:KP1) +! write(0,*) ' phil=',phil(KD:K) !! write(0,*) ' phih=',phih(kd:KP1),' kdt=',kdt - write(0,*) ' phih=',phih(KD:KP1) - write(0,*) ' toi=',toi - write(0,*) ' qoi=',qoi - endif +! write(0,*) ' phih=',phih(KD:KP1) +! write(0,*) ' toi=',toi(kd:k) +! write(0,*) ' qoi=',qoi(kd:k) +! endif ! CLDFRD = zero DOF = zero @@ -1505,7 +1520,7 @@ SUBROUTINE CLOUD( & HOL(L) = HOL(L) + ETA(L) HST(L) = HST(L) + ETA(L) ! -! if (kd == 12) then +! if (kd == 37) then ! if (lprnt) then ! write(0,*) ' IN CLOUD for KD=',KD,' K=',K ! write(0,*) ' l=',l,' hol=',hol(l),' hst=',hst(l) @@ -1645,16 +1660,16 @@ SUBROUTINE CLOUD( & KPBL = KBL ! if(lprnt)write(0,*)' 1st kbl=',kbl,' kblmx=',kblmx,' kd=',kd -! if(lprnt)write(0,*)' tx3=',tx3,' tx1=',tx1,' tem=',tem -! 1, ' hcrit=',hcrit +! if(lprnt)write(0,*)' tx3=',tx3,' tx1=',tx1,' tem=',tem & +! &, ' hcrit=',hcrit ELSE KBL = KPBL ! if(lprnt)write(0,*)' 2nd kbl=',kbl ENDIF -! if(lprnt)write(0,*)' after CALKBL l=',l,' hol=',hol(l) -! 1, ' hst=',hst(l) +! if(lprnt)write(0,*)' after CALKBL l=',l,' hol=',hol(l) & +! &, ' hst=',hst(l) ! KBL = min(kmax,MAX(KBL,KD+2)) KB1 = KBL - 1 @@ -1751,11 +1766,11 @@ SUBROUTINE CLOUD( & cnvflg = (TEM > ZERO .OR. (LOWEST .AND. TEM1 >= ZERO)) & & .AND. TX1 < RHRAM -! if(lprnt) write(0,*)' cnvflg=',cnvflg,' tem=',tem,' tem1=',tem1 -! &,' tx1=',tx1,' rhram=',rhram,' kbl=',kbl,' kd=',kd,' lowest=' -! &,lowest,' rhfacs=',rhfacs,' ltl=',ltl(kd1),' qol=',qol(kd1) +! if(lprnt) write(0,*)' cnvflg=',cnvflg,' tem=',tem,' tem1=',tem1 & +! &,' tx1=',tx1,' rhram=',rhram,' kbl=',kbl,' kd=',kd,' lowest=' & +! &,lowest,' rhfacs=',rhfacs,' ltl=',ltl(kd1),' qol=',qol(kd1) & ! &,' qst=',qst(kd1),' hst=',hst(kd1),' nu=',nu -! if(lprnt .and. (.not. cnvflg)) write(0,*)' tx1=',tx1,' rhfacs=' +! if(lprnt .and. (.not. cnvflg)) write(0,*)' tx1=',tx1,' rhfacs=' & ! &,rhfacs, ' tem=',tem,' hst=',hst(kd1) IF (.NOT. cnvflg) RETURN @@ -1781,7 +1796,7 @@ SUBROUTINE CLOUD( & endif endif -! if (lprnt) write(0,*)' wcbase=',wcbase,' rbl=', +! if (lprnt) write(0,*)' wcbase=',wcbase,' rbl=', & ! & rbl(ntk),' ntk=',ntk endif @@ -1793,6 +1808,7 @@ SUBROUTINE CLOUD( & DO L=KBL,K QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) ENDDO +! if (lprnt) write(0,*)' qil=',qil(kbl:k),' gaf=',gaf(kbl) ! DO L=KB1,KD1,-1 lp1 = l + 1 @@ -1802,8 +1818,9 @@ SUBROUTINE CLOUD( & ! FCO(LP1) = TEM1 + ST2 * HBL -! if(lprnt) write(0,*)' fco=',fco(l+1),' tem1=',tem1,' st2=',st2 -! &,' hbl=',hbl,' tx3=',tx3,' tem=',tem,' gaf=',gaf(l),' l=',l +! if(lprnt) write(0,*)' fco=',fco(l+1),' tem1=',tem1,' st2=',st2 & +! &,' hbl=',hbl,' tx3=',tx3,' tem=',tem,' gaf=',gaf(l),' l=',l & +! &,'gaflp1=',gaf(lp1),' half=',half,' qst=',qst(l),' hst=',hst(l) RNN(LP1) = ZET(LP1) * TEM1 + ST2 * TX4 GMH(LP1) = XI(LP1) * TEM1 + ST2 * TX5 @@ -1814,6 +1831,8 @@ SUBROUTINE CLOUD( & ! QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) QLL(LP1) = (half*ALHF) * ST2 * (QIL(L)+QIL(LP1)) + ONE +! if (lprnt) write(0,*)' qil=',qil(l),' qll=',qll(lp1), & +! & ' rcr=',tcr,' tcl=',tcl,' tcrf=',tcrf ENDDO ! ! FOR THE CLOUD TOP -- L=KD @@ -1867,7 +1886,7 @@ SUBROUTINE CLOUD( & ! tem1 = (one-akt(l)) * eta(l) -! if(lprnt) write(0,*)' qll=',qll(l),' st2=',st2,' tem=',tem +! if(lprnt) write(0,*)' qll=',qll(l),' st2=',st2,' tem=',tem & ! &,' tx2=',tx2,' akt=',akt(l),' eta=',eta(l) AKT(L) = QLL(L) + (st2 + tem) * tx2 @@ -1907,7 +1926,7 @@ SUBROUTINE CLOUD( & TX5 = zero DO L=KB1,KD1,-1 TEM = BKC(L-1) * AKC(L) -! if (lprnt) write(0,*)' tx3=',tx3,' fco=',fco(l),' akc=',akc(l) +! if (lprnt) write(0,*)' tx3=',tx3,' fco=',fco(l),' akc=',akc(l) & ! &,' bkc=',bkc(l-1), ' l=',l TX3 = (TX3 + FCO(L)) * TEM TX4 = (TX4 + RNN(L)) * TEM @@ -1928,7 +1947,7 @@ SUBROUTINE CLOUD( & ! HSU = HST(KD) + LTL(KD) * NU * (QOL(KD)-QST(KD)) -! if (lprnt) write(0,*)' hsu=',hsu,' hst=',hst(kd), +! if (lprnt) write(0,*)' hsu=',hsu,' hst=',hst(kd), & ! &' ltl=',ltl(kd),' qol=',qol(kd),' qst=',qst(kd) ! !===> VERTICAL INTEGRALS NEEDED TO COMPUTE THE ENTRAINMENT PARAMETER @@ -1957,7 +1976,7 @@ SUBROUTINE CLOUD( & cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4 -! if (lprnt) write(0,*)' ii=',ii,' cnvflg=',cnvflg,' hsu=',hsu & +! if (lprnt) write(0,*)' ii=',ii,' cnvflg=',cnvflg,' hsu=',hsu & ! &,' hbl=',hbl,' tx1=',tx1,' hsd=',hsd !*********************************************************************** @@ -1990,13 +2009,13 @@ SUBROUTINE CLOUD( & if (tem2 > almax) tem2 = -100.0 alm = max(tem1,tem2) -! if (lprnt) write(0,*) ' tem1=',tem1,' tem2=',tem2,' alm=',alm & +! if (lprnt) write(0,*) ' tem1=',tem1,' tem2=',tem2,' alm=',alm & ! &,' tx1=',tx1,' tem=',tem,' epp=',epp,' x00=',x00,' st2=',st2 endif endif -! if (lprnt) write(0,*)' almF=',alm,' ii=',ii,' qw00=',qw00 +! if (lprnt) write(0,*)' almF=',alm,' ii=',ii,' qw00=',qw00 & ! &,' qi00=',qi00 ! ! CLIP CASE: @@ -2026,7 +2045,7 @@ SUBROUTINE CLOUD( & GO TO 888 ENDIF ! -! if (lprnt) write(0,*)' hstkd=',hst(kd),' qstkd=',qst(kd) +! if (lprnt) write(0,*)' hstkd=',hst(kd),' qstkd=',qst(kd) & ! &,' ii=',ii,' clp=',clp st1s = ONE @@ -2080,9 +2099,9 @@ SUBROUTINE CLOUD( & rel_fac = max(zero, min(half,rel_fac)) IF (CRTFUN) THEN - II = tem*0.02-0.999999999 - II = MAX(1, MIN(II, 16)) - ACR = tx1 * (AC(II) + tem * AD(II)) * CCWF + iwk = tem*0.02-0.999999999 + iwk = MAX(1, MIN(iwk, 16)) + ACR = tx1 * (AC(iwk) + tem * AD(iwk)) * CCWF ENDIF ! !===> NORMALIZED MASSFLUX @@ -2129,10 +2148,10 @@ SUBROUTINE CLOUD( & DETP = (BKC(L)*DET - (QTVP-QTV) & & + DEL_ETA*(QOL(L)+CLL(L)+CIL(L)) + ST1) * AKC(L) -! if(lprnt) write(0,*)' detp=',detp,' bkc=',bkc(l),' det=',det +! if(lprnt) write(0,*)' detp=',detp,' bkc=',bkc(l),' det=',det & ! if (lprnt .and. kd == 15) -! & write(0,*)' detp=',detp,' bkc=',bkc(l),' det=',det -! &,' qtvp=',qtvp,' qtv=',qtv,' del_eta=',del_eta,' qol=' +! & write(0,*)' detp=',detp,' bkc=',bkc(l),' det=',det & +! &,' qtvp=',qtvp,' qtv=',qtv,' del_eta=',del_eta,' qol=' & ! &,qol(l),' st1=',st1,' akc=',akc(l) ! TEM1 = AKT(L) - QLL(L) @@ -2153,11 +2172,11 @@ SUBROUTINE CLOUD( & TEM2 = HCCP + DETP * QTP * ALHF ! -! if(lprnt) write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu +! if(lprnt) write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu & ! if (lprnt .and. kd == 15) -! & write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu & -! &,' qst=',qst(l),' qol=',qol(l),' hccp=',hccp,' detp=',detp & -! *,' qtp=',qtp,' alhf=',alhf,' vtf=',vtf(l) +! & write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu & +! &,' qst=',qst(l),' qol=',qol(l),' hccp=',hccp,' detp=',detp & +! &,' qtp=',qtp,' alhf=',alhf,' vtf=',vtf(l) ST2 = LTL(L) * VTF(L) TEM5 = CLL(L) + CIL(L) @@ -2170,13 +2189,13 @@ SUBROUTINE CLOUD( & ! &, ' st2=',st2,' det=',det,' tem5=',tem5,' dlb=',dlb(l) & ! write(0,*)' tem4=',tem4,' tem2=',tem2,' detp=',detp & ! &, ' eta=',eta(l),' dlt=',dlt(l),' rns=',rns(l),' l=',l & -! write(0,*)' bt1=',tem3/(eta(l+1)*qrb(l)) +! write(0,*)' bt1=',tem3/(eta(l+1)*qrb(l)) & ! &, ' bt2=',tem4/(eta(l)*qrt(l)) ! endif ST1 = TEM3 + TEM4 -! if (lprnt) write(0,*)' wfn=',wfn,' st1=',st1,' l=',l,' ep_wfn=', & +! if (lprnt) write(0,*)' wfn=',wfn,' st1=',st1,' l=',l,' ep_wfn=', & ! &ep_wfn,' akm=',akm WFN = WFN + ST1 @@ -2216,7 +2235,7 @@ SUBROUTINE CLOUD( & ! 888 continue -! if (lprnt) write(0,*)' ep_wfn=',ep_wfn,' ii=',ii,' rns=',rns(kd) +! if (lprnt) write(0,*)' ep_wfn=',ep_wfn,' ii=',ii,' rns=',rns(kd) & ! &,' clp=',clp,' hst(kd)=',hst(kd) if (ep_wfn) then @@ -2245,8 +2264,8 @@ SUBROUTINE CLOUD( & qw00 = zero qi00 = zero -! if (lprnt) write(0,*)' returning to 777 : ii=',ii,' qw00=',qw00,qi00 -! &,' clp=',clp,' hst(kd)=',hst(kd) +! if (lprnt) write(0,*)' returning to 777 : ii=',ii,' qw00=',qw00, & +! & qi00,' clp=',clp,' hst(kd)=',hst(kd) go to 777 else @@ -2264,7 +2283,7 @@ SUBROUTINE CLOUD( & ST1 = HALF * (TX1-ETA(KD1)*ST1-ST2*(DET-TEM5))*DLB(KD) ! ! if (lprnt) write(0,*)' st1=',st1,' st2=',st2,' ltl=',ltl(kd) & -! *,ltl(kd1),' qos=',qos,qol(kd1) +! &,ltl(kd1),' qos=',qos,qol(kd1) WFN = WFN + ST1 AKM = AKM - min(ST1,ZERO) ! Commented on 08/26/02 - does not include top @@ -2297,8 +2316,8 @@ SUBROUTINE CLOUD( & IF (.not. cnvflg .and. WFN > ACR .and. & & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. -! if (lprnt) write(0,*)' calcup=',calcup,' akm=',akm,' tem=',tem -! *,' cnvflg=',cnvflg,' clp=',clp,' rhc=',rhc,' cd=',cd,' acr=',acr +! if (lprnt) write(0,*)' calcup=',calcup,' akm=',akm,' tem=',tem & +! &,' cnvflg=',cnvflg,' clp=',clp,' rhc=',rhc,' cd=',cd,' acr=',acr ! !===> IF NO SOUNDING MEETS THIRD CONDITION, RETURN ! @@ -2697,9 +2716,11 @@ SUBROUTINE CLOUD( & if (do_aw) then tx1 = (0.2 / max(alm, 1.0e-5)) tx2 = one - min(one, pi * tx1 * tx1 / area) -! if(lprnt) write(0,*)' kd=',kd,' alm=',alm,' tx1=',tx1 +! if(lprnt) write(0,*)' kd=',kd,' alm=',alm,' tx1=',tx1 & ! &,' area=',area,' pi=',pi,' tx2=',tx2 + tx2 = tx2 * tx2 + ! if(lprnt) write(0,*)' kd=',kd,' wvl=',wvl(kd:k+1) ! if(lprnt) write(0,*)' kd=',kd,' eta=',eta(kd:k+1) ! if(lprnt) write(0,*)' kd=',kd,' rho=',rho(kd:k) @@ -2823,7 +2844,7 @@ SUBROUTINE CLOUD( & ! avr = avr * 86400.0 / DT ! write(0,*) ' avt=',avt,' avq=',avq,' avr=',avr,' avh=' & ! * ,avh,' alm=',alm,' DDFT=',DDFT,' KD=',KD & -! &,' TOIK-',toi(k),' TOIK-1=',toi(k-1),' TOIK-2=',toi(k-2) & +! &,' TOIK-',toi(k),' TOIK-1=',toi(k-1),' TOIK-2=',toi(k-2) ! if (kd == 12 .and. .not. ddft) stop ! if (avh > 0.1 .or. abs(avt+avq) > 1.0e-5 .or. & ! & abs(avt-avr) > 1.0e-5 .or. abs(avr+avq) > 1.0e-5) stop @@ -3320,8 +3341,8 @@ SUBROUTINE DDRFT( & STLA = SIN(TLA*deg2rad) ! sine of tilting angle CTL2 = one - STLA * STLA ! cosine square of tilting angle ! -! if (lprnt) write(0,*)' tla=',tla,' al2=',al2,' ptop=' & -! &,0.5*(prl(kd)+prl(kd1)),' ntla=',ntla,' f2=',f2,' stla=',stla +! if (lprnt) write(0,*)' tla=',tla,' al2=',al2,' ptop=' & +! &,0.5*(prl(kd)+prl(kd1)),' ntla=',ntla,' f2=',f2,' stla=',stla & ! if (lprnt) write(0,*)' buy=',(buy(l),l=kd,kbl) ! STLA = F2 * STLA * AL2 @@ -3697,7 +3718,7 @@ SUBROUTINE DDRFT( & ELSE ERRQ = TX2 ! Further iteration ! ! if (lprnt) write(0,*)' itr=',itr,' errq=',errq -! if (itr == itrmu .and. ERRQ > ERRMIN*10 & +! if (itr == itrmu .and. ERRQ > ERRMIN*10 & ! & .and. ntla == 1) ERRQ = 10.0 ENDIF ENDIF @@ -3710,7 +3731,7 @@ SUBROUTINE DDRFT( & ! ! if(lprnt) then ! write(0,*)' QRP=',(QRP(L),L=KD,KBL) -! write(0,*)'RNF=',(RNF(L),L=KD,KBL),' RNT=',RNT,' RNB=',RNB +! write(0,*)'RNF=',(RNF(L),L=KD,KBL),' RNT=',RNT,' RNB=',RNB & ! &,' errq=',errq ! endif ! @@ -3816,9 +3837,9 @@ SUBROUTINE DDRFT( & RNTP = zero TX5 = TX1 QA(1) = zero -! if(lprnt) write(0,*)' stlt=',stlt(kd),' qrb=',qrb(kd) -! *,' tx1=',tx1,' ror=',ror(kd),' gms=',gms(kd),' rpart=',rpart -! *,' rnt=',rnt +! if(lprnt) write(0,*)' stlt=',stlt(kd),' qrb=',qrb(kd) & +! &,' tx1=',tx1,' ror=',ror(kd),' gms=',gms(kd),' rpart=',rpart & +! &,' rnt=',rnt ! ! Here we assume RPART of detrained rain RNT goes to Pd ! @@ -3877,8 +3898,8 @@ SUBROUTINE DDRFT( & VT(1) = GMS(L-1) * QRPF(QRP(L-1)) RNT = ROR(L-1) * (WVL(L-1)+VT(1))*QRP(L-1) ! if(lprnt) write(0,*)' l=',l,' qa=',qa(1), ' tx1RNT=',RNT*tx1,& -! *' wvl=',wvl(l-1) & -! *,' qrp=',qrp(l-1),' tx5=',tx5,' tx1=',tx1,' rnt=',rnt +! &' wvl=',wvl(l-1) & +! &,' qrp=',qrp(l-1),' tx5=',tx5,' tx1=',tx1,' rnt=',rnt ! @@ -3956,7 +3977,7 @@ SUBROUTINE DDRFT( & ! ! Iteration loop for a given level L begins ! -! if (lprnt) write(0,*)' tx8=',tx8,' tx9=',tx9,' tx5=',tx5 +! if (lprnt) write(0,*)' tx8=',tx8,' tx9=',tx9,' tx5=',tx5 & ! &, ' tx1=',tx1 else DO ITR=1,ITRMD @@ -3979,8 +4000,8 @@ SUBROUTINE DDRFT( & TEM2 = TX8 ST1 = zero ENDIF -! if (lprnt) write(0,*)' st1=',st1,' tem=',tem,' ror=',ror(l) & -! &,' qrp=',qrp(l),' rnt=',rnt,' ror1=',ror(l-1),' wvl=',wvl(l) & +! if (lprnt) write(0,*)' st1=',st1,' tem=',tem,' ror=',ror(l) & +! &,' qrp=',qrp(l),' rnt=',rnt,' ror1=',ror(l-1),' wvl=',wvl(l) & ! &,' wvl1=',wvl(l-1),' tem2=',tem2,' vt=',vt(1),' tx3=',tx3 ! st2 = tx5 @@ -4001,13 +4022,13 @@ SUBROUTINE DDRFT( & ! TX5 = (TX1 - tem*tx6 - ST1 + TEM2 + TX3) ! endif ! -! if(lprnt) write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' -! if(tx5 <= 0.0 .and. l > kd+2) & -! & write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' i & -! *,tem2,' tx3=',tx3,' tem=',tem,' tem1=',tem1,' wvl=',wvl(l-1), & -! &wvl(l),' l=',l,' itr=',itr,' evp=',evp(l-1),' vt=',vt(1) & -! *,' qrp=',qrp(l),' rnt=',rnt,' kd=',kd -! if (lprnt) write(0,*)' etd=',etd(l),' wvl=',wvl(l) & +! if(lprnt) write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' & +! if(tx5 <= 0.0 .and. l > kd+2) & +! & write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' & +! &,tem2,' tx3=',tx3,' tem=',tem,' tem1=',tem1,' wvl=',wvl(l-1), & +! &wvl(l),' l=',l,' itr=',itr,' evp=',evp(l-1),' vt=',vt(1) & +! &,' qrp=',qrp(l),' rnt=',rnt,' kd=',kd +! if (lprnt) write(0,*)' etd=',etd(l),' wvl=',wvl(l) & ! &,' trw=',trw(1),trw(2),' ror=',ror(l),' wa=',wa @@ -4099,7 +4120,7 @@ SUBROUTINE DDRFT( & QA(1) = TX1*RNT + RNF(L-1) - EVP(L-1) ! ! if(lprnt) write(0,*)' etd=',etd(l),' tx5=',tx5,' rnt=',rnt & -! *,' rnf=',rnf(l-1),' evp=',evp(l-1),' itr=',itr,' L=',L +! &,' rnf=',rnf(l-1),' evp=',evp(l-1),' itr=',itr,' L=',L ! if (qa(1) > zero) then IF (ETD(L) > zero) THEN @@ -4158,8 +4179,8 @@ SUBROUTINE DDRFT( & ! if (lprnt) write(0,*)' errw=',errw,' wvl=',wvl(l) ! if(lprnt .or. tx5 == 0.0) then ! if(tx5 == 0.0 .and. l > kbl) then -! write(0,*)' errq=',errq,' itr=',itr,' l=',l,' wvl=',wvl(l) -! &,' tx5=',tx5,' idnm=',idnm,' etd1=',etd(l-1),' etd=',etd(l) +! write(0,*)' errq=',errq,' itr=',itr,' l=',l,' wvl=',wvl(l) & +! &,' tx5=',tx5,' idnm=',idnm,' etd1=',etd(l-1),' etd=',etd(l) & ! &,' kbl=',kbl ! endif ! @@ -4183,8 +4204,8 @@ SUBROUTINE DDRFT( & & + STLT(KBL) * QRB(KB1)) * (0.5*FAC) endif -! if(lprnt) write(0,*)' tx1=',tx1,' rnt=',rnt,' rnf=',rnf(l-1) -! *,' evp=',evp(l-1),' l=',l +! if(lprnt) write(0,*)' tx1=',tx1,' rnt=',rnt,' rnf=',rnf(l-1) & +! &,' evp=',evp(l-1),' l=',l EVP(L-1) = zero TEM = MAX(TX1*RNT+RNF(L-1),ZERO) @@ -4192,14 +4213,14 @@ SUBROUTINE DDRFT( & ! IF (QA(1) > 0.0) THEN ! if(lprnt) write(0,*)' ror=',ror(l),' tx5=',tx5,' tx1=',tx1 & -! *,' tx9=',tx9,' gms=',gms(l),' qa=',qa(1 +! &,' tx9=',tx9,' gms=',gms(l),' qa=',qa(1) ! if(lprnt) call mpi_quit(13) ! if (tx5 == 0.0 .or. gms(l) == 0.0) ! if (lprnt) & -! * write(0,*)' Atx5=',tx5,' gms=',gms(l),' ror=',ror(l) & -! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & -! *,' kbl=',kbl,' etd1=',etd(l-1),' idnm=',idnm,' idn=',idn(idnm) -! *,' errq=',errq +! & write(0,*)' Atx5=',tx5,' gms=',gms(l),' ror=',ror(l) & +! &,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & +! &,' kbl=',kbl,' etd1=',etd(l-1),' idnm=',idnm,' idn=',idn(idnm) & +! &,' errq=',errq QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & & ** (one/1.1364) @@ -4273,10 +4294,10 @@ SUBROUTINE DDRFT( & ! ! if (tx5 == 0.0 .or. gms(l) == 0.0) -! if (lprnt) -! * write(0,*)' Btx5=',tx5,' gms=',gms(l),' ror=',ror(l) & -! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & -! *,' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA & +! if (lprnt) & +! & write(0,*)' Btx5=',tx5,' gms=',gms(l),' ror=',ror(l) & +! &,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & +! &,' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA & ! &,' evp=',evp(l-1) ! ! IF (QA(1) > 0.0) THEN @@ -4360,8 +4381,8 @@ SUBROUTINE DDRFT( & ! if (lprnt) then ! write(0,*)' ERRQ=',ERRQ,' IDN=',IDN(idnm),' idnm=',idnm -! write(0,*)' L=',L,' QRP=',QRP(L),' ETD=',ETD(L),' QA=',QA(1) -! *,' evp=',evp(l-1),' rnf=',rnf(l-1) +! write(0,*)' L=',L,' QRP=',QRP(L),' ETD=',ETD(L),' QA=',QA(1) & +! &, ' evp=',evp(l-1),' rnf=',rnf(l-1) ! endif ! @@ -4463,13 +4484,14 @@ end subroutine ddrft SUBROUTINE QSATCN(TT,P,Q,DQDT) ! SUBROUTINE QSATCN(TT,P,Q,DQDT,lprnt) +! + USE FUNCPHYS , ONLY : fpvs implicit none ! real(kind=kind_phys) TT, P, Q, DQDT ! real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & - &, ONE_M10=1.E-10 & &, rvi=one/rv, facw=CVAP-CLIQ & &, faci=CVAP-CSOL, hsub=alhl+alhf & &, tmix=TTP-20.0 & @@ -4478,15 +4500,19 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) ! real(kind=kind_phys) es, d, hlorv, W ! -! es = 10.0 * fpvs(tt) ! fpvs is in centibars! - es = 0.01 * fpvs(tt) ! fpvs is in Pascals! - D = one / max(p+epsm1*es,ONE_M10) +! es = 10.0 * fpvs(tt) ! fpvs is in centibars! + es = min(p, 0.01 * fpvs(tt)) ! fpvs is in Pascals! +! D = one / max(p+epsm1*es,ONE_M10) + D = one / (p+epsm1*es) ! - q = MIN(eps*es*D, ONE) + q = MIN(eps*es*D, ONE) + +! if (lprnt) write(0,*)' q=',q,' eps=',eps,' es=',es,' d=',d, & +! &' one=',one,' tt=',tt,' p=',p,' epsm1=',epsm1,' fpvs=',fpvs(tt) ! W = max(ZERO, min(ONE, (TT - TMIX)*DEN)) hlorv = ( W * (alhl + FACW * (tt-ttp)) & - & + (one-W) * (alhf + FACI * (tt-ttp)) ) * RVI + & + (one-W) * (hsub + FACI * (tt-ttp)) ) * RVI dqdt = p * q * hlorv * D / (tt*tt) ! return diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f index 0a1a49c77..d0aaee476 100644 --- a/physics/sfc_cice.f +++ b/physics/sfc_cice.f @@ -41,7 +41,7 @@ end subroutine sfc_cice_finalize !----------------------------------- subroutine sfc_cice_run & ! --- inputs: - & ( im, cplflx, cplchm, hvap, cp, rvrdm1, rd, & + & ( im, cplflx, hvap, cp, rvrdm1, rd, & & t1, q1, cm, ch, prsl1, & & wind, flag_cice, flag_iter, dqsfc, dtsfc, & & dusfc, dvsfc, & @@ -58,7 +58,7 @@ subroutine sfc_cice_run & ! ! ! call sfc_cice ! ! inputs: ! -! ( im, cplflx, cplchm, hvap, cp, rvrdm1, rd, ! +! ( im, cplflx, hvap, cp, rvrdm1, rd, ! ! t1, q1, cm, ch, prsl1, ! ! wind, flag_cice, flag_iter, dqsfc, dtsfc, ! ! dusfc, dvsfc, ! @@ -99,7 +99,6 @@ subroutine sfc_cice_run & ! --- inputs: integer, intent(in) :: im logical, intent(in) :: cplflx - logical, intent(in) :: cplchm ! real (kind=kind_phys), dimension(im), intent(in) :: u1, v1, & real (kind=kind_phys), dimension(im), intent(in) :: & @@ -126,9 +125,7 @@ subroutine sfc_cice_run & errmsg = '' errflg = 0 ! - if ((.not. cplflx) .and. (.not.cplchm)) then - return - endif + if (.not. cplflx) return ! cpinv = 1.0/cp hvapi = 1.0/hvap diff --git a/physics/sfc_cice.meta b/physics/sfc_cice.meta index 48aa1f4c8..543e4d78b 100644 --- a/physics/sfc_cice.meta +++ b/physics/sfc_cice.meta @@ -17,14 +17,6 @@ type = logical intent = in optional = F -[cplchm] - standard_name = flag_for_chemistry_coupling - long_name = flag controlling cplchm collection (default off) - units = flag - dimensions = () - type = logical - intent = in - optional = F [hvap] standard_name = latent_heat_of_vaporization_of_water_at_0C long_name = latent heat of evaporation/sublimation diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 4cbf94245..60d5ceeea 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -175,9 +175,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) #endif z0max = max(1.0e-6, min(0.01 * z0rl_lnd(i), z1(i))) !** xubin's new z0 over land - tem1 = 1.0 - shdmax(i) - tem2 = tem1 * tem1 - tem1 = 1.0 - tem2 + tem1 = 1.0 - shdmax(i) + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 if( ivegsrc == 1 ) then @@ -246,9 +246,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) tvs = 0.5 * (tsurf_ice(i)+tskin_ice(i)) * virtfac z0max = max(1.0e-6, min(0.01 * z0rl_ice(i), z1(i))) !** xubin's new z0 over land and sea ice - tem1 = 1.0 - shdmax(i) - tem2 = tem1 * tem1 - tem1 = 1.0 - tem2 + tem1 = 1.0 - shdmax(i) + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 if( ivegsrc == 1 ) then @@ -263,7 +263,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! dependance of czil czilc = 0.8 - tem1 = 1.0 - sigmaf(i) + tem1 = 1.0 - sigmaf(i) ztmax = z0max*exp( - tem1*tem1 & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) ztmax = max(ztmax, 1.0e-6) @@ -281,11 +281,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! the stuff now put into "stability" if (wet(i)) then ! Some open ocean - tvs = 0.5 * (tsurf_ocn(i)+tskin_ocn(i)) * virtfac - z0 = 0.01 * z0rl_ocn(i) - z0max = max(1.0e-6, min(z0,z1(i))) + tvs = 0.5 * (tsurf_ocn(i)+tskin_ocn(i)) * virtfac + z0 = 0.01 * z0rl_ocn(i) + z0max = max(1.0e-6, min(z0,z1(i))) ustar_ocn(i) = sqrt(grav * z0 / charnock) - wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) + wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) !** test xubin's new z0 @@ -307,7 +307,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) call znot_t_v6(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type == 7) then call znot_t_v7(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) - else if (sfc_z0_type /= 0) then + else if (sfc_z0_type > 0) then write(0,*)'no option for sfc_z0_type=',sfc_z0_type stop endif @@ -322,33 +322,35 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ! update z0 over ocean ! - if (sfc_z0_type == 0) then - z0 = (charnock / grav) * ustar_ocn(i) * ustar_ocn(i) + if (sfc_z0_type >= 0) then + if (sfc_z0_type == 0) then + z0 = (charnock / grav) * ustar_ocn(i) * ustar_ocn(i) ! mbek -- toga-coare flux algorithm -! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) +! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) ! new implementation of z0 -! cc = ustar(i) * z0 / rnu -! pp = cc / (1. + cc) -! ff = grav * arnu / (charnock * ustar(i) ** 3) -! z0 = arnu / (ustar(i) * ff ** pp) - - if (redrag) then - z0rl_ocn(i) = 100.0 * max(min(z0, z0s_max), 1.e-7) +! cc = ustar(i) * z0 / rnu +! pp = cc / (1. + cc) +! ff = grav * arnu / (charnock * ustar(i) ** 3) +! z0 = arnu / (ustar(i) * ff ** pp) + + if (redrag) then + z0rl_ocn(i) = 100.0 * max(min(z0, z0s_max), 1.e-7) + else + z0rl_ocn(i) = 100.0 * max(min(z0,.1), 1.e-7) + endif + + elseif (sfc_z0_type == 6) then ! wang + call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m + z0rl_ocn(i) = 100.0 * z0 ! cm + elseif (sfc_z0_type == 7) then ! wang + call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m + z0rl_ocn(i) = 100.0 * z0 ! cm else - z0rl_ocn(i) = 100.0 * max(min(z0,.1), 1.e-7) + z0rl_ocn(i) = 1.0e-4 endif - elseif (sfc_z0_type == 6) then ! wang - call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m - z0rl_ocn(i) = 100.0 * z0 ! cm - elseif (sfc_z0_type == 7) then ! wang - call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m - z0rl_ocn(i) = 100.0 * z0 ! cm - else - z0rl_ocn(i) = 1.0e-4 endif - endif ! end of if(open ocean) ! endif ! end of if(flagiter) loop diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index dac459405..c10ff5b7b 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -423,7 +423,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio_at_lowest_model_layer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water at lowest model layer + long_name = mixing ratio of cloud water at lowest model layer units = kg kg-1 dimensions = (horizontal_dimension) type = real diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index ed43a719d..ed6387afb 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -252,9 +252,9 @@ subroutine sfc_nst_run & errmsg = '' errflg = 0 - cpinv=1.0/cp - hvapi=1.0/hvap - elocp=hvap/cp + cpinv = 1.0/cp + hvapi = 1.0/hvap + elocp = hvap/cp sss = 34.0 ! temporarily, when sea surface salinity data is not ready ! diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 52375dd18..4004e586f 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -48,7 +48,9 @@ subroutine cires_ugwp_driver_v0(me, master, &, rain real(kind=kind_phys), intent(in), dimension(im,levs) :: ugrs - &, vgrs, tgrs, qgrs, prsi, prsl, prslk, phii, phil, del + &, vgrs, tgrs, qgrs, prsl, prslk, phil, del + real(kind=kind_phys), intent(in), dimension(im,levs+1) :: prsi + &, phii ! real(kind=kind_phys), intent(in) :: oro_stat(im,nmtvr) real(kind=kind_phys), intent(in), dimension(im) :: hprime, oc From 62fb748a3cacaa78e34dea5f1791eaed91af9094 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 28 Dec 2019 01:25:54 +0000 Subject: [PATCH 12/24] after updates to make ras+mg3+shoc reproduce between ipd and ccpp --- physics/GFS_DCNV_generic.F90 | 12 +- physics/GFS_DCNV_generic.meta | 32 ++ physics/GFS_MP_generic.F90 | 16 +- physics/GFS_MP_generic.meta | 32 ++ physics/GFS_PBL_generic.F90 | 28 +- physics/GFS_SCNV_generic.F90 | 7 +- physics/GFS_SCNV_generic.meta | 16 + physics/GFS_suite_interstitial.F90 | 39 +- physics/GFS_suite_interstitial.meta | 41 ++ physics/gcm_shoc.F90 | 100 ++++- physics/m_micro.F90 | 10 +- physics/micro_mg2_0.F90 | 2 +- physics/micro_mg3_0.F90 | 634 ++++++++++++++-------------- physics/micro_mg_utils.F90 | 2 +- physics/moninshoc.f | 21 +- physics/rascnv.F90 | 30 +- 16 files changed, 619 insertions(+), 403 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 1ac2a7619..96c1180ed 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -20,14 +20,14 @@ end subroutine GFS_DCNV_generic_pre_finalize subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, & isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & save_u, save_v, save_t, save_qv, ca_deep, & - errmsg, errflg) + lprnt, ipr, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, isppt_deep + integer, intent(in) :: im, levs, ipr + logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, isppt_deep, lprnt real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0 @@ -100,14 +100,14 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, & rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, & - cape, tconvtend, qconvtend, uconvtend, vconvtend, errmsg, errflg) + cape, tconvtend, qconvtend, uconvtend, vconvtend, lprnt, ipr, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs - logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep + integer, intent(in) :: im, levs, ipr + logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep, lprnt real(kind=kind_phys), intent(in) :: frain, dtf real(kind=kind_phys), dimension(im), intent(in) :: rain1, cld1d diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index fb02f2ae5..2028a09ab 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -130,6 +130,22 @@ kind = kind_phys intent = in optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = inout + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -546,6 +562,22 @@ kind = kind_phys intent = inout optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = inout + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index f8f97bfcb..305d483ac 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -16,13 +16,13 @@ end subroutine GFS_MP_generic_pre_init !> \section arg_table_GFS_MP_generic_pre_run Argument Table !! \htmlinclude GFS_MP_generic_pre_run.html !! - subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_q, errmsg, errflg) + subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_q, lprnt, ipr, errmsg, errflg) ! use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, ntcw, nncl, ntrac - logical, intent(in) :: ldiag3d, do_aw + integer, intent(in) :: im, levs, ntcw, nncl, ntrac, ipr + logical, intent(in) :: ldiag3d, do_aw, lprnt real(kind=kind_phys), dimension(im, levs), intent(in) :: gt0 real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 @@ -86,15 +86,15 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp, totprcp, totice, & totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, dt3dt, dq3dt, rain_cpl, rainc_cpl, snow_cpl, pwat, & do_sppt, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, raincprv, rainncprv, iceprv, snowprv, graupelprv, & - dtp, errmsg, errflg) + dtp, lprnt, ipr, errmsg, errflg) ! use machine, only: kind_phys implicit none - integer, intent(in) :: im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac + integer, intent(in) :: im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, ipr integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_mg - logical, intent(in) :: cal_pre, lssav, ldiag3d, cplflx, cplchm + logical, intent(in) :: cal_pre, lssav, ldiag3d, cplflx, cplchm, lprnt real(kind=kind_phys), intent(in) :: dtf, frain, con_g real(kind=kind_phys), dimension(im), intent(in) :: rainc, rain1, xlat, xlon, tsfc @@ -263,7 +263,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt do k = 1, levs-1 do i = 1, im if (prsl(i,k) > p850 .and. prsl(i,k+1) <= p850) then - t850(i) = gt0(i,k) - (prsl(i,k)-p850) / & + t850(i) = gt0(i,k) - (prsl(i,k)-p850) / & (prsl(i,k)-prsl(i,k+1)) * & (gt0(i,k)-gt0(i,k+1)) endif @@ -358,8 +358,6 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt do i=1,im pwat(i) = pwat(i) + del(i,k)*(gq0(i,k,1)+work1(i)) enddo -! if (lprnt .and. i == ipr) write(0,*)' gq0=', -! &gq0(i,k,1),' qgrs=',qgrs(i,k,1),' work2=',work2(i),' k=',k enddo do i=1,im pwat(i) = pwat(i) * onebg diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 2e55b6ad5..37a6d0fa4 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -98,6 +98,22 @@ kind = kind_phys intent = inout optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = inout + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -820,6 +836,22 @@ kind = kind_phys intent = in optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = inout + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 16d7df01c..99f4d5cc0 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -122,18 +122,10 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, lprnt = .false. ipt = 1 ! do i=1,im -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-294.37) < 0.101 & -! .and. abs(xlat(i)*rad2dg-4.1) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-308.88) < 0.101 & -! .and. abs(xlat(i)*rad2dg+29.16) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-311.08) < 0.101 & -! .and. abs(xlat(i)*rad2dg+28.27) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-113.48) < 0.101 & -! .and. abs(xlat(i)*rad2dg-21.07) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.29) < 0.201 & -! .and. abs(xlat(i)*rad2dg-17.45) < 0.201 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-169.453) < 0.501 & -! .and. abs(xlat(i)*rad2dg-72.96) < 0.501 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-97.50) < 0.101 & +! .and. abs(xlat(i)*rad2dg-24.48) < 0.101 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-293.91) < 0.101 & +! .and. abs(xlat(i)*rad2dg+72.02) < 0.101 ! if (kdt == 1) & ! write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & ! ' xlat=',xlat(i)*rad2dg,' me=',me @@ -145,8 +137,8 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ! enddo ! if (lprnt) then ! write(0,*)' qgrsv=',qgrs(ipt,:,1) -! write(0,*)' qgrsw=',qgrs(ipt,:,2) -! write(0,*)' qgrsi=',qgrs(ipt,:,3) +! write(0,*)' qgrsi=',qgrs(ipt,:,ntiw) +! write(0,*)' qgrsw=',qgrs(ipt,:,ntcw) ! endif !DH: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. ) @@ -565,14 +557,6 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dtsfci_diag(i) = dtsfc1(i) dqsfci_diag(i) = dqsfc1(i) enddo -! if (lprnt) then -! write(0,*)' dusfc=',dusfc_diag(ipt),' dusfc1=',dusfc1(ipt), & -! & ' dvsfc=',dvsfc_diag(ipt),' dvsfc1=',dvsfc1(ipt), & -! & ' dtsfc=',dtsfc_diag(ipt),' dtsfc1=',dvsfc1(ipt), & -! & ' dtf=',dtf,' kdt=',kdt -! write(0,*)' dtdt=',dtdt(ipt,1:10)*86400 -! write(0,*)' dqidt=',dqdt(ipt,1:10,ntiw)*86400 -! endif if (ldiag3d) then if (lsidea) then diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 9e70fda76..ec8adc35c 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -15,14 +15,14 @@ end subroutine GFS_SCNV_generic_pre_finalize !! \htmlinclude GFS_SCNV_generic_pre_run.html !! subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, gt0, gq0_water_vapor, & - save_t, save_qv, errmsg, errflg) + save_t, save_qv, lprnt, ipr, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d + integer, intent(in) :: im, levs, ipr + logical, intent(in) :: ldiag3d, lprnt real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, gq0_water_vapor real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t, save_qv @@ -52,6 +52,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, gt0, gq0_water_vapor, & end subroutine GFS_SCNV_generic_pre_run + end module GFS_SCNV_generic_pre module GFS_SCNV_generic_post diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index a2763e4bb..d7ec06818 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -61,6 +61,22 @@ kind = kind_phys intent = inout optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = inout + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 9f2debde2..317d7cfa5 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -460,9 +460,9 @@ end subroutine GFS_suite_interstitial_3_finalize !! #endif subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & - ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, xlon, xlat, gq0, imp_physics, imp_physics_mg, & + ntiw, ntlnc, ntinc, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, xlon, xlat, gq0, imp_physics, imp_physics_mg, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, prsi, prsl, & - prslk, rhcbot, rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, kinver, ras, lprnt, ipt, kdt, me, & + prslk, rhcbot, rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, kinver, ras, lprnt, ipt, kdt, me, & clw, rhc, save_qc, save_qi, errmsg, errflg) use machine, only: kind_phys @@ -470,9 +470,9 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr implicit none ! interface variables - integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntclamt, ntrw, & - ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, kdt, me + integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntlnc, ntinc, & + ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, kdt, me integer, dimension(im), intent(in) :: islmsk, kpbl, kinver logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras @@ -512,8 +512,10 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr lprnt = .false. ipt = 1 ! do i=1,im -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-294.37) < 0.101 & -! .and. abs(xlat(i)*rad2dg-4.1) < 0.101 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-97.50) < 0.101 & +! .and. abs(xlat(i)*rad2dg-24.48) < 0.101 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-293.91) < 0.101 & +! .and. abs(xlat(i)*rad2dg+72.02) < 0.101 ! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-308.88) < 0.101 & ! .and. abs(grid%xlat(i)*rad2dg+29.16) < 0.101 ! lprnt = kdt >= 135 .and. abs(xlon(i)*rad2dg-95.27) < 0.101 & @@ -568,6 +570,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & + n /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then tracers = tracers + 1 do k=1,levs @@ -606,7 +609,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr rhc(i,k) = min(rhcmax, max(0.7, 1.0-tx2(i)*tem1*tem2)) enddo enddo - if (kdt == 1 .and. me == 0) write(0,*)' rhc=',rhc(1,:) +! if (kdt == 1 .and. me == 0) write(0,*)' rhc=',rhc(1,:) else do k=1,levs do i=1,im @@ -670,6 +673,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr ! if (lprnt) write(0,*)' clwice=',clw(ipt,:,1) ! if (lprnt) write(0,*)' clwwat=',clw(ipt,:,2) ! if (lprnt) write(0,*)' rhc=',rhc(ipt,:) +! if (lprnt) write(0,*)' gq01=',gq0(ipt,:,1) end subroutine GFS_suite_interstitial_3_run @@ -691,7 +695,7 @@ end subroutine GFS_suite_interstitial_4_finalize subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, & ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, dtf, save_qc, save_qi, con_pi, & - gq0, clw, dqdti, errmsg, errflg) + gq0, clw, dqdti, gt0, lprnt, ipr, errmsg, errflg) use machine, only: kind_phys @@ -701,12 +705,12 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to integer, intent(in) :: im, levs, tracers_total, ntrac, ntcw, ntiw, ntclamt, ntrw, & ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, ipr - logical, intent(in) :: ltaerosol, cplchm + logical, intent(in) :: ltaerosol, cplchm, lprnt real(kind=kind_phys), intent(in) :: con_pi, dtf - real(kind=kind_phys), dimension(im,levs), intent(in) :: save_qc + real(kind=kind_phys), dimension(im,levs), intent(in) :: save_qc, gt0 ! save_qi is not allocated for Zhao-Carr MP real(kind=kind_phys), dimension(:, :), intent(in) :: save_qi @@ -739,6 +743,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt) then if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & + n /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc ) then tracers = tracers + 1 do k=1,levs @@ -807,6 +812,16 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to enddo endif +! if (lprnt) then +! write(0,*)' aft shallow physics' +! write(0,*)'qt0s=',gt0(ipr,:) +! write(0,*)'qq0s=',gq0(ipr,:,1) +! write(0,*)'qq0ws=',gq0(ipr,:,ntcw) +! write(0,*)'qq0is=',gq0(ipr,:,ntiw) +! write(0,*)'qq0ntic=',gq0(ipr,:,8) +! write(0,*)'qq0os=',gq0(ipr,:,12) +! endif + end subroutine GFS_suite_interstitial_4_run end module GFS_suite_interstitial_4 diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index c5371a6f6..2c7fabeea 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1145,6 +1145,22 @@ type = integer intent = in optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F [ntclamt] standard_name = index_for_cloud_amount long_name = tracer index for cloud amount integer @@ -1734,6 +1750,31 @@ kind = kind_phys intent = inout optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = inout + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index f41b31225..d6ca01b9d 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -25,9 +25,9 @@ end subroutine shoc_finalize !! #endif subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & - dtp, me, prsl, delp, phii, phil, u, v, omega, rhc, & - supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & - gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & + dtp, me, prsl, delp, phii, phil, u, v, omega, rhc, & + supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & + gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & cld_sgs, tke, tkh, wthv_sec, lprnt, ipr, errmsg, errflg) implicit none @@ -117,6 +117,8 @@ subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, !GFDL lat has no meaning inside of shoc - changed to "1" +! if(lprnt) write(0,*)' befncpi=',ncpi(ipr,:) +! if(lprnt) write(0,*)' tkh=',tkh(ipr,:) call shoc_work (ix, nx, nzm, nzm+1, dtp, me, 1, prsl, delp, & phii, phil, u, v, omega, gt0, gq0(:,:,1), qi, qc, qsnw, qrn, & @@ -125,6 +127,7 @@ subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, ntlnc, ncpl, ncpi, & con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt) +! if(lprnt) write(0,*)' aftncpi=',ncpi(ipr,:) if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme do k=1,nzm do i=1,nx @@ -400,6 +403,14 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & zi(i,k) = phii(i,k) * ggri enddo enddo + +! if (lprnt) write(0,*)' tabsin=',tabs(ipr,:) +! if (lprnt) write(0,*)' qcin=',qc(ipr,:) +! if (lprnt) write(0,*)' qwvin=',qwv(ipr,:) +! if (lprnt) write(0,*)' qiin=',qi(ipr,:) +! if (lprnt) write(0,*)' qplin=',qpl(ipr,:) +! if (lprnt) write(0,*)' qpiin=',qpi(ipr,:) +! if (lprnt) write(0,*)' tkein=',tke(ipr,:) ! ! move water from vapor to condensate if the condensate is negative ! @@ -415,6 +426,23 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & tabs(i,k) = tabs(i,k) - fac_sub * qi(i,k) qi(i,k) = zero endif +! +! testing removal of ice when too warm to sustain ice +! +! if (qi(i,k) > zero .and. tabs(i,k) > 273.16) then +! wrk = (tabs(i,k) - 273.16) / fac_sub +! if (wrk < qi(i,k)) then +! wrk = qi(i,k) - wrk +! qi(i,k) = wrk +! qwv(i,k) = qwv(i,k) + wrk +! tabs(i,k) = 273.16 +! else +! tabs(i,k) = tabs(i,k) - qi(i,k) / fac_sub +! qwv(i,k) = qwv(i,k) + qi(i,k) +! qi(i,k) = 0.0 +! endif +! endif + enddo enddo ! fill negative water vapor from below @@ -427,6 +455,9 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & enddo enddo +! if (lprnt) write(0,*)' tabsin2=',tabs(ipr,:) +! if (lprnt) write(0,*)' qwvin2=',qwv(ipr,:) + do k=1,nzm do i=1,nx zl(i,k) = phil(i,k) * ggri @@ -454,10 +485,15 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & ! Liquid/ice water static energy - ! Note the the units are degrees K hl(i,k) = tabs(i,k) + gamaz(i,k) - fac_cond*(qcl(i,k)+qpl(i,k)) & - fac_sub *(qci(i,k)+qpi(i,k)) +! if (lprnt .and. i == ipr .and. k<=10) write(0,*)' hl=',hl(i,k), & +! ' tabs=',tabs(i,k),' gamaz=',gamaz(i,k), ' fac_cond=',fac_cond, & +! ' qcl=',qcl(i,k),' qpl=',qpl(i,k),' qci=',qci(i,k),' qpi=',qpi(i,k),& +! ' fac_sub=',fac_sub,' k=',k w3(i,k) = zero enddo enddo +! if (lprnt) write(0,*)' hlin=',hl(ipr,1:40) ! Define vertical grid increments for later use in the vertical differentiation @@ -510,6 +546,8 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & * sqrt(tke(i,k)) / (zl(i,ku) - zl(i,kd)) w_sec(i,k) = max(twoby3 * tke(i,k) - twoby15 * wrk, zero) ! w_sec(i,k) = max(twoby3 * tke(i,k), zero) +! if(lprnt .and. i == ipr .and. k <40) write(0,*)' w_sec=',w_sec(i,k),' tke=',tke(i,k),& +! ' tkh=',tkh(i,ka),tkh(i,kb),' w=',w(i,ku),w(i,kd),' prnum=',prnum(i,ka),prnum(i,kb),' k=',k else w_sec(i,k) = zero endif @@ -578,6 +616,11 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & call assumed_pdf() +! if (lprnt) write(0,*)' tabsout=',tabs(ipr,1:40) +! if (lprnt) write(0,*)' qcout=',qc(ipr,1:40) +! if (lprnt) write(0,*)' qwvout=',qwv(ipr,1:40) +! if (lprnt) write(0,*)' qiout=',qi(ipr,1:40) + contains subroutine tke_shoc() @@ -684,12 +727,21 @@ subroutine tke_shoc() wrk = (dtn*Cee) / smixt(i,k) wrk1 = wtke + dtn*(a_prod_sh+a_prod_bu) +! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wrk1=',wrk1,& +! ' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu,' dtn=',dtn,' smixt=', & +! smixt(i,k),' tkh=',tkh(i,ku),tkh(i,kd),' def2=',def2(i,ku),def2(i,kd) & +! ,' prnum=',prnum(i,ku),prnum(i,kd),' wthv_sec=',wthv_sec(i,k),' thv=',thv(i,k) + do itr=1,nitr ! iterate for implicit solution wtke = min(max(min_tke, wtke), max_tke) a_diss = wrk*sqrt(wtke) ! Coefficient in the TKE dissipation term wtke = wrk1 / (one+a_diss) wtke = tkef1*wtke + tkef2*wtk2 ! tkef1+tkef2 = 1.0 +! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wtk2=',wtk2,& +! ' a_diss=',a_diss,' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu, & +! ' wrk1=',wrk1,' itr=',itr,' k=',k + wtk2 = wtke enddo @@ -711,6 +763,9 @@ subroutine tke_shoc() tscale1/(one+lambda*buoy_sgs*tscale1*tscale1)) endif +! if (lprnt .and. i == ipr .and. k<40) write(0,*)' isotropy=',isotropy(i,k),& +! ' buoy_sgs=',buoy_sgs,' lambda=',lambda,' tscale1=',tscale1 + ! TKE budget terms ! tkesbdiss(i,k) = a_diss @@ -728,6 +783,8 @@ subroutine tke_shoc() tkh(i,k) = min(tkhmax, wrk * (isotropy(i,k) * tke(i,k) & + isotropy(i,k1) * tke(i,k1))) ! Eddy thermal diffusivity enddo ! i +! if (lprnt) write(0,*)' shocendtkh=',tkh(ipr,k),' tke=',tke(ipr,k),& +! tke(ipr,k1),' isot=',isotropy(ipr,k),isotropy(ipr,k1),'k=',k,' k1=',k1 enddo ! k @@ -1320,6 +1377,7 @@ subroutine assumed_pdf() ! wthlsec = wthl_sec(i,k) ! Compute square roots of some variables so we don't have to do it again +! if (lprnt .and. i == ipr .and. k<10) write(0,*)' w_sec=',w_sec(i,k),' k=',k if (w_sec(i,k) > zero) then sqrtw2 = sqrt(w_sec(i,k)) else @@ -1386,6 +1444,8 @@ subroutine assumed_pdf() ! Find parameters of the PDF of liquid/ice static energy +! if (lprnt .and. i == ipr .and. k<10) write(0,*)' thlsec=',thlsec,' w1_2=',w1_2,' w1_1=',w1_1,& +! ' thl_first=',thl_first,' k=',k,' wthlsec=',wthlsec,sqrtw2,sqrtthl IF (thlsec <= thl_tol*thl_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN thl1_1 = thl_first thl1_2 = thl_first @@ -1415,9 +1475,14 @@ subroutine assumed_pdf() thl2_2 = zero endif ! +! if (lprnt .and. i == ipr .and. k<10) write(0,*)' thl1_1=',thl1_1,' sqrtthl=',sqrtthl,' thl_first=',thl_first,& +! ' thl1_2=',thl1_2,' corrtest1=',corrtest1,' w1_2=',w1_2,' w1_1=',w1_1 + thl1_1 = thl1_1*sqrtthl + thl_first thl1_2 = thl1_2*sqrtthl + thl_first +! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thl1_1=',thl1_1,' thl1_2=',thl1_2 + sqrtthl2_1 = sqrt(thl2_1) sqrtthl2_2 = sqrt(thl2_2) @@ -1439,6 +1504,9 @@ subroutine assumed_pdf() qw1_1 = - corrtest2 / w1_2 ! A.7 qw1_2 = - corrtest2 / w1_1 ! A.8 +! if (lprnt .and. i == ipr .and. k<10) write(0,*)' qw1_1=',qw1_1,' corrtest2=',corrtest2,& +! ' w1_2=',w1_2,' wqwsec=',wqwsec,' sqrtw2=',sqrtw2,' sqrtqt=',sqrtqt,' qwsec=',qwsec + tsign = abs(qw1_2-qw1_1) ! Skew_qw = skew_facw*Skew_w @@ -1498,6 +1566,9 @@ subroutine assumed_pdf() Tl1_1 = thl1_1 - gamaz(i,k) Tl1_2 = thl1_2 - gamaz(i,k) +! if (lprnt .and. i == ipr .and. k<40) write(0,*)' Tl1_1=',Tl1_1,' Tl1_2=',Tl1_2,& +! ' wrk1=',wrk1,' thl1_1=',thl1_1,' thl1_2=',thl1_2,' qpl=',qpl(i,k),' qpi=',qpi(i,k) + ! Now compute qs ! Partition based on temperature for the first plume @@ -1505,6 +1576,7 @@ subroutine assumed_pdf() IF (Tl1_1 >= tbgmax) THEN lstarn1 = lcond esval = min(fpvsl(Tl1_1), pval) +! if (lprnt .and. i == ipr .and. k<40) write(0,*)' esval=',esval,' pval=',pval,' eps=',eps qs1 = eps * esval / (pval-0.378d0*esval) ELSE IF (Tl1_1 <= tbgmin) THEN lstarn1 = lsub @@ -1568,6 +1640,8 @@ subroutine assumed_pdf() s1 = qw1_1 - wrk ! A.17 cthl1 = cqt1*wrk*cpolv*beta1*pkap ! A.20 +! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc s1=',s1,' qw1_1=',qw1_1,'wrk=',wrk,& +! ' qs1=',qs1,' beta1=',beta1,' cqt1=',cqt1 wrk1 = cthl1 * cthl1 wrk2 = cqt1 * cqt1 ! std_s1 = sqrt(max(zero,wrk1*thl2_1+wrk2*qw2_1-2.*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) @@ -1581,6 +1655,9 @@ subroutine assumed_pdf() wrk = s1 / (std_s1*sqrt2) C1 = max(zero, min(one, half*(one+erf(wrk)))) ! A.15 +! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc wrk=',wrk,' s1=',s1,'std=',std_s1,& +! ' c1=',c1*100,' qs1=',qs1,' qw1_1=',qw1_1,' k=',k + IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 !! ELSEIF (s1 >= qcmin) THEN !! C1 = one @@ -1639,6 +1716,11 @@ subroutine assumed_pdf() qi1 = qn1 - ql1 qi2 = qn2 - ql2 +! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc qi=',qi1,qi2,' ql=',ql1,ql2,& +! ' c1=',c1,' c2=',c2,' s1=',s1,' s2=',s2,' k=',k,' tl1=',tl1_1,tl1_2,' om1=',om1,'om2=',om2& +! ,' tbgmin=',tbgmin,'a_bg=',a_bg + + diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,k)) diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) diag_qi = diag_qn - diag_ql @@ -1651,6 +1733,10 @@ subroutine assumed_pdf() + fac_sub *(diag_qi+qpi(i,k)) & + tkesbdiss(i,k) * (dtn/cp) ! tke dissipative heating +! if (lprnt .and. i == ipr .and. k < 40) write(0,*)' tabsout=',tabs(ipr,k),' k=',k& +! ,' hl=',hl(i,k),' gamaz=',gamaz(i,k),' diag_ql=',diag_ql,' qpl=',qpl(i,k)& +! ,' diag_qi=',diag_qi,' qpi=',qpi(i,k),' diag_qn =',diag_qn ,' aterm=',aterm,' onema=',onema& +! ,' qn1=',qn1 ,' qn2=',qn2,' ql1=',ql1,' ql2=',ql2 ! Update moisture fields ! Update ncpl and ncpi Anning Cheng 03/11/2016 @@ -1720,7 +1806,7 @@ end subroutine assumed_pdf real function esatw(t) - real t ! temperature (K) + real t ! temperature (K) real a0,a1,a2,a3,a4,a5,a6,a7,a8 data a0,a1,a2,a3,a4,a5,a6,a7,a8 / & 6.11239921, 0.443987641, 0.142986287e-1, & @@ -1733,8 +1819,8 @@ end function esatw real function qsatw(t,p) ! implicit none - real t ! temperature (K) - real p ! pressure (Pa) + real t ! temperature (K) + real p ! pressure (Pa) real esat ! esat = fpvs(t) esat = fpvsl(t) @@ -1745,7 +1831,7 @@ end function qsatw real function esati(t) - real t ! temperature (K) + real t ! temperature (K) real a0,a1,a2,a3,a4,a5,a6,a7,a8 data a0,a1,a2,a3,a4,a5,a6,a7,a8 / & 6.11147274, 0.503160820, 0.188439774e-1, & diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 1ee4eeeb5..07f2e46ab 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -528,6 +528,12 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & enddo endif endif +! if (lprnt) then +! write(0,*)' inmic qlcn=',qlcn(ipr,:) +! write(0,*)' inmic qlls=',qlls(ipr,:) +! write(0,*)' inmic qicn=',qicn(ipr,:) +! write(0,*)' inmic qils=',qils(ipr,:) +! endif ! DT_MOIST = dt_i dt_r8 = dt_i @@ -1540,7 +1546,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! if(lprint) then ! write(0,*)' calling micro_mg_tend3_0 qcvar3=',qcvar3,' i=',i ! write(0,*)' qcr8=',qcr8(:) +! write(0,*)' qir8=',qir8(:) ! write(0,*)' ncr8=',ncr8(:) +! write(0,*)' nir8=',nir8(:) ! write(0,*)' npccninr8=',npccninr8(:) ! write(0,*)' plevr8=',plevr8(:) ! write(0,*)' ter8=',ter8(:) @@ -1845,7 +1853,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (allocated(ALPHT_X)) deallocate (ALPHT_X) ! if (lprnt) then -! write(0,*)' rn_o=',rn_o(ipr),' ls_prc2=',ls_prc2(ipr),' ls_snr=',ls_snr(ipr) +! write(0,*)' rn_o=',rn_o(ipr),' ls_prc2=',ls_prc2(ipr),' ls_snr=',ls_snr(ipr),' kdt=',kdt ! write(0,*)' end micro_mg_tend t_io= ', t_io(ipr,:) ! write(0,*)' end micro_mg_tend clls_io= ', clls_io(ipr,:) ! endif diff --git a/physics/micro_mg2_0.F90 b/physics/micro_mg2_0.F90 index 281802878..6588a375a 100644 --- a/physics/micro_mg2_0.F90 +++ b/physics/micro_mg2_0.F90 @@ -1678,7 +1678,7 @@ subroutine micro_mg_tend ( & if (do_cldice) then call ice_deposition_sublimation(t(:,k), q(:,k), qi(:,k), ni(:,k), & - icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & + cldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) do i=1,mgncol diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index c707ba9da..9a9971df5 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -1,70 +1,75 @@ -!>\file micro_mg3_0.F90 -!! This file contains Morrison-Gettelman MP version 3.0 - -!! Update of MG microphysics with prognostic hai OR graupel. - -!>\ingroup mg2mg3 -!>\defgroup mg3_mp Morrison-Gettelman MP version 3.0 -!> @{ -!! This module contains MG microphysics version 3.0 - Update of MG microphysics with -!! prognostic hail OR graupel. -!! -!! \authors Andrew Gettelman, Hugh Morrison -!! -!! \version 3 history: Sep 2016: development begun for hail, graupel -!! This version:https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/mg3_tags/mg3_33_cam5_4_153/ -!! -!! \version 2 history: Sep 2011: Development begun. -!!\n Feb 2013: Added of prognostic precipitation. -!!\n Aug 2015: Published and released version -!! -!! Contributions from: Sean Santos, Peter Caldwell, Xiaohong Liu and Steve Ghan -!! -!! - Anning Cheng adopted mg2 for FV3GFS 9/29/2017 -!!\n add GMAO ice conversion and Liu et. al liquid water -!!\n conversion in 10/12/2017 -!! -!! - Anning showed promising results for FV3GFS on 10/15/2017 -!! - S. Moorthi - Oct/Nov 2017 - optimized the MG2 code -!! - S. Moorthi - Nov 2017 - made the sedimentation quasi-implicit -!! - S. Moorthi - Feb 2018 - updated to MG3 - modified graupel sedimentation -!! other modifications to eliminate blowup. -!! - S. Moorthi - Mar 2018 - fixed a few bugs and added option to run as MG2 -!! - S. Moorthi - Oct,29,2018 - change nlb from nlev/3 to levels with p/ps < 0.05 (nlball) -!! -!! invoked in CAM by specifying -microphys=mg3 -!! -!! References: -!! -!! Gettelman, A. and H. Morrison, Advanced Two-Moment Microphysics for Global Models. -!! Part I: Off line tests and comparisons with other schemes. -!! J. Climate, 28, 1268-1287. doi: 10.1175/JCLI-D-14-00102.1, 2015. -!! -!! Gettelman, A., H. Morrison, S. Santos, P. Bogenschutz and P. H. Caldwell -!! Advanced Two-Moment Microphysics for Global Models. -!! Part II: Global model solutions and Aerosol-Cloud Interactions. -!! J. Climate, 28, 1288-1307. doi:10.1175/JCLI-D-14-00103.1 , 2015. -!! -!! -!! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice -!! microphysics in cooperation with the MG liquid microphysics. This is -!! controlled by the do_cldice variable. -!! -!! If do_cldice is false, then MG microphysics should not update CLDICE or -!! NUMICE; it is assumed that the other microphysics scheme will have updated -!! CLDICE and NUMICE. The other microphysics should handle the following -!! processes that would have been done by MG: -!! - Detrainment (liquid and ice) -!! - Homogeneous ice nucleation -!! - Heterogeneous ice nucleation -!! - Bergeron process -!! - Melting of ice -!! - Freezing of cloud drops -!! - Autoconversion (ice -> snow) -!! - Growth/Sublimation of ice -!! - Sedimentation of ice -!! -!! This option has not been updated since the introduction of prognostic -!! precipitation, and probably should be adjusted to cover snow as well. +module micro_mg3_0 +!--------------------------------------------------------------------------------- +! Purpose: +! MG microphysics version 3.0 - Update of MG microphysics with +! prognostic hail OR graupel. +! +! Author: Andrew Gettelman, Hugh Morrison +! +! +! Version 3 history: Sep 2016: development begun for hail, graupel +! This version:https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/mg3_tags/mg3_33_cam5_4_153/ +! +! Version 2 history: Sep 2011: Development begun. +! Feb 2013: Added of prognostic precipitation. +! Aug 2015: Published and released version +! Contributions from: Sean Santos, Peter Caldwell, Xiaohong Liu and Steve Ghan +! +! Anning Cheng adopted mg2 for FV3GFS 9/29/2017 +! add GMAO ice conversion and Liu et. al liquid water +! conversion in 10/12/2017 +! Anning showed promising results for FV3GFS on 10/15/2017 +! S. Moorthi - Oct/Nov 2017 - optimized the MG2 code +! S. Moorthi - Nov 2017 - made the sedimentation quasi-implicit +! S. Moorthi - Feb 2018 - updated to MG3 - modified graupel sedimentation +! other modifications to eliminate blowup. +! S. Moorthi - Mar 2018 - fixed a few bugs and added option to run as MG2 +! S. Moorthi - Oct,29,2018 - change nlb from nlev/3 to levels with p/ps < 0.05 (nlball) +! +! invoked in CAM by specifying -microphys=mg3 +! +! References: +! +! Gettelman, A. and H. Morrison, Advanced Two-Moment Microphysics for Global Models. +! +! Part I: Off line tests and comparisons with other schemes. +! +! J. Climate, 28, 1268-1287. doi: 10.1175/JCLI-D-14-00102.1, 2015. +! +! +! +! Gettelman, A., H. Morrison, S. Santos, P. Bogenschutz and P. H. Caldwell +! +! Advanced Two-Moment Microphysics for Global Models. +! +! Part II: Global model solutions and Aerosol-Cloud Interactions. +! +! J. Climate, 28, 1288-1307. doi:10.1175/JCLI-D-14-00103.1 , 2015. +! +! for questions contact Hugh Morrison, Andrew Gettelman +! e-mail: morrison@ucar.edu, andrew@ucar.edu +!--------------------------------------------------------------------------------- +! +! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice +! microphysics in cooperation with the MG liquid microphysics. This is +! controlled by the do_cldice variable. +! +! If do_cldice is false, then MG microphysics should not update CLDICE or +! NUMICE; it is assumed that the other microphysics scheme will have updated +! CLDICE and NUMICE. The other microphysics should handle the following +! processes that would have been done by MG: +! - Detrainment (liquid and ice) +! - Homogeneous ice nucleation +! - Heterogeneous ice nucleation +! - Bergeron process +! - Melting of ice +! - Freezing of cloud drops +! - Autoconversion (ice -> snow) +! - Growth/Sublimation of ice +! - Sedimentation of ice +! +! This option has not been updated since the introduction of prognostic +! precipitation, and probably should be adjusted to cover snow as well. ! !--------------------------------------------------------------------------------- !Version 3.O based on micro_mg2_0.F90 and WRF3.8.1 module_mp_morr_two_moment.F @@ -118,9 +123,6 @@ ! 1) An implementation of the gamma function (if not intrinsic). ! 2) saturation vapor pressure and specific humidity over water ! 3) svp over ice - -module micro_mg3_0 - use machine, only : r8 => kind_phys use physcons, only : epsqs => con_eps, fv => con_fvirt use funcphys, only : fpvsl, fpvsi @@ -153,25 +155,25 @@ module micro_mg3_0 ! (mnuccd) are based on the fixed cloud ice number. Calculation of ! mnuccd follows from the prognosed ice crystal number ni. -logical :: nccons !< nccons = .true. to specify constant cloud droplet number -logical :: nicons !< nicons = .true. to specify constant cloud ice number +logical :: nccons ! nccons = .true. to specify constant cloud droplet number +logical :: nicons ! nicons = .true. to specify constant cloud ice number !++ag kt -logical :: ngcons !< ngcons = .true. to specify constant graupel number +logical :: ngcons ! ngcons = .true. to specify constant graupel number !--ag kt ! specified ice and droplet number concentrations ! note: these are local in-cloud values, not grid-mean -real(r8) :: ncnst !< droplet num concentration when nccons=.true. (m-3) -real(r8) :: ninst !< ice num concentration when nicons=.true. (m-3) +real(r8) :: ncnst ! droplet num concentration when nccons=.true. (m-3) +real(r8) :: ninst ! ice num concentration when nicons=.true. (m-3) !++ag kt -real(r8) :: ngnst !< graupel num concentration when ngcons=.true. (m-3) +real(r8) :: ngnst ! graupel num concentration when ngcons=.true. (m-3) !--ag kt !========================================================= ! Private module parameters !========================================================= -!> Range of cloudsat reflectivities (dBz) for analytic simulator +!Range of cloudsat reflectivities (dBz) for analytic simulator real(r8), parameter :: csmin = -30._r8 real(r8), parameter :: csmax = 26._r8 real(r8), parameter :: mindbz = -99._r8 @@ -196,18 +198,18 @@ module micro_mg3_0 !========================================================= ! Set using arguments to micro_mg_init -real(r8) :: g !< gravity -real(r8) :: r !< dry air gas constant -real(r8) :: rv !< water vapor gas constant -real(r8) :: cpp !< specific heat of dry air -real(r8) :: tmelt !< freezing point of water (K) +real(r8) :: g ! gravity +real(r8) :: r ! dry air gas constant +real(r8) :: rv ! water vapor gas constant +real(r8) :: cpp ! specific heat of dry air +real(r8) :: tmelt ! freezing point of water (K) ! latent heats of: -real(r8) :: xxlv !< vaporization -real(r8) :: xlf !< freezing -real(r8) :: xxls !< sublimation +real(r8) :: xxlv ! vaporization +real(r8) :: xlf ! freezing +real(r8) :: xxls ! sublimation -real(r8) :: rhmini !< Minimum rh for ice cloud fraction > 0. +real(r8) :: rhmini ! Minimum rh for ice cloud fraction > 0. ! flags logical :: microp_uniform, do_cldice, use_hetfrz_classnuc, & @@ -215,16 +217,16 @@ module micro_mg3_0 do_hail, do_graupel !--ag -real(r8) :: rhosu !< typical 850mn air density +real(r8) :: rhosu ! typical 850mn air density -real(r8) :: icenuct !< ice nucleation temperature: currently -5 degrees C +real(r8) :: icenuct ! ice nucleation temperature: currently -5 degrees C -real(r8) :: snowmelt !< what temp to melt all snow: currently 2 degrees C -real(r8) :: rainfrze !< what temp to freeze all rain: currently -5 degrees C +real(r8) :: snowmelt ! what temp to melt all snow: currently 2 degrees C +real(r8) :: rainfrze ! what temp to freeze all rain: currently -5 degrees C -real(r8) :: rhogtmp !< hail or graupel density (kg m-3) -real(r8) :: agtmp !< tmp ag/ah parameter -real(r8) :: bgtmp !< tmp fall speed parameter +real(r8) :: rhogtmp ! hail or graupel density (kg m-3) +real(r8) :: agtmp ! tmp ag/ah parameter +real(r8) :: bgtmp ! tmp fall speed parameter ! additional constants to help speed up code real(r8) :: gamma_br_plus1, gamma_bs_plus1, gamma_bi_plus1, gamma_bj_plus1, gamma_bg_plus1 @@ -232,11 +234,11 @@ module micro_mg3_0 real(r8) :: xxlv_squared, xxls_squared real(r8) :: omeps -character(len=16) :: micro_mg_precip_frac_method !< type of precipitation fraction method -real(r8) :: micro_mg_berg_eff_factor !< berg efficiency factor +character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method +real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor -logical :: allow_sed_supersat !< Allow supersaturated conditions after sedimentation loop -logical :: do_sb_physics !< do SB 2001 autoconversion or accretion physics +logical :: allow_sed_supersat ! Allow supersaturated conditions after sedimentation loop +logical :: do_sb_physics ! do SB 2001 autoconversion or accretion physics logical :: do_ice_gmao logical :: do_liq_liu @@ -244,10 +246,6 @@ module micro_mg3_0 contains !=============================================================================== -!>\ingroup mg3_mp -!! This subroutine initializes microphysics routine, should be called -!! once at start of simulation. -!!\author Andrew Gettelman, Dec 2005 subroutine micro_mg_init( & kind, gravit, rair, rh2o, cpair, & tmelt_in, latvap, latice, & @@ -415,7 +413,6 @@ subroutine micro_mg_init( & tmx = 375.16_r8 trice = 35.00_r8 ip = .true. -!> - call gestbl() call gestbl(tmn ,tmx ,trice ,ip ,epsqs , latvap ,latice ,rh2o , & cpair ,tmelt_in ) @@ -426,13 +423,6 @@ end subroutine micro_mg_init !=============================================================================== !microphysics routine for each timestep goes here... -!>\ingroup mg3_mp -!! This subroutine calculates calculate -!! MG3 microphysical processes and other utilities. -!>\authors Hugh Morrison, Andrew Gettelman, NCAR, Peter Caldwell, LLNL -!! e-mail: morrison@ucar.edu, andrew@ucar.edu -!!\section mg3_micro_mg_tend MG3 micro_mg_tend General Algorithm -!> @{ subroutine micro_mg_tend ( & mgncol, nlev, deltatin, & t, q, & @@ -477,6 +467,7 @@ subroutine micro_mg_tend ( & !++ag reff_rain, reff_snow, reff_grau, & !--ag + qcsevap, qisevap, qvres, & cmeitot, vtrmc, vtrmi, & umr, ums, & @@ -566,196 +557,194 @@ subroutine micro_mg_tend ( & ! e-mail: morrison@ucar.edu, andrew@ucar.edu ! input arguments - integer, intent(in) :: mgncol !< number of microphysics columns - integer, intent(in) :: nlev !< number of layers - integer, intent(in) :: nlball(mgncol) !< sedimentation start level - real(r8), intent(in) :: xlat,xlon !< number of layers - real(r8), intent(in) :: deltatin !< time step (s) - real(r8), intent(in) :: t(mgncol,nlev) !< input temperature (K) - real(r8), intent(in) :: q(mgncol,nlev) !< input h20 vapor mixing ratio (kg/kg) + integer, intent(in) :: mgncol ! number of microphysics columns + integer, intent(in) :: nlev ! number of layers + integer, intent(in) :: nlball(mgncol) ! sedimentation start level + real(r8), intent(in) :: xlat,xlon ! number of layers + real(r8), intent(in) :: deltatin ! time step (s) + real(r8), intent(in) :: t(mgncol,nlev) ! input temperature (K) + real(r8), intent(in) :: q(mgncol,nlev) ! input h20 vapor mixing ratio (kg/kg) ! note: all input cloud variables are grid-averaged - real(r8), intent(in) :: qcn(mgncol,nlev) !< cloud water mixing ratio (kg/kg) - real(r8), intent(in) :: qin(mgncol,nlev) !< cloud ice mixing ratio (kg/kg) - real(r8), intent(in) :: ncn(mgncol,nlev) !< cloud water number conc (1/kg) - real(r8), intent(in) :: nin(mgncol,nlev) !< cloud ice number conc (1/kg) - - real(r8), intent(in) :: qrn(mgncol,nlev) !< rain mixing ratio (kg/kg) - real(r8), intent(in) :: qsn(mgncol,nlev) !< snow mixing ratio (kg/kg) - real(r8), intent(in) :: nrn(mgncol,nlev) !< rain number conc (1/kg) - real(r8), intent(in) :: nsn(mgncol,nlev) !< snow number conc (1/kg) + real(r8), intent(in) :: qcn(mgncol,nlev) ! cloud water mixing ratio (kg/kg) + real(r8), intent(in) :: qin(mgncol,nlev) ! cloud ice mixing ratio (kg/kg) + real(r8), intent(in) :: ncn(mgncol,nlev) ! cloud water number conc (1/kg) + real(r8), intent(in) :: nin(mgncol,nlev) ! cloud ice number conc (1/kg) + + real(r8), intent(in) :: qrn(mgncol,nlev) ! rain mixing ratio (kg/kg) + real(r8), intent(in) :: qsn(mgncol,nlev) ! snow mixing ratio (kg/kg) + real(r8), intent(in) :: nrn(mgncol,nlev) ! rain number conc (1/kg) + real(r8), intent(in) :: nsn(mgncol,nlev) ! snow number conc (1/kg) !++ag - real(r8), intent(in) :: qgr(mgncol,nlev) !< graupel/hail mixing ratio (kg/kg) - real(r8), intent(in) :: ngr(mgncol,nlev) !< graupel/hail number conc (1/kg) + real(r8), intent(in) :: qgr(mgncol,nlev) ! graupel/hail mixing ratio (kg/kg) + real(r8), intent(in) :: ngr(mgncol,nlev) ! graupel/hail number conc (1/kg) !--ag - real(r8) :: relvar(mgncol,nlev) !< cloud water relative variance (-) - real(r8) :: accre_enhan(mgncol,nlev)!< optional accretion -! real(r8), intent(in) :: relvar_i !< cloud water relative variance (-) - real(r8), intent(in) :: accre_enhan_i !< optional accretion - !< enhancement factor (-) + real(r8) :: relvar(mgncol,nlev) ! cloud water relative variance (-) + real(r8) :: accre_enhan(mgncol,nlev)! optional accretion +! real(r8), intent(in) :: relvar_i ! cloud water relative variance (-) + real(r8), intent(in) :: accre_enhan_i ! optional accretion + ! enhancement factor (-) - real(r8), intent(in) :: p(mgncol,nlev) !< air pressure (pa) - real(r8), intent(in) :: pdel(mgncol,nlev) !< pressure difference across level (pa) + real(r8), intent(in) :: p(mgncol,nlev) ! air pressure (pa) + real(r8), intent(in) :: pdel(mgncol,nlev) ! pressure difference across level (pa) - real(r8), intent(in) :: cldn(mgncol,nlev) !< cloud fraction (no units) - real(r8), intent(in) :: liqcldf(mgncol,nlev) !< liquid cloud fraction (no units) - real(r8), intent(in) :: icecldf(mgncol,nlev) !< ice cloud fraction (no units) - real(r8), intent(in) :: qsatfac(mgncol,nlev) !< subgrid cloud water saturation scaling factor (no units) - logical, intent(in) :: lprnt !< control flag for diagnostic print out - logical, intent(in) :: iccn !< flag for IN and CCN forcing for Morrison-Gettelman microphysics - logical, intent(in) :: aero_in !< flag for using aerosols in Morrison-Gettelman microphysics + real(r8), intent(in) :: cldn(mgncol,nlev) ! cloud fraction (no units) + real(r8), intent(in) :: liqcldf(mgncol,nlev) ! liquid cloud fraction (no units) + real(r8), intent(in) :: icecldf(mgncol,nlev) ! ice cloud fraction (no units) + real(r8), intent(in) :: qsatfac(mgncol,nlev) ! subgrid cloud water saturation scaling factor (no units) + logical, intent(in) :: lprnt, iccn, aero_in ! used for scavenging ! Inputs for aerosol activation - real(r8), intent(inout) :: naai(mgncol,nlev) !< ice nucleation number (from microp_aero_ts) (1/kg) - real(r8), intent(in) :: npccnin(mgncol,nlev) !< ccn activated number tendency (from microp_aero_ts) (1/kg*s) -! real(r8), intent(in) :: npccn(mgncol,nlev) !< ccn activated number tendency (from microp_aero_ts) (1/kg*s) - real(r8) :: npccn(mgncol,nlev) !< ccn activated number tendency (from microp_aero_ts) (1/kg*s) + real(r8), intent(inout) :: naai(mgncol,nlev) ! ice nucleation number (from microp_aero_ts) (1/kg) + real(r8), intent(in) :: npccnin(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s) +! real(r8), intent(in) :: npccn(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s) + real(r8) :: npccn(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s) ! Note that for these variables, the dust bin is assumed to be the last index. ! (For example, in CAM, the last dimension is always size 4.) - real(r8), intent(in) :: rndst(mgncol,nlev,10) !< radius of each dust bin, for contact freezing (from microp_aero_ts) (m) - real(r8), intent(in) :: nacon(mgncol,nlev,10) !< number in each dust bin, for contact freezing (from microp_aero_ts) (1/m^3) + real(r8), intent(in) :: rndst(mgncol,nlev,10) ! radius of each dust bin, for contact freezing (from microp_aero_ts) (m) + real(r8), intent(in) :: nacon(mgncol,nlev,10) ! number in each dust bin, for contact freezing (from microp_aero_ts) (1/m^3) ! output arguments - real(r8), intent(out) :: qcsinksum_rate1ord(mgncol,nlev) !< 1st order rate for - !! direct cw to precip conversion - real(r8), intent(out) :: tlat(mgncol,nlev) !< latent heating rate (W/kg) - real(r8), intent(out) :: qvlat(mgncol,nlev) !< microphysical tendency qv (1/s) - real(r8), intent(out) :: qctend(mgncol,nlev) !< microphysical tendency qc (1/s) - real(r8), intent(out) :: qitend(mgncol,nlev) !< microphysical tendency qi (1/s) - real(r8), intent(out) :: nctend(mgncol,nlev) !< microphysical tendency nc (1/(kg*s)) - real(r8), intent(out) :: nitend(mgncol,nlev) !< microphysical tendency ni (1/(kg*s)) - - real(r8), intent(out) :: qrtend(mgncol,nlev) !< microphysical tendency qr (1/s) - real(r8), intent(out) :: qstend(mgncol,nlev) !< microphysical tendency qs (1/s) - real(r8), intent(out) :: nrtend(mgncol,nlev) !< microphysical tendency nr (1/(kg*s)) - real(r8), intent(out) :: nstend(mgncol,nlev) !< microphysical tendency ns (1/(kg*s)) + real(r8), intent(out) :: qcsinksum_rate1ord(mgncol,nlev) ! 1st order rate for + ! direct cw to precip conversion + real(r8), intent(out) :: tlat(mgncol,nlev) ! latent heating rate (W/kg) + real(r8), intent(out) :: qvlat(mgncol,nlev) ! microphysical tendency qv (1/s) + real(r8), intent(out) :: qctend(mgncol,nlev) ! microphysical tendency qc (1/s) + real(r8), intent(out) :: qitend(mgncol,nlev) ! microphysical tendency qi (1/s) + real(r8), intent(out) :: nctend(mgncol,nlev) ! microphysical tendency nc (1/(kg*s)) + real(r8), intent(out) :: nitend(mgncol,nlev) ! microphysical tendency ni (1/(kg*s)) + + real(r8), intent(out) :: qrtend(mgncol,nlev) ! microphysical tendency qr (1/s) + real(r8), intent(out) :: qstend(mgncol,nlev) ! microphysical tendency qs (1/s) + real(r8), intent(out) :: nrtend(mgncol,nlev) ! microphysical tendency nr (1/(kg*s)) + real(r8), intent(out) :: nstend(mgncol,nlev) ! microphysical tendency ns (1/(kg*s)) !++ag - real(r8), intent(out) :: qgtend(mgncol,nlev) !< microphysical tendency qg (1/s) - real(r8), intent(out) :: ngtend(mgncol,nlev) !< microphysical tendency ng (1/(kg*s)) + real(r8), intent(out) :: qgtend(mgncol,nlev) ! microphysical tendency qg (1/s) + real(r8), intent(out) :: ngtend(mgncol,nlev) ! microphysical tendency ng (1/(kg*s)) !--ag - real(r8), intent(out) :: effc(mgncol,nlev) !< droplet effective radius (micron) - real(r8), intent(out) :: effc_fn(mgncol,nlev) !< droplet effective radius, assuming nc = 1.e8 kg-1 - real(r8), intent(out) :: effi(mgncol,nlev) !< cloud ice effective radius (micron) - real(r8), intent(out) :: sadice(mgncol,nlev) !< cloud ice surface area density (cm2/cm3) - real(r8), intent(out) :: sadsnow(mgncol,nlev) !< cloud snow surface area density (cm2/cm3) - real(r8), intent(out) :: prect(mgncol) !< surface precip rate (m/s) - real(r8), intent(out) :: preci(mgncol) !< cloud ice/snow precip rate (m/s) - real(r8), intent(out) :: nevapr(mgncol,nlev) !< evaporation rate of rain + snow (1/s) - real(r8), intent(out) :: evapsnow(mgncol,nlev) !< sublimation rate of snow (1/s) - real(r8), intent(out) :: am_evp_st(mgncol,nlev) !< stratiform evaporation area (frac) - real(r8), intent(out) :: prain(mgncol,nlev) !< production of rain + snow (1/s) - real(r8), intent(out) :: prodsnow(mgncol,nlev) !< production of snow (1/s) - real(r8), intent(out) :: cmeout(mgncol,nlev) !< evap/sub of cloud (1/s) - real(r8), intent(out) :: deffi(mgncol,nlev) !< ice effective diameter for optics (radiation) (micron) - real(r8), intent(out) :: pgamrad(mgncol,nlev) !< ice gamma parameter for optics (radiation) (no units) - real(r8), intent(out) :: lamcrad(mgncol,nlev) !< slope of droplet distribution for optics (radiation) (1/m) - real(r8), intent(out) :: qsout(mgncol,nlev) !< snow mixing ratio (kg/kg) - real(r8), intent(out) :: dsout(mgncol,nlev) !< snow diameter (m) - real(r8), intent(out) :: lflx(mgncol,2:nlev+1) !< grid-box average liquid condensate flux (kg m^-2 s^-1) - real(r8), intent(out) :: iflx(mgncol,2:nlev+1) !< grid-box average ice condensate flux (kg m^-2 s^-1) - real(r8), intent(out) :: rflx(mgncol,2:nlev+1) !< grid-box average rain flux (kg m^-2 s^-1) - real(r8), intent(out) :: sflx(mgncol,2:nlev+1) !< grid-box average snow flux (kg m^-2 s^-1) + real(r8), intent(out) :: effc(mgncol,nlev) ! droplet effective radius (micron) + real(r8), intent(out) :: effc_fn(mgncol,nlev) ! droplet effective radius, assuming nc = 1.e8 kg-1 + real(r8), intent(out) :: effi(mgncol,nlev) ! cloud ice effective radius (micron) + real(r8), intent(out) :: sadice(mgncol,nlev) ! cloud ice surface area density (cm2/cm3) + real(r8), intent(out) :: sadsnow(mgncol,nlev) ! cloud snow surface area density (cm2/cm3) + real(r8), intent(out) :: prect(mgncol) ! surface precip rate (m/s) + real(r8), intent(out) :: preci(mgncol) ! cloud ice/snow precip rate (m/s) + real(r8), intent(out) :: nevapr(mgncol,nlev) ! evaporation rate of rain + snow (1/s) + real(r8), intent(out) :: evapsnow(mgncol,nlev) ! sublimation rate of snow (1/s) + real(r8), intent(out) :: am_evp_st(mgncol,nlev) ! stratiform evaporation area (frac) + real(r8), intent(out) :: prain(mgncol,nlev) ! production of rain + snow (1/s) + real(r8), intent(out) :: prodsnow(mgncol,nlev) ! production of snow (1/s) + real(r8), intent(out) :: cmeout(mgncol,nlev) ! evap/sub of cloud (1/s) + real(r8), intent(out) :: deffi(mgncol,nlev) ! ice effective diameter for optics (radiation) (micron) + real(r8), intent(out) :: pgamrad(mgncol,nlev) ! ice gamma parameter for optics (radiation) (no units) + real(r8), intent(out) :: lamcrad(mgncol,nlev) ! slope of droplet distribution for optics (radiation) (1/m) + real(r8), intent(out) :: qsout(mgncol,nlev) ! snow mixing ratio (kg/kg) + real(r8), intent(out) :: dsout(mgncol,nlev) ! snow diameter (m) + real(r8), intent(out) :: lflx(mgncol,2:nlev+1) ! grid-box average liquid condensate flux (kg m^-2 s^-1) + real(r8), intent(out) :: iflx(mgncol,2:nlev+1) ! grid-box average ice condensate flux (kg m^-2 s^-1) + real(r8), intent(out) :: rflx(mgncol,2:nlev+1) ! grid-box average rain flux (kg m^-2 s^-1) + real(r8), intent(out) :: sflx(mgncol,2:nlev+1) ! grid-box average snow flux (kg m^-2 s^-1) !++ag - real(r8), intent(out) :: gflx(mgncol,2:nlev+1) !< grid-box average graupel/hail flux (kg m^-2 s^-1) + real(r8), intent(out) :: gflx(mgncol,2:nlev+1) ! grid-box average graupel/hail flux (kg m^-2 s^-1) !--ag - real(r8), intent(out) :: qrout(mgncol,nlev) !< grid-box average rain mixing ratio (kg/kg) - real(r8), intent(out) :: reff_rain(mgncol,nlev) !< rain effective radius (micron) - real(r8), intent(out) :: reff_snow(mgncol,nlev) !< snow effective radius (micron) + real(r8), intent(out) :: qrout(mgncol,nlev) ! grid-box average rain mixing ratio (kg/kg) + real(r8), intent(out) :: reff_rain(mgncol,nlev) ! rain effective radius (micron) + real(r8), intent(out) :: reff_snow(mgncol,nlev) ! snow effective radius (micron) !++ag - real(r8), intent(out) :: reff_grau(mgncol,nlev) !< graupel effective radius (micron) + real(r8), intent(out) :: reff_grau(mgncol,nlev) ! graupel effective radius (micron) !--ag - real(r8), intent(out) :: qcsevap(mgncol,nlev) !< cloud water evaporation due to sedimentation (1/s) - real(r8), intent(out) :: qisevap(mgncol,nlev) !< cloud ice sublimation due to sedimentation (1/s) - real(r8), intent(out) :: qvres(mgncol,nlev) !< residual condensation term to ensure RH < 100% (1/s) - real(r8), intent(out) :: cmeitot(mgncol,nlev) !< grid-mean cloud ice sub/dep (1/s) - real(r8), intent(out) :: vtrmc(mgncol,nlev) !< mass-weighted cloud water fallspeed (m/s) - real(r8), intent(out) :: vtrmi(mgncol,nlev) !< mass-weighted cloud ice fallspeed (m/s) - real(r8), intent(out) :: umr(mgncol,nlev) !< mass weighted rain fallspeed (m/s) - real(r8), intent(out) :: ums(mgncol,nlev) !< mass weighted snow fallspeed (m/s) + real(r8), intent(out) :: qcsevap(mgncol,nlev) ! cloud water evaporation due to sedimentation (1/s) + real(r8), intent(out) :: qisevap(mgncol,nlev) ! cloud ice sublimation due to sedimentation (1/s) + real(r8), intent(out) :: qvres(mgncol,nlev) ! residual condensation term to ensure RH < 100% (1/s) + real(r8), intent(out) :: cmeitot(mgncol,nlev) ! grid-mean cloud ice sub/dep (1/s) + real(r8), intent(out) :: vtrmc(mgncol,nlev) ! mass-weighted cloud water fallspeed (m/s) + real(r8), intent(out) :: vtrmi(mgncol,nlev) ! mass-weighted cloud ice fallspeed (m/s) + real(r8), intent(out) :: umr(mgncol,nlev) ! mass weighted rain fallspeed (m/s) + real(r8), intent(out) :: ums(mgncol,nlev) ! mass weighted snow fallspeed (m/s) !++ag - real(r8), intent(out) :: umg(mgncol,nlev) !< mass weighted graupel/hail fallspeed (m/s) - real(r8), intent(out) :: qgsedten(mgncol,nlev) !< qg sedimentation tendency (1/s) + real(r8), intent(out) :: umg(mgncol,nlev) ! mass weighted graupel/hail fallspeed (m/s) + real(r8), intent(out) :: qgsedten(mgncol,nlev) ! qg sedimentation tendency (1/s) !--ag - real(r8), intent(out) :: qcsedten(mgncol,nlev) !< qc sedimentation tendency (1/s) - real(r8), intent(out) :: qisedten(mgncol,nlev) !< qi sedimentation tendency (1/s) - real(r8), intent(out) :: qrsedten(mgncol,nlev) !< qr sedimentation tendency (1/s) - real(r8), intent(out) :: qssedten(mgncol,nlev) !< qs sedimentation tendency (1/s) + real(r8), intent(out) :: qcsedten(mgncol,nlev) ! qc sedimentation tendency (1/s) + real(r8), intent(out) :: qisedten(mgncol,nlev) ! qi sedimentation tendency (1/s) + real(r8), intent(out) :: qrsedten(mgncol,nlev) ! qr sedimentation tendency (1/s) + real(r8), intent(out) :: qssedten(mgncol,nlev) ! qs sedimentation tendency (1/s) ! microphysical process rates for output (mixing ratio tendencies) (all have units of 1/s) - real(r8), intent(out) :: pratot(mgncol,nlev) !< accretion of cloud by rain - real(r8), intent(out) :: prctot(mgncol,nlev) !< autoconversion of cloud to rain - real(r8), intent(out) :: mnuccctot(mgncol,nlev) !< mixing ratio tend due to immersion freezing - real(r8), intent(out) :: mnuccttot(mgncol,nlev) !< mixing ratio tend due to contact freezing - real(r8), intent(out) :: msacwitot(mgncol,nlev) !< mixing ratio tend due to H-M splintering - real(r8), intent(out) :: psacwstot(mgncol,nlev) !< collection of cloud water by snow - real(r8), intent(out) :: bergstot(mgncol,nlev) !< bergeron process on snow - real(r8), intent(out) :: bergtot(mgncol,nlev) !< bergeron process on cloud ice - real(r8), intent(out) :: melttot(mgncol,nlev) !< melting of cloud ice - real(r8), intent(out) :: homotot(mgncol,nlev) !< homogeneous freezing cloud water - real(r8), intent(out) :: qcrestot(mgncol,nlev) !< residual cloud condensation due to removal of excess supersat - real(r8), intent(out) :: prcitot(mgncol,nlev) !< autoconversion of cloud ice to snow - real(r8), intent(out) :: praitot(mgncol,nlev) !< accretion of cloud ice by snow - real(r8), intent(out) :: qirestot(mgncol,nlev) !< residual ice deposition due to removal of excess supersat - real(r8), intent(out) :: mnuccrtot(mgncol,nlev) !< mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s) - real(r8), intent(out) :: mnuccritot(mgncol,nlev)!< mixing ratio tendency due to heterogeneous freezing of rain to ice (1/s) - real(r8), intent(out) :: pracstot(mgncol,nlev) !< mixing ratio tendency due to accretion of rain by snow (1/s) - real(r8), intent(out) :: meltsdttot(mgncol,nlev)!< latent heating rate due to melting of snow (W/kg) - real(r8), intent(out) :: frzrdttot(mgncol,nlev) !< latent heating rate due to homogeneous freezing of rain (W/kg) - real(r8), intent(out) :: mnuccdtot(mgncol,nlev) !< mass tendency from ice nucleation + real(r8), intent(out) :: pratot(mgncol,nlev) ! accretion of cloud by rain + real(r8), intent(out) :: prctot(mgncol,nlev) ! autoconversion of cloud to rain + real(r8), intent(out) :: mnuccctot(mgncol,nlev) ! mixing ratio tend due to immersion freezing + real(r8), intent(out) :: mnuccttot(mgncol,nlev) ! mixing ratio tend due to contact freezing + real(r8), intent(out) :: msacwitot(mgncol,nlev) ! mixing ratio tend due to H-M splintering + real(r8), intent(out) :: psacwstot(mgncol,nlev) ! collection of cloud water by snow + real(r8), intent(out) :: bergstot(mgncol,nlev) ! bergeron process on snow + real(r8), intent(out) :: bergtot(mgncol,nlev) ! bergeron process on cloud ice + real(r8), intent(out) :: melttot(mgncol,nlev) ! melting of cloud ice + real(r8), intent(out) :: homotot(mgncol,nlev) ! homogeneous freezing cloud water + real(r8), intent(out) :: qcrestot(mgncol,nlev) ! residual cloud condensation due to removal of excess supersat + real(r8), intent(out) :: prcitot(mgncol,nlev) ! autoconversion of cloud ice to snow + real(r8), intent(out) :: praitot(mgncol,nlev) ! accretion of cloud ice by snow + real(r8), intent(out) :: qirestot(mgncol,nlev) ! residual ice deposition due to removal of excess supersat + real(r8), intent(out) :: mnuccrtot(mgncol,nlev) ! mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s) + real(r8), intent(out) :: mnuccritot(mgncol,nlev)! mixing ratio tendency due to heterogeneous freezing of rain to ice (1/s) + real(r8), intent(out) :: pracstot(mgncol,nlev) ! mixing ratio tendency due to accretion of rain by snow (1/s) + real(r8), intent(out) :: meltsdttot(mgncol,nlev)! latent heating rate due to melting of snow (W/kg) + real(r8), intent(out) :: frzrdttot(mgncol,nlev) ! latent heating rate due to homogeneous freezing of rain (W/kg) + real(r8), intent(out) :: mnuccdtot(mgncol,nlev) ! mass tendency from ice nucleation !++ag Hail/Graupel Tendencies - real(r8), intent(out) :: pracgtot(mgncol,nlev) !< change in q collection rain by graupel (precipf) - real(r8), intent(out) :: psacwgtot(mgncol,nlev) !< change in q collection droplets by graupel (lcldm) - real(r8), intent(out) :: pgsacwtot(mgncol,nlev) !< conversion q to graupel due to collection droplets by snow (lcldm) - real(r8), intent(out) :: pgracstot(mgncol,nlev) !< conversion q to graupel due to collection rain by snow (precipf) - real(r8), intent(out) :: prdgtot(mgncol,nlev) !< dep of graupel (precipf) -! real(r8), intent(out) :: eprdgtot(mgncol,nlev) !< sub of graupel (precipf) - real(r8), intent(out) :: qmultgtot(mgncol,nlev) !< change q due to ice mult droplets/graupel (lcldm) - real(r8), intent(out) :: qmultrgtot(mgncol,nlev)!< change q due to ice mult rain/graupel (precipf) - real(r8), intent(out) :: psacrtot(mgncol,nlev) !< conversion due to coll of snow by rain (precipf) - real(r8), intent(out) :: npracgtot(mgncol,nlev) !< change n collection rain by graupel (precipf) - real(r8), intent(out) :: nscngtot(mgncol,nlev) !< change n conversion to graupel due to collection droplets by snow (lcldm) - real(r8), intent(out) :: ngracstot(mgncol,nlev) !< change n conversion to graupel due to collection rain by snow (precipf) - real(r8), intent(out) :: nmultgtot(mgncol,nlev) !< ice mult due to acc droplets by graupel (lcldm) - real(r8), intent(out) :: nmultrgtot(mgncol,nlev)!< ice mult due to acc rain by graupel (precipf) - real(r8), intent(out) :: npsacwgtot(mgncol,nlev)!< change n collection droplets by graupel (lcldm?) + real(r8), intent(out) :: pracgtot(mgncol,nlev) ! change in q collection rain by graupel (precipf) + real(r8), intent(out) :: psacwgtot(mgncol,nlev) ! change in q collection droplets by graupel (lcldm) + real(r8), intent(out) :: pgsacwtot(mgncol,nlev) ! conversion q to graupel due to collection droplets by snow (lcldm) + real(r8), intent(out) :: pgracstot(mgncol,nlev) ! conversion q to graupel due to collection rain by snow (precipf) + real(r8), intent(out) :: prdgtot(mgncol,nlev) ! dep of graupel (precipf) +! real(r8), intent(out) :: eprdgtot(mgncol,nlev) ! sub of graupel (precipf) + real(r8), intent(out) :: qmultgtot(mgncol,nlev) ! change q due to ice mult droplets/graupel (lcldm) + real(r8), intent(out) :: qmultrgtot(mgncol,nlev)! change q due to ice mult rain/graupel (precipf) + real(r8), intent(out) :: psacrtot(mgncol,nlev) ! conversion due to coll of snow by rain (precipf) + real(r8), intent(out) :: npracgtot(mgncol,nlev) ! change n collection rain by graupel (precipf) + real(r8), intent(out) :: nscngtot(mgncol,nlev) ! change n conversion to graupel due to collection droplets by snow (lcldm) + real(r8), intent(out) :: ngracstot(mgncol,nlev) ! change n conversion to graupel due to collection rain by snow (precipf) + real(r8), intent(out) :: nmultgtot(mgncol,nlev) ! ice mult due to acc droplets by graupel (lcldm) + real(r8), intent(out) :: nmultrgtot(mgncol,nlev)! ice mult due to acc rain by graupel (precipf) + real(r8), intent(out) :: npsacwgtot(mgncol,nlev)! change n collection droplets by graupel (lcldm?) !--ag - real(r8), intent(out) :: nrout(mgncol,nlev) !< rain number concentration (1/m3) - real(r8), intent(out) :: nsout(mgncol,nlev) !< snow number concentration (1/m3) - real(r8), intent(out) :: refl(mgncol,nlev) !< analytic radar reflectivity - real(r8), intent(out) :: arefl(mgncol,nlev) !< average reflectivity will zero points outside valid range - real(r8), intent(out) :: areflz(mgncol,nlev) !< average reflectivity in z. - real(r8), intent(out) :: frefl(mgncol,nlev) !< fractional occurrence of radar reflectivity - real(r8), intent(out) :: csrfl(mgncol,nlev) !< cloudsat reflectivity - real(r8), intent(out) :: acsrfl(mgncol,nlev) !< cloudsat average - real(r8), intent(out) :: fcsrfl(mgncol,nlev) !< cloudsat fractional occurrence of radar reflectivity - real(r8), intent(out) :: rercld(mgncol,nlev) !< effective radius calculation for rain + cloud - real(r8), intent(out) :: ncai(mgncol,nlev) !< output number conc of ice nuclei available (1/m3) - real(r8), intent(out) :: ncal(mgncol,nlev) !< output number conc of CCN (1/m3) - real(r8), intent(out) :: qrout2(mgncol,nlev) !< copy of qrout as used to compute drout2 - real(r8), intent(out) :: qsout2(mgncol,nlev) !< copy of qsout as used to compute dsout2 - real(r8), intent(out) :: nrout2(mgncol,nlev) !< copy of nrout as used to compute drout2 - real(r8), intent(out) :: nsout2(mgncol,nlev) !< copy of nsout as used to compute dsout2 - real(r8), intent(out) :: drout2(mgncol,nlev) !< mean rain particle diameter (m) - real(r8), intent(out) :: dsout2(mgncol,nlev) !< mean snow particle diameter (m) - real(r8), intent(out) :: freqs(mgncol,nlev) !< fractional occurrence of snow - real(r8), intent(out) :: freqr(mgncol,nlev) !< fractional occurrence of rain - real(r8), intent(out) :: nfice(mgncol,nlev) !< fractional occurrence of ice - real(r8), intent(out) :: qcrat(mgncol,nlev) !< limiter for qc process rates (1=no limit --> 0. no qc) + real(r8), intent(out) :: nrout(mgncol,nlev) ! rain number concentration (1/m3) + real(r8), intent(out) :: nsout(mgncol,nlev) ! snow number concentration (1/m3) + real(r8), intent(out) :: refl(mgncol,nlev) ! analytic radar reflectivity + real(r8), intent(out) :: arefl(mgncol,nlev) ! average reflectivity will zero points outside valid range + real(r8), intent(out) :: areflz(mgncol,nlev) ! average reflectivity in z. + real(r8), intent(out) :: frefl(mgncol,nlev) ! fractional occurrence of radar reflectivity + real(r8), intent(out) :: csrfl(mgncol,nlev) ! cloudsat reflectivity + real(r8), intent(out) :: acsrfl(mgncol,nlev) ! cloudsat average + real(r8), intent(out) :: fcsrfl(mgncol,nlev) ! cloudsat fractional occurrence of radar reflectivity + real(r8), intent(out) :: rercld(mgncol,nlev) ! effective radius calculation for rain + cloud + real(r8), intent(out) :: ncai(mgncol,nlev) ! output number conc of ice nuclei available (1/m3) + real(r8), intent(out) :: ncal(mgncol,nlev) ! output number conc of CCN (1/m3) + real(r8), intent(out) :: qrout2(mgncol,nlev) ! copy of qrout as used to compute drout2 + real(r8), intent(out) :: qsout2(mgncol,nlev) ! copy of qsout as used to compute dsout2 + real(r8), intent(out) :: nrout2(mgncol,nlev) ! copy of nrout as used to compute drout2 + real(r8), intent(out) :: nsout2(mgncol,nlev) ! copy of nsout as used to compute dsout2 + real(r8), intent(out) :: drout2(mgncol,nlev) ! mean rain particle diameter (m) + real(r8), intent(out) :: dsout2(mgncol,nlev) ! mean snow particle diameter (m) + real(r8), intent(out) :: freqs(mgncol,nlev) ! fractional occurrence of snow + real(r8), intent(out) :: freqr(mgncol,nlev) ! fractional occurrence of rain + real(r8), intent(out) :: nfice(mgncol,nlev) ! fractional occurrence of ice + real(r8), intent(out) :: qcrat(mgncol,nlev) ! limiter for qc process rates (1=no limit --> 0. no qc) !++ag - real(r8), intent(out) :: qgout(mgncol,nlev) !< graupel/hail mixing ratio (kg/kg) - real(r8), intent(out) :: dgout(mgncol,nlev) !< graupel/hail diameter (m) - real(r8), intent(out) :: ngout(mgncol,nlev) !< graupel/hail number concentration (1/m3) + real(r8), intent(out) :: qgout(mgncol,nlev) ! graupel/hail mixing ratio (kg/kg) + real(r8), intent(out) :: dgout(mgncol,nlev) ! graupel/hail diameter (m) + real(r8), intent(out) :: ngout(mgncol,nlev) ! graupel/hail number concentration (1/m3) !Not sure if these are needed since graupel/hail is prognostic? - real(r8), intent(out) :: qgout2(mgncol,nlev) !< copy of qgout as used to compute dgout2 - real(r8), intent(out) :: ngout2(mgncol,nlev) !< copy of ngout as used to compute dgout2 - real(r8), intent(out) :: dgout2(mgncol,nlev) !< mean graupel/hail particle diameter (m) - real(r8), intent(out) :: freqg(mgncol,nlev) !< fractional occurrence of graupel + real(r8), intent(out) :: qgout2(mgncol,nlev) ! copy of qgout as used to compute dgout2 + real(r8), intent(out) :: ngout2(mgncol,nlev) ! copy of ngout as used to compute dgout2 + real(r8), intent(out) :: dgout2(mgncol,nlev) ! mean graupel/hail particle diameter (m) + real(r8), intent(out) :: freqg(mgncol,nlev) ! fractional occurrence of graupel !--ag @@ -767,38 +756,38 @@ subroutine micro_mg_tend ( & ! Used with CARMA cirrus microphysics ! (or similar external microphysics model) - ! real(r8), intent(in) :: tnd_qsnow(:,:) !< snow mass tendency (kg/kg/s) - ! real(r8), intent(in) :: tnd_nsnow(:,:) !< snow number tendency (#/kg/s) - ! real(r8), intent(in) :: re_ice(:,:) !< ice effective radius (m) + ! real(r8), intent(in) :: tnd_qsnow(:,:) ! snow mass tendency (kg/kg/s) + ! real(r8), intent(in) :: tnd_nsnow(:,:) ! snow number tendency (#/kg/s) + ! real(r8), intent(in) :: re_ice(:,:) ! ice effective radius (m) ! From external ice nucleation. - !real(r8), intent(in) :: frzimm(:,:) !< Number tendency due to immersion freezing (1/cm3) - !real(r8), intent(in) :: frzcnt(:,:) !< Number tendency due to contact freezing (1/cm3) - !real(r8), intent(in) :: frzdep(:,:) !< Number tendency due to deposition nucleation (1/cm3) + !real(r8), intent(in) :: frzimm(:,:) ! Number tendency due to immersion freezing (1/cm3) + !real(r8), intent(in) :: frzcnt(:,:) ! Number tendency due to contact freezing (1/cm3) + !real(r8), intent(in) :: frzdep(:,:) ! Number tendency due to deposition nucleation (1/cm3) ! local workspace ! all units mks unless otherwise stated ! local copies of input variables - real(r8) :: qc(mgncol,nlev) !< cloud liquid mixing ratio (kg/kg) - real(r8) :: qi(mgncol,nlev) !< cloud ice mixing ratio (kg/kg) - real(r8) :: nc(mgncol,nlev) !< cloud liquid number concentration (1/kg) - real(r8) :: ni(mgncol,nlev) !< cloud liquid number concentration (1/kg) - real(r8) :: qr(mgncol,nlev) !< rain mixing ratio (kg/kg) - real(r8) :: qs(mgncol,nlev) !< snow mixing ratio (kg/kg) - real(r8) :: nr(mgncol,nlev) !< rain number concentration (1/kg) - real(r8) :: ns(mgncol,nlev) !< snow number concentration (1/kg) + real(r8) :: qc(mgncol,nlev) ! cloud liquid mixing ratio (kg/kg) + real(r8) :: qi(mgncol,nlev) ! cloud ice mixing ratio (kg/kg) + real(r8) :: nc(mgncol,nlev) ! cloud liquid number concentration (1/kg) + real(r8) :: ni(mgncol,nlev) ! cloud liquid number concentration (1/kg) + real(r8) :: qr(mgncol,nlev) ! rain mixing ratio (kg/kg) + real(r8) :: qs(mgncol,nlev) ! snow mixing ratio (kg/kg) + real(r8) :: nr(mgncol,nlev) ! rain number concentration (1/kg) + real(r8) :: ns(mgncol,nlev) ! snow number concentration (1/kg) !++ag - real(r8) :: qg(mgncol,nlev) !< graupel mixing ratio (kg/kg) - real(r8) :: ng(mgncol,nlev) !< graupel number concentration (1/kg) -! real(r8) :: rhogtmp !< hail or graupel density (kg m-3) + real(r8) :: qg(mgncol,nlev) ! graupel mixing ratio (kg/kg) + real(r8) :: ng(mgncol,nlev) ! graupel number concentration (1/kg) +! real(r8) :: rhogtmp ! hail or graupel density (kg m-3) !--ag ! general purpose variables - real(r8) :: deltat !< sub-time step (s) - real(r8) :: oneodt !< one / deltat - real(r8) :: mtime !< the assumed ice nucleation timescale + real(r8) :: deltat ! sub-time step (s) + real(r8) :: oneodt ! one / deltat + real(r8) :: mtime ! the assumed ice nucleation timescale ! physical properties of the air at a given point real(r8) :: rho(mgncol,nlev) ! density (kg m-3) @@ -1092,14 +1081,14 @@ subroutine micro_mg_tend ( & ! Process inputs - !> - Assign variable deltat to deltatin + ! assign variable deltat to deltatin deltat = deltatin oneodt = one / deltat ! nstep_def = max(1, nint(deltat/20)) nstep_def = max(1, nint(deltat/5)) ! tsfac = log(ts_au/ts_au_min) * qiinv - !> - Copies of input concentrations that may be changed internally. + ! Copies of input concentrations that may be changed internally. do k=1,nlev do i=1,mgncol qc(i,k) = qcn(i,k) @@ -1119,7 +1108,7 @@ subroutine micro_mg_tend ( & ! cldn: used to set cldm, unused for subcolumns ! liqcldf: used to set lcldm, unused for subcolumns ! icecldf: used to set icldm, unused for subcolumns -!> - Calculation liquid/ice cloud fraction + if (microp_uniform) then ! subcolumns, set cloud fraction variables to one ! if cloud water or ice is present, if not present @@ -1165,7 +1154,7 @@ subroutine micro_mg_tend ( & ! if (lprnt) write(0,*)' icldm=',icldm(1,nlev-20:nlev) ! if (lprnt) write(0,*)' qsfm=',qsfm(1,nlev-20:nlev) - !> - Initialize local variables + ! Initialize local variables ! local physical properties @@ -1236,7 +1225,7 @@ subroutine micro_mg_tend ( & ! set mtime here to avoid answer-changing mtime = deltat - !> - initialize microphysics output + ! initialize microphysics output do k=1,nlev do i=1,mgncol qcsevap(i,k) = zero @@ -1320,7 +1309,7 @@ subroutine micro_mg_tend ( & gflx(i,k+1) = zero !--ag - !> - initialize precip output + ! initialize precip output qrout(i,k) = zero qsout(i,k) = zero @@ -1335,12 +1324,12 @@ subroutine micro_mg_tend ( & ! for refl calc rainrt(i,k) = zero - !> - initialize rain size + ! initialize rain size rercld(i,k) = zero qcsinksum_rate1ord(i,k) = zero - !> - initialize variables for trop_mozart + ! initialize variables for trop_mozart nevapr(i,k) = zero prer_evap(i,k) = zero evapsnow(i,k) = zero @@ -1353,7 +1342,7 @@ subroutine micro_mg_tend ( & lamc(i,k) = zero - !> - initialize microphysical tendencies + ! initialize microphysical tendencies tlat(i,k) = zero qvlat(i,k) = zero @@ -1370,7 +1359,7 @@ subroutine micro_mg_tend ( & ngtend(i,k) = zero !--ag - !> - initialize in-cloud and in-precip quantities to zero + ! initialize in-cloud and in-precip quantities to zero qcic(i,k) = zero qiic(i,k) = zero qsic(i,k) = zero @@ -1387,7 +1376,7 @@ subroutine micro_mg_tend ( & !++ag ngic(i,k) = zero !--ag - !> - initialize precip fallspeeds to zero + ! initialize precip fallspeeds to zero ums(i,k) = zero uns(i,k) = zero umr(i,k) = zero @@ -1397,7 +1386,7 @@ subroutine micro_mg_tend ( & ung(i,k) = zero !--ag - !> - initialize limiter for output + ! initialize limiter for output qcrat(i,k) = one ! Many outputs have to be initialized here at the top to work around @@ -1451,7 +1440,7 @@ subroutine micro_mg_tend ( & npccn(i,k) = zero enddo enddo -!> - initialize ccn activated number tendency (\p npccn) +! if (iccn) then do k=1,nlev do i=1,mgncol @@ -1466,7 +1455,7 @@ subroutine micro_mg_tend ( & enddo endif - !> - initialize precip at surface + ! initialize precip at surface do i=1,mgncol prect(i) = zero @@ -1612,7 +1601,7 @@ subroutine micro_mg_tend ( & tlat(i,k) = tlat(i,k) + dum1 meltsdttot(i,k) = meltsdttot(i,k) + dum1 -! if (lprnt .and. k >=100) write(0,*)' tlats=',tlat(i,k),' dum1=',dum1,& +! if (lprnt .and. k >=40) write(0,*)' tlats=',tlat(i,k),' dum1=',dum1,& ! ' minstsm=',minstsm(i,k),' qs=',qs(i,k),' xlf=',xlf,' oneodt=',oneodt, & ! ' snowmelt=',snowmelt,' t=',t(i,k),' dum=',dum,' k=',k @@ -1654,7 +1643,7 @@ subroutine micro_mg_tend ( & tlat(i,k) = dum1 + tlat(i,k) meltsdttot(i,k) = dum1 + meltsdttot(i,k) -! if (lprnt .and. k >=100) write(0,*)' tlatg=',tlat(i,k),' dum1=',dum1,& +! if (lprnt .and. k >=40) write(0,*)' tlatg=',tlat(i,k),' dum1=',dum1,& ! ' minstgm=',minstgm(i,k),' qg=',qg(i,k),' xlf=',xlf,' oneodt=',oneodt, & ! ' snowmelt=',snowmelt,' t=',t(i,k),' k=',k,' cpp=',cpp @@ -2182,6 +2171,10 @@ subroutine micro_mg_tend ( & call bergeron_process_snow(t(:,k), rho(:,k), dv(:,k), mu(:,k), sc(:,k), & qvl(:,k), qvi(:,k), asn(:,k), qcic(:,k), qsic(:,k), lams(:,k), n0s(:,k), & bergs(:,k), mgncol) +! if(lprnt) write(0,*)' bergs1=',bergs(1,k),' k=',k,' micro_mg_berg_eff_factor=',micro_mg_berg_eff_factor +! if(lprnt) write(0,*)' t=',t(1,k),' rho=',rho(1,k),' dv=',dv(1,k),' mu=',mu(1,k),& +! 'qcic=',qcic(1,k),' qsic=',qsic(1,k),' qvl=',qvl(1,k),' qvi=',qvi(1,k), & +! ' mu=',mu(1,k),' sc=',sc(1,k),' asn=',asn(1,k),' lams=',lams(1,k),' n0s=',n0s(1,k),' ni=',ni(1,k) bergs(:,k) = bergs(:,k) * micro_mg_berg_eff_factor @@ -2192,6 +2185,11 @@ subroutine micro_mg_tend ( & icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) +! if(lprnt) write(0,*)' t=',t(1,k),' k=',k,' q=',q(1,k),' qi=',qi(1,k),& +! ' ni=',ni(1,k),' icldm=',icldm(1,k),' rho=',rho(1,k),' dv=',dv(1,k),& +! ' qvl=',qvl(1,k),' qvi=',qvi(1,k),' berg=',berg(1,k),' vap_dep=',& +! vap_dep(1,k),' ice_sublim=',ice_sublim(1,k) +! if(lprnt) write(0,*)' berg1=',berg(1,k),' k=',k,' micro_mg_berg_eff_factor=',micro_mg_berg_eff_factor do i=1,mgncol ! sublimation should not exceed available ice ice_sublim(i,k) = max(ice_sublim(i,k), -qi(i,k)*oneodt) @@ -2367,6 +2365,8 @@ subroutine micro_mg_tend ( & qcrat(i,k) = one end if +! if(lprnt) write(0,*)' bergs2=',bergs(1,k),' k=',k,' ratio=',ratio + !PMC 12/3/12: ratio is also frac of step w/ liquid. !thus we apply berg for "ratio" of timestep and vapor !deposition for the remaining frac of the timestep. @@ -2437,13 +2437,11 @@ subroutine micro_mg_tend ( & if (do_cldice) then ! freezing of rain to produce ice if mean rain size is smaller than Dcs - if (lamr(i,k) > qsmall) then - if(one/lamr(i,k) < Dcs) then - mnuccri(i,k) = mnuccr(i,k) - nnuccri(i,k) = nnuccr(i,k) - mnuccr(i,k) = zero - nnuccr(i,k) = zero - end if + if (lamr(i,k) > qsmall .and. one/lamr(i,k) < Dcs) then + mnuccri(i,k) = mnuccr(i,k) + nnuccri(i,k) = nnuccr(i,k) + mnuccr(i,k) = zero + nnuccr(i,k) = zero end if end if @@ -2840,11 +2838,11 @@ subroutine micro_mg_tend ( & ! if (lprnt) write(0,*)' k=',k,' tlat=',tlat(i,k) ! if (lprnt .and. k >= 60) write(0,*)' k=',k,' tlat=',tlat(i,k) -! qctend(i,k) = qctend(i,k) + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & -! psacws(i,k)-bergs(i,k))*l!ldm(i,k)-berg(i,k) +! qctend(i,k) = qctend(i,k) + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & +! psacws(i,k)-bergs(i,k))*lcldm(i,k)-berg(i,k) - qctend(i,k) = qctend(i,k)+ & - (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & + qctend(i,k) = qctend(i,k) + & + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k) - & psacws(i,k)-bergs(i,k)-qmultg(i,k)-psacwg(i,k)-pgsacw(i,k))*lcldm(i,k)-berg(i,k) if (do_cldice) then @@ -3682,7 +3680,7 @@ subroutine micro_mg_tend ( & end do !! nstep loop ! if (lprnt) write(0,*)' prectaftssno=',prect(i),' preci=',preci(i) -! if (lprnt) write(0,*)' qgtnd1=',qgtend(1,:) +! if (lprnt) write(0,*)' qgtnd1=',qgtend(1,:) if (do_graupel .or. do_hail) then !++ag Graupel Sedimentation @@ -4459,16 +4457,13 @@ subroutine micro_mg_tend ( & enddo end subroutine micro_mg_tend -!> @} !======================================================================== !OUTPUT CALCULATIONS !======================================================================== -!>\ingroup mg3_mp -!! This subroutine calculates effective radius for rain and cloud. subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol,nlev) - integer, intent(in) :: mgncol, nlev ! horizontal and vertical dimension + integer, intent(in) :: mgncol, nlev real(r8), dimension(mgncol,nlev), intent(in) :: lamr ! rain size parameter (slope) real(r8), dimension(mgncol,nlev), intent(in) :: n0r ! rain size parameter (intercept) real(r8), dimension(mgncol,nlev), intent(in) :: lamc ! size distribution parameter (slope) @@ -4509,4 +4504,3 @@ end subroutine calc_rercld !======================================================================== end module micro_mg3_0 -!>@} diff --git a/physics/micro_mg_utils.F90 b/physics/micro_mg_utils.F90 index 51178813c..89dd7193e 100644 --- a/physics/micro_mg_utils.F90 +++ b/physics/micro_mg_utils.F90 @@ -839,7 +839,7 @@ end function var_coef_integer !! Initial ice deposition and sublimation loop. !! Run before the main loop !! This subroutine written by Peter Caldwell -subroutine ice_deposition_sublimation(t, qv, qi, ni, & +subroutine ice_deposition_sublimation(t, qv, qi, ni, & icldm, rho, dv,qvl, qvi, & berg, vap_dep, ice_sublim, mgncol) diff --git a/physics/moninshoc.f b/physics/moninshoc.f index 4ab08e47e..560d6bbfe 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -119,17 +119,20 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! if (ix < im) stop ! - if (lprnt) write(0,*)' in moninshoc tsea=',tsea(ipr) - &, ' grav=',grav, rd, cp, hvap, fv,' ipr=',ipr - &,' ntke=',ntke,' ntcw=',ntcw - if (lprnt) write(0,*)' in moninshoc tin=',t1(ipr,:) - if (lprnt) write(0,*)' in moninshoc qin=',q1(ipr,:,1) - if (lprnt) write(0,*)' in moninshoc qwin=',q1(ipr,:,2) - if (lprnt) write(0,*)' in moninshoc qiin=',q1(ipr,:,3) +! if (lprnt) write(0,*)' in moninshoc tsea=',tsea(ipr) +! &, ' grav=',grav, rd, cp, hvap, fv,' ipr=',ipr +! &,' ntke=',ntke,' ntcw=',ntcw +! if (lprnt) write(0,*)' in moninshoc tin=',t1(ipr,:) +! if (lprnt) write(0,*)' in moninshoc qin=',q1(ipr,:,1) +! if (lprnt) write(0,*)' in moninshoc qwin=',q1(ipr,:,2) +! if (lprnt) write(0,*)' in moninshoc qiin=',q1(ipr,:,3) + dt2 = delt rdt = 1. / dt2 km1 = km - 1 kmpbl = km / 2 +! + rtg = 0.0 ! do k=1,km do i=1,im @@ -167,6 +170,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, endif enddo enddo + ! if (lprnt) then ! write(0,*)' tx1=',tx1(ipr),' kinver=',kinver(ipr) ! write(0,*)' xkzo=',xkzo(ipr,:) @@ -376,6 +380,9 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, dkt(i,k) = max(min(tkh(i,kp1)+xkzo(i,k), dkmax), xkzo(i,k)) enddo enddo + +! if (lprnt) write(0,*)' tkh=',tkh(ipr,:) +! if (lprnt) write(0,*)' dkt=',dkt(ipr,:) ! ! compute tridiagonal matrix elements for heat and moisture ! diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 8ba7591c3..7ae82acca 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -73,7 +73,7 @@ module rascnv ! real(kind=kind_phys), parameter :: TF=230.16, TCR=260.16 & ! real(kind=kind_phys), parameter :: TF=233.16, TCR=263.16 & real(kind=kind_phys), parameter :: TF=233.16, TCR=273.16 & - &, TCRF=1.0/(TCR-TF),TCL=2.0 + &, TCRF=1.0/(TCR-TF), TCL=2.0 ! ! For pressure gradient force in momentum mixing @@ -305,7 +305,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! Implicit none ! - LOGICAL FLIPV, lprnt,revap + LOGICAL FLIPV, lprnt ! ! input ! @@ -364,7 +364,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, rainp ! integer :: nrcmax ! Maximum # of random clouds per 1200s ! - Integer KCR, KFX, NCMX, NC, KTEM, I, ii, L, lm1 & + Integer KCR, KFX, NCMX, NC, KTEM, I, ii, Lm1, l & &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & &, kblmn, ksfc, ncrnd @@ -385,8 +385,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & endif trcmin = -99999.0 if (ntk-2 > 0) trcmin(ntk-2) = 1.0d-4 -! nrcmax = nrcm -! nrcmax = 32 !> - Initialize CCPP error handling variables @@ -461,6 +459,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & DO IPT=1,IM lprint = lprnt .and. ipt == ipr + ia = ipr tem1 = max(zero, min(one, (log(area(ipt)) - dxmin) * dxinv)) tem2 = one - tem1 @@ -471,6 +470,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & c0 = (prauras(1)*tem1 + prauras(2)*tem2) * tem if (ccwfac == zero) ccwfac = half +! if (lprint) write(0,*)' c0=',c0,' c0i=',c0i,' dlq_fac=',dlq_fac, & +! & ' ccwf=',ccwf + ! ! ctei = .false. ! if (ctei_r(ipt) > ctei_rm) ctei = .true. @@ -528,7 +530,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & KTEM = MIN(K,KFMAX) KFX = KTEM - KCR -! if(lprint)write(0,*)' enter RASCNV k=',k,' ktem=',ktem & +! if(lprint)write(0,*)' enter RASCNV k=',k,' ktem=',ktem & ! &, ' krmax=',krmax,' kfmax=',kfmax & ! &, ' krmin=',krmin,' ncrnd=',ncrnd & ! &, ' kcr=',kcr, ' cdrag=',cdrag(ipr) @@ -553,8 +555,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & IC(KFX+I) = IRND + KRMIN ENDDO ENDIF -! - ia = ipr ! ! if (me == 0) write(0,*)' in rascnv: k=',k,' lprnt=',lprnt ! if (lprint) then @@ -1199,7 +1199,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & DDVEL(ipt) = DDVEL(ipt) * DDFAC * GRAV / (prs(KP1)-prs(K)) -! if (lprint) write(0,*)' ddvel=',ddvel(ipt) +! if (lprint) write(0,*)' ddvel=',ddvel(ipt),' ddfac=',ddfac ! ENDDO ! End of the IPT Loop! @@ -2685,7 +2685,7 @@ SUBROUTINE CLOUD( & ! ! if(lprnt) write(0,*)' wfn=',wfn,' acr=',acr,' akm=',akm & ! &,' amb=',amb,' KD=',kd,' cldfrd=',cldfrd & -! &,' rel_fac=',rel_fac,' prskd=',prs(kd) +! &,' rel_fac=',rel_fac,' prskd=',prs(kd),' revap=',revap !===> RELAXATION AND CLIPPING FACTORS ! @@ -2858,6 +2858,7 @@ SUBROUTINE CLOUD( & TX1 = zero TX2 = zero ! +! if (lprnt) write(0,*)' revap=',revap IF (REVAP) THEN ! REEVAPORATION OF FALLING CONVECTIVE RAIN ! tem = zero @@ -2875,7 +2876,8 @@ SUBROUTINE CLOUD( & !! tem1 = sqrt(max(1.0, min(100.0,(4.0E10/max(area,one))))) ! 20100902 tem1 = sqrt(max(one, min(100.0,(6.25E10/max(area,one))))) ! 20110530 -! if (lprnt) write(0,*)' clfr0=',clf(tem),' tem=',tem,' tem1=',tem1 +! if (lprnt) write(0,*)' clfr0=',clf(tem),' tem=',tem,' tem1=', & +! & tem1 ! clfrac = max(ZERO, min(ONE, rknob*clf(tem)*tem1)) ! clfrac = max(ZERO, min(0.25, rknob*clf(tem)*tem1)) @@ -2972,9 +2974,9 @@ SUBROUTINE CLOUD( & CUP = CUP + TX1 + DOF * AMB * sigf(kbl) ENDIF -! if (lprnt) write(0,*)' tx1=',tx1,' tx2=',tx2,' dof=',dof -! &,' cup=',cup*86400/dt,' amb=',amb -! &,' amb=',amb,' cup=',cup,' clfrac=',clfrac,' cldfrd=',cldfrd +! if (lprnt) write(0,*)' tx1=',tx1,' tx2=',tx2,' dof=',dof & +! &,' cup=',cup*86400/dt,' amb=',amb & +! &,' amb=',amb,' cup=',cup,' clfrac=',clfrac,' cldfrd=',cldfrd & ! &,' ddft=',ddft,' kd=',kd,' kbl=',kbl,' k=',k ! ! Convective transport (mixing) of passive tracers From 647a9cf5e91764fc2adb3bcbf4f3f33e54233f7a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 30 Dec 2019 17:48:46 +0000 Subject: [PATCH 13/24] updtes to GFS_suite_interstitial.F90 , gcm_shoc.F90, m_micro.F90 with correcponding changes in ipd --- physics/GFS_suite_interstitial.F90 | 4 ++-- physics/gcm_shoc.F90 | 12 ++++++------ physics/m_micro.F90 | 11 ++++++----- 3 files changed, 14 insertions(+), 13 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 317d7cfa5..34a09f790 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -570,7 +570,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & - n /= ntlnc .and. n /= ntinc .and. & +! n /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then tracers = tracers + 1 do k=1,levs @@ -743,7 +743,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt) then if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & - n /= ntlnc .and. n /= ntinc .and. & +! n /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc ) then tracers = tracers + 1 do k=1,levs diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index d6ca01b9d..48d477fde 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -1659,9 +1659,9 @@ subroutine assumed_pdf() ! ' c1=',c1*100,' qs1=',qs1,' qw1_1=',qw1_1,' k=',k IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 -!! ELSEIF (s1 >= qcmin) THEN -!! C1 = one -!! qn1 = s1 + ELSEIF (s1 >= qcmin) THEN + C1 = one + qn1 = s1 ENDIF ! now compute non-precipitating cloud condensate @@ -1694,9 +1694,9 @@ subroutine assumed_pdf() wrk = s2 / (std_s2*sqrt2) C2 = max(zero, min(one, half*(one+erf(wrk)))) IF (C2 > zero) qn2 = s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk) -!! ELSEIF (s2 >= qcmin) THEN -!! C2 = one -!! qn2 = s2 + ELSEIF (s2 >= qcmin) THEN + C2 = one + qn2 = s2 ENDIF ENDIF diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 07f2e46ab..694060acd 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -234,7 +234,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & integer kcldtopcvn,i,k,ll, kbmin, NAUX, nbincontactdust,l integer, dimension(im) :: kct real (kind=kind_phys) T_ICE_ALL, USE_AV_V,BKGTAU,LCCIRRUS, & - & NPRE_FRAC, Nct, Wct, fcn, ksa1, tauxr8, DT_Moist, dt_r8, & + & NPRE_FRAC, Nct, Wct, fcn, ksa1, tauxr8, DT_Moist, dt_r8, tem, & & TMAXLL, USURF,LTS_UP, LTS_LOW, MIN_EXP, fracover, c2_gw, est3 real(kind=kind_phys), allocatable, dimension(:,:) :: & @@ -546,12 +546,12 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & QICN(I,K), CLCN(I,K), NCPL(I,K), & & NCPI(I,K), qc_min) if (rnw(i,k) <= qc_min(1)) then - ncpl(i,k) = 0.0 - elseif (ncpl(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpl(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + ncpr(i,k) = 0.0 + elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) endif if (snw(i,k) <= qc_min(2)) then - ncpl(i,k) = 0.0 + ncps(i,k) = 0.0 elseif (ncps(i,k) <= nmin) then ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) endif @@ -564,6 +564,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & enddo enddo endif + do i=1,im KCBL(i) = max(LM-KCBL(i),10) KCT(i) = 10 From 06aeee65e2f084acba2340a1245f1722df26eaf4 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Jan 2020 19:12:59 +0000 Subject: [PATCH 14/24] after updating the code based on climbfuji comments from CCPP --- physics/GFS_DCNV_generic.F90 | 12 +- physics/GFS_DCNV_generic.meta | 32 -- physics/GFS_MP_generic.F90 | 20 +- physics/GFS_MP_generic.meta | 32 -- physics/GFS_PBL_generic.F90 | 39 +- physics/GFS_PBL_generic.meta | 82 ---- physics/GFS_SCNV_generic.F90 | 6 +- physics/GFS_SCNV_generic.meta | 16 - physics/GFS_suite_interstitial.F90 | 59 +-- physics/GFS_suite_interstitial.meta | 40 -- physics/GFS_surface_composites.F90 | 4 - physics/gcm_shoc.F90 | 107 +---- physics/gcm_shoc.meta | 24 -- physics/m_micro.F90 | 24 +- physics/m_micro.meta | 33 +- physics/micro_mg2_0.F90 | 10 +- physics/micro_mg3_0.F90 | 8 +- physics/moninshoc.f | 26 +- physics/moninshoc.meta | 24 -- physics/rascnv.F90 | 643 +++------------------------- physics/rascnv.meta | 142 +++++- 21 files changed, 254 insertions(+), 1129 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 7bb56d361..d7305cbe5 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -20,14 +20,14 @@ end subroutine GFS_DCNV_generic_pre_finalize subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, cplchm,& isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & save_u, save_v, save_t, save_qv, ca_deep, & - dqdti, lprnt, ipr, errmsg, errflg) + dqdti, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, ipr - logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, cplchm, isppt_deep, lprnt + integer, intent(in) :: im, levs + logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, cplchm, isppt_deep real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0 @@ -107,14 +107,14 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, & rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, & - cape, tconvtend, qconvtend, uconvtend, vconvtend, lprnt, ipr, errmsg, errflg) + cape, tconvtend, qconvtend, uconvtend, vconvtend, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, ipr - logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep, lprnt + integer, intent(in) :: im, levs + logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep real(kind=kind_phys), intent(in) :: frain, dtf real(kind=kind_phys), dimension(im), intent(in) :: rain1, cld1d diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 724db885e..07c75eafc 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -147,22 +147,6 @@ kind = kind_phys intent = inout optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -579,22 +563,6 @@ kind = kind_phys intent = inout optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 20b752b24..f72f9405a 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -16,13 +16,13 @@ end subroutine GFS_MP_generic_pre_init !> \section arg_table_GFS_MP_generic_pre_run Argument Table !! \htmlinclude GFS_MP_generic_pre_run.html !! - subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_q, lprnt, ipr, errmsg, errflg) + subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_q, errmsg, errflg) ! use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, ntcw, nncl, ntrac, ipr - logical, intent(in) :: ldiag3d, do_aw, lprnt + integer, intent(in) :: im, levs, ntcw, nncl, ntrac + logical, intent(in) :: ldiag3d, do_aw real(kind=kind_phys), dimension(im, levs), intent(in) :: gt0 real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 @@ -86,15 +86,15 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp, totprcp, totice, & totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, dt3dt, dq3dt, rain_cpl, rainc_cpl, snow_cpl, pwat, & do_sppt, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & - graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, lprnt, ipr, errmsg, errflg) + graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, errmsg, errflg) ! use machine, only: kind_phys implicit none - integer, intent(in) :: im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, ipr + integer, intent(in) :: im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires - logical, intent(in) :: cal_pre, lssav, ldiag3d, cplflx, cplchm, lprnt + logical, intent(in) :: cal_pre, lssav, ldiag3d, cplflx, cplchm real(kind=kind_phys), intent(in) :: dtf, frain, con_g real(kind=kind_phys), dimension(im), intent(in) :: rainc, rain1, xlat, xlon, tsfc @@ -217,14 +217,6 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt rain, phii, tsfc, & ! input domr, domzr, domip, doms) ! output ! -! if (lprnt) print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ' -! &,DOMR(ipr),DOMZR(ipr),DOMIP(ipr),DOMS(ipr) -! do i=1,im -! if (abs(xlon(i)*57.29578-114.0) .lt. 0.2 .and. -! & abs(xlat(i)*57.29578-40.0) .lt. 0.2) -! & print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ', -! & DOMR(i),DOMZR(i),DOMIP(i),DOMS(i) -! end do ! HCHUANG: use new precipitation type to decide snow flag for LSM snow accumulation if (imp_physics /= imp_physics_gfdl .and. imp_physics /= imp_physics_thompson) then diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 9dbd04abd..ddf8cb813 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -98,22 +98,6 @@ kind = kind_phys intent = inout optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -897,22 +881,6 @@ kind = kind_phys intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 042d509bd..f8bbf247e 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -84,7 +84,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef, trans_aero, ntchs, ntchm, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, cplchm, ltaerosol, & - hybedmf, do_shoc, satmedmf, qgrs, vdftra, xlon, xlat, lprnt, ipt, kdt, me,errmsg, errflg) + hybedmf, do_shoc, satmedmf, qgrs, vdftra, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -99,17 +99,11 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: cplchm, ltaerosol, hybedmf, do_shoc, satmedmf - real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra - logical, intent(inout) :: lprnt - integer, intent(inout) :: ipt - integer, intent(in) :: kdt, me - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: rad2dg = 180.0/3.14159265359 !local variables integer :: i, k, kk, k1, n @@ -118,29 +112,6 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, errmsg = '' errflg = 0 - - lprnt = .false. - ipt = 1 -! do i=1,im -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-97.50) < 0.101 & -! .and. abs(xlat(i)*rad2dg-24.48) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-293.91) < 0.101 & -! .and. abs(xlat(i)*rad2dg+72.02) < 0.101 -! if (kdt == 1) & -! write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & -! ' xlat=',xlat(i)*rad2dg,' me=',me -! if (lprnt) then -! ipt = i -! write(0,*)' GFS_PBL_generic_pre_run ipt=',ipt,'xlon=',xlon(i)*rad2dg,' xlat=',xlat(i)*rad2dg,' me=',me -! exit -! endif -! enddo -! if (lprnt) then -! write(0,*)' qgrsv=',qgrs(ipt,:,1) -! write(0,*)' qgrsi=',qgrs(ipt,:,ntiw) -! write(0,*)' qgrsw=',qgrs(ipt,:,ntcw) -! endif - !DH: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. ) if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then vdftra = qgrs @@ -316,8 +287,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & dq3dt_ozone, rd, cp,fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, fice, dusfc_cice, dvsfc_cice, dtsfc_cice, & - dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, & - lprnt, ipt, kdt, me, errmsg, errflg) + dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -332,11 +302,6 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu - logical, intent(inout) :: lprnt - integer, intent(inout) :: ipt - integer, intent(in) :: kdt, me - - real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac, fice diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 120f98a5f..51764e04d 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -307,56 +307,6 @@ kind = kind_phys intent = inout optional = F -[xlon] - standard_name = longitude - long_name = longitude - units = radians - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[xlat] - standard_name = latitude - long_name = latitude - units = radians - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipt] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1270,38 +1220,6 @@ kind = kind_phys intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipt] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 6db23065c..d8784dc62 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -15,14 +15,14 @@ end subroutine GFS_SCNV_generic_pre_finalize !! \htmlinclude GFS_SCNV_generic_pre_run.html !! subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, gt0, gq0_water_vapor, & - save_t, save_qv, lprnt, ipr, errmsg, errflg) + save_t, save_qv, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, ipr - logical, intent(in) :: ldiag3d, lprnt + integer, intent(in) :: im, levs + logical, intent(in) :: ldiag3d real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, gq0_water_vapor real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t, save_qv diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index e17682609..79f4eab11 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -61,22 +61,6 @@ kind = kind_phys intent = inout optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 8eef89b0b..8abaf24b7 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -468,7 +468,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & imp_physics_gfdl, imp_physics_thompson, & imp_physics_wsm6, imp_physics_fer_hires, prsi, & prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, & - work1, work2, kpbl, kinver, ras, lprnt, ipt, kdt, me, & + work1, work2, kpbl, kinver, ras, me, & clw, rhc, save_qc, save_qi, errmsg, errflg) use machine, only: kind_phys @@ -478,7 +478,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & ! interface variables integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntlnc, ntinc, & ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, kdt, me + imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, me integer, dimension(im), intent(in) :: islmsk, kpbl, kinver logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras @@ -493,8 +493,6 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & ! save_qi is not allocated for Zhao-Carr MP real(kind=kind_phys), dimension(:, :), intent(inout) :: save_qi real(kind=kind_phys), dimension(im, levs, nn), intent(inout) :: clw - logical, intent(inout) :: lprnt - integer, intent(inout) :: ipt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -508,41 +506,12 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & ! turnrhcrit = 0.900, turnrhcrit_upper = 0.150 ! in the following inverse of slope_mg and slope_upmg are specified real(kind=kind_phys),parameter :: slope_mg = 50.0_kind_phys, & - slope_upmg = 25.0_kind_phys, & - rad2dg = 180.0/3.14159265359 + slope_upmg = 25.0_kind_phys ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - lprnt = .false. - ipt = 1 -! do i=1,im -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-97.50) < 0.101 & -! .and. abs(xlat(i)*rad2dg-24.48) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-293.91) < 0.101 & -! .and. abs(xlat(i)*rad2dg+72.02) < 0.101 -! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-308.88) < 0.101 & -! .and. abs(grid%xlat(i)*rad2dg+29.16) < 0.101 -! lprnt = kdt >= 135 .and. abs(xlon(i)*rad2dg-95.27) < 0.101 & -! .and. abs(xlat(i)*rad2dg-26.08) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-311.08) < 0.101 & -! .and. abs(xlat(i)*rad2dg+28.27) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-113.48) < 0.101 & -! .and. abs(xlat(i)*rad2dg-21.07) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.29) < 0.201 & -! .and. abs(xlat(i)*rad2dg-17.45) < 0.201 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-169.453) < 0.501 & -! .and. abs(xlat(i)*rad2dg-72.96) < 0.501 -! if (kdt == 1) & -! write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & -! ' xlat=',xlat(i)*rad2dg,' me=',me -! if (lprnt) then -! ipt = i -! write(0,*)' ipt=',ipt,'xlon=',xlon(i)*rad2dg,' xlat=',xlat(i)*rad2dg,' me=',me -! exit -! endif -! enddo ! !GF* The following section (initializing convective variables) is already executed in GFS_typedefs%interstitial_phys_reset ! do k=1,levs @@ -615,7 +584,6 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & rhc(i,k) = min(rhcmax, max(0.7, 1.0-tx2(i)*tem1*tem2)) enddo enddo -! if (kdt == 1 .and. me == 0) write(0,*)' rhc=',rhc(1,:) else do k=1,levs do i=1,im @@ -676,11 +644,6 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & rhc(:,:) = 1.0 endif ! end if_ntcw -! if (lprnt) write(0,*)' clwice=',clw(ipt,:,1) -! if (lprnt) write(0,*)' clwwat=',clw(ipt,:,2) -! if (lprnt) write(0,*)' rhc=',rhc(ipt,:) -! if (lprnt) write(0,*)' gq01=',gq0(ipt,:,1) - end subroutine GFS_suite_interstitial_3_run end module GFS_suite_interstitial_3 @@ -701,7 +664,7 @@ end subroutine GFS_suite_interstitial_4_finalize subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, & ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, dtf, save_qc, save_qi, con_pi, & - gq0, clw, gt0, dqdti, imfdeepcnv, imfdeepcnv_gf, lprnt, ipr, errmsg, errflg) + gq0, clw, gt0, dqdti, imfdeepcnv, imfdeepcnv_gf, errmsg, errflg) use machine, only: kind_phys @@ -711,9 +674,9 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to integer, intent(in) :: im, levs, tracers_total, ntrac, ntcw, ntiw, ntclamt, ntrw, & ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imfdeepcnv, imfdeepcnv_gf, ipr + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imfdeepcnv, imfdeepcnv_gf - logical, intent(in) :: ltaerosol, cplchm, lprnt + logical, intent(in) :: ltaerosol, cplchm real(kind=kind_phys), intent(in) :: con_pi, dtf real(kind=kind_phys), dimension(im,levs), intent(in) :: save_qc, gt0 @@ -821,16 +784,6 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to enddo endif -! if (lprnt) then -! write(0,*)' aft shallow physics' -! write(0,*)'qt0s=',gt0(ipr,:) -! write(0,*)'qq0s=',gq0(ipr,:,1) -! write(0,*)'qq0ws=',gq0(ipr,:,ntcw) -! write(0,*)'qq0is=',gq0(ipr,:,ntiw) -! write(0,*)'qq0ntic=',gq0(ipr,:,8) -! write(0,*)'qq0os=',gq0(ipr,:,12) -! endif - end subroutine GFS_suite_interstitial_4_run end module GFS_suite_interstitial_4 diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 8a6b84cb9..f8a8109da 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1429,30 +1429,6 @@ type = logical intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipt] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in - optional = F [me] standard_name = mpi_rank long_name = current MPI-rank @@ -1791,22 +1767,6 @@ type = integer intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index a70579b1e..2dd0d423d 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -379,10 +379,6 @@ subroutine GFS_surface_composites_post_run ( gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) + txo*gflx_ocn(i) endif tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_ocn(i) - !tsfc(i) = txl*tsfc_lnd(i) + txi*tsfc_ice(i) + txo*tsfc_ocn(i) - - ! DH* NOTE THIS IS UNNECESSARY BECAUSE DONE BEFORE? Diag%cmm(i) = txl*cmm3(i,1) + txi*cmm3(i,2) + txo*cmm3(i,3) - ! DH* NOTE THIS IS UNNECESSARY BECAUSE DONE BEFORE? Diag%chh(i) = txl*chh3(i,1) + txi*chh3(i,2) + txo*chh3(i,3) zorll(i) = zorl_lnd(i) zorlo(i) = zorl_ocn(i) diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index 48d477fde..b32843bc1 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -24,16 +24,15 @@ end subroutine shoc_finalize !! \htmlinclude shoc_run.html !! #endif -subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & - dtp, me, prsl, delp, phii, phil, u, v, omega, rhc, & - supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & - gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & - cld_sgs, tke, tkh, wthv_sec, lprnt, ipr, errmsg, errflg) +subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, & + con_pi, con_fvirt, dtp, prsl, delp, phii, phil, u, v, omega, rhc, & + supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & + gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & + cld_sgs, tke, tkh, wthv_sec, errmsg, errflg) implicit none - integer, intent(in) :: ix, nx, nzm, me, ipr, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc - logical, intent(in) :: lprnt + integer, intent(in) :: ix, nx, nzm, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc real(kind=kind_phys), intent(in) :: tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & dtp, supice, pcrit, cefac, cesfac, tkef1, dis_opt ! @@ -115,19 +114,13 @@ subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, ! phy_f3d(1,1,ntot3d-1) - shoc determined diffusion coefficients ! phy_f3d(1,1,ntot3d ) - shoc determined w'theta' - !GFDL lat has no meaning inside of shoc - changed to "1" - -! if(lprnt) write(0,*)' befncpi=',ncpi(ipr,:) -! if(lprnt) write(0,*)' tkh=',tkh(ipr,:) - - call shoc_work (ix, nx, nzm, nzm+1, dtp, me, 1, prsl, delp, & - phii, phil, u, v, omega, gt0, gq0(:,:,1), qi, qc, qsnw, qrn, & - rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & - cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, lprnt, ipr, & - ntlnc, ncpl, ncpi, & + call shoc_work (ix, nx, nzm, nzm+1, dtp, prsl, delp, & + phii, phil, u, v, omega, gt0, gq0(:,:,1), qi, qc, qsnw, qrn, & + rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & + cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, & + ntlnc, ncpl, ncpi, & con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt) -! if(lprnt) write(0,*)' aftncpi=',ncpi(ipr,:) if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme do k=1,nzm do i=1,nx @@ -168,25 +161,21 @@ end subroutine shoc_run ! replacing fac_fus by fac_sub ! S.Moorthi - 00-00-17 - added an alternate option for near boundary cek following ! Scipion et. al., from U. Oklahoma. - subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & + subroutine shoc_work (ix, nx, nzm, nz, dtn, & prsl, delp, phii, phil, u, v, omega, tabs, & qwv, qi, qc, qpi, qpl, rhc, supice, & pcrit, cefac, cesfac, tkef1, dis_opt, & cld_sgs, tke, hflx, evap, prnum, tkh, & - wthv_sec, lprnt, ipr, ntlnc, ncpl, ncpi, & + wthv_sec, ntlnc, ncpl, ncpi, & cp, ggr, lcond, lfus, rv, rgas, pi, epsv) use funcphys , only : fpvsl, fpvsi, fpvs ! saturation vapor pressure for water & ice implicit none - logical, intent(in) :: lprnt - integer, intent(in) :: ipr real, intent(in) :: cp, ggr, lcond, lfus, rv, rgas, pi, epsv integer, intent(in) :: ix ! max number of points in the physics window in the x integer, intent(in) :: nx ! Number of points in the physics window in the x - integer, intent(in) :: me ! MPI rank - integer, intent(in) :: lat ! latitude integer, intent(in) :: nzm ! Number of vertical layers integer, intent(in) :: nz ! Number of layer interfaces (= nzm + 1) @@ -404,13 +393,6 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & enddo enddo -! if (lprnt) write(0,*)' tabsin=',tabs(ipr,:) -! if (lprnt) write(0,*)' qcin=',qc(ipr,:) -! if (lprnt) write(0,*)' qwvin=',qwv(ipr,:) -! if (lprnt) write(0,*)' qiin=',qi(ipr,:) -! if (lprnt) write(0,*)' qplin=',qpl(ipr,:) -! if (lprnt) write(0,*)' qpiin=',qpi(ipr,:) -! if (lprnt) write(0,*)' tkein=',tke(ipr,:) ! ! move water from vapor to condensate if the condensate is negative ! @@ -455,9 +437,6 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & enddo enddo -! if (lprnt) write(0,*)' tabsin2=',tabs(ipr,:) -! if (lprnt) write(0,*)' qwvin2=',qwv(ipr,:) - do k=1,nzm do i=1,nx zl(i,k) = phil(i,k) * ggri @@ -485,16 +464,10 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & ! Liquid/ice water static energy - ! Note the the units are degrees K hl(i,k) = tabs(i,k) + gamaz(i,k) - fac_cond*(qcl(i,k)+qpl(i,k)) & - fac_sub *(qci(i,k)+qpi(i,k)) -! if (lprnt .and. i == ipr .and. k<=10) write(0,*)' hl=',hl(i,k), & -! ' tabs=',tabs(i,k),' gamaz=',gamaz(i,k), ' fac_cond=',fac_cond, & -! ' qcl=',qcl(i,k),' qpl=',qpl(i,k),' qci=',qci(i,k),' qpi=',qpi(i,k),& -! ' fac_sub=',fac_sub,' k=',k w3(i,k) = zero enddo enddo -! if (lprnt) write(0,*)' hlin=',hl(ipr,1:40) - ! Define vertical grid increments for later use in the vertical differentiation do k=2,nzm @@ -546,8 +519,6 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & * sqrt(tke(i,k)) / (zl(i,ku) - zl(i,kd)) w_sec(i,k) = max(twoby3 * tke(i,k) - twoby15 * wrk, zero) ! w_sec(i,k) = max(twoby3 * tke(i,k), zero) -! if(lprnt .and. i == ipr .and. k <40) write(0,*)' w_sec=',w_sec(i,k),' tke=',tke(i,k),& -! ' tkh=',tkh(i,ka),tkh(i,kb),' w=',w(i,ku),w(i,kd),' prnum=',prnum(i,ka),prnum(i,kb),' k=',k else w_sec(i,k) = zero endif @@ -616,11 +587,6 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & call assumed_pdf() -! if (lprnt) write(0,*)' tabsout=',tabs(ipr,1:40) -! if (lprnt) write(0,*)' qcout=',qc(ipr,1:40) -! if (lprnt) write(0,*)' qwvout=',qwv(ipr,1:40) -! if (lprnt) write(0,*)' qiout=',qi(ipr,1:40) - contains subroutine tke_shoc() @@ -727,23 +693,12 @@ subroutine tke_shoc() wrk = (dtn*Cee) / smixt(i,k) wrk1 = wtke + dtn*(a_prod_sh+a_prod_bu) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wrk1=',wrk1,& -! ' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu,' dtn=',dtn,' smixt=', & -! smixt(i,k),' tkh=',tkh(i,ku),tkh(i,kd),' def2=',def2(i,ku),def2(i,kd) & -! ,' prnum=',prnum(i,ku),prnum(i,kd),' wthv_sec=',wthv_sec(i,k),' thv=',thv(i,k) - do itr=1,nitr ! iterate for implicit solution wtke = min(max(min_tke, wtke), max_tke) a_diss = wrk*sqrt(wtke) ! Coefficient in the TKE dissipation term wtke = wrk1 / (one+a_diss) wtke = tkef1*wtke + tkef2*wtk2 ! tkef1+tkef2 = 1.0 - -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wtk2=',wtk2,& -! ' a_diss=',a_diss,' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu, & -! ' wrk1=',wrk1,' itr=',itr,' k=',k - wtk2 = wtke - enddo tke(i,k) = min(max(min_tke, wtke), max_tke) @@ -763,9 +718,6 @@ subroutine tke_shoc() tscale1/(one+lambda*buoy_sgs*tscale1*tscale1)) endif -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' isotropy=',isotropy(i,k),& -! ' buoy_sgs=',buoy_sgs,' lambda=',lambda,' tscale1=',tscale1 - ! TKE budget terms ! tkesbdiss(i,k) = a_diss @@ -783,8 +735,6 @@ subroutine tke_shoc() tkh(i,k) = min(tkhmax, wrk * (isotropy(i,k) * tke(i,k) & + isotropy(i,k1) * tke(i,k1))) ! Eddy thermal diffusivity enddo ! i -! if (lprnt) write(0,*)' shocendtkh=',tkh(ipr,k),' tke=',tke(ipr,k),& -! tke(ipr,k1),' isot=',isotropy(ipr,k),isotropy(ipr,k1),'k=',k,' k1=',k1 enddo ! k @@ -1222,7 +1172,7 @@ subroutine canuto() ! In the presence of strong vertical gradients of w2, the value interpolated to the interface can ! be as much as twice as as large (or as small) as the value on in layer center. When the skewness ! of W PDF is calculated in assumed_pdf(), the code there uses w2 on the layer center, and the value -! of w3 interpolated from the interfaces to the layer center. The errorsintroduced due to dual +! of w3 interpolated from the interfaces to the layer center. The errors introduced due to dual ! interpolation are amplified by exponentiation during the calculation of skewness ! and result in (ususally negative) values ! of skewness of W PDF that are too large ( < -10). The resulting PDF consists of two delta @@ -1377,7 +1327,6 @@ subroutine assumed_pdf() ! wthlsec = wthl_sec(i,k) ! Compute square roots of some variables so we don't have to do it again -! if (lprnt .and. i == ipr .and. k<10) write(0,*)' w_sec=',w_sec(i,k),' k=',k if (w_sec(i,k) > zero) then sqrtw2 = sqrt(w_sec(i,k)) else @@ -1444,8 +1393,6 @@ subroutine assumed_pdf() ! Find parameters of the PDF of liquid/ice static energy -! if (lprnt .and. i == ipr .and. k<10) write(0,*)' thlsec=',thlsec,' w1_2=',w1_2,' w1_1=',w1_1,& -! ' thl_first=',thl_first,' k=',k,' wthlsec=',wthlsec,sqrtw2,sqrtthl IF (thlsec <= thl_tol*thl_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN thl1_1 = thl_first thl1_2 = thl_first @@ -1475,14 +1422,9 @@ subroutine assumed_pdf() thl2_2 = zero endif ! -! if (lprnt .and. i == ipr .and. k<10) write(0,*)' thl1_1=',thl1_1,' sqrtthl=',sqrtthl,' thl_first=',thl_first,& -! ' thl1_2=',thl1_2,' corrtest1=',corrtest1,' w1_2=',w1_2,' w1_1=',w1_1 - thl1_1 = thl1_1*sqrtthl + thl_first thl1_2 = thl1_2*sqrtthl + thl_first -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thl1_1=',thl1_1,' thl1_2=',thl1_2 - sqrtthl2_1 = sqrt(thl2_1) sqrtthl2_2 = sqrt(thl2_2) @@ -1504,9 +1446,6 @@ subroutine assumed_pdf() qw1_1 = - corrtest2 / w1_2 ! A.7 qw1_2 = - corrtest2 / w1_1 ! A.8 -! if (lprnt .and. i == ipr .and. k<10) write(0,*)' qw1_1=',qw1_1,' corrtest2=',corrtest2,& -! ' w1_2=',w1_2,' wqwsec=',wqwsec,' sqrtw2=',sqrtw2,' sqrtqt=',sqrtqt,' qwsec=',qwsec - tsign = abs(qw1_2-qw1_1) ! Skew_qw = skew_facw*Skew_w @@ -1566,9 +1505,6 @@ subroutine assumed_pdf() Tl1_1 = thl1_1 - gamaz(i,k) Tl1_2 = thl1_2 - gamaz(i,k) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' Tl1_1=',Tl1_1,' Tl1_2=',Tl1_2,& -! ' wrk1=',wrk1,' thl1_1=',thl1_1,' thl1_2=',thl1_2,' qpl=',qpl(i,k),' qpi=',qpi(i,k) - ! Now compute qs ! Partition based on temperature for the first plume @@ -1576,7 +1512,6 @@ subroutine assumed_pdf() IF (Tl1_1 >= tbgmax) THEN lstarn1 = lcond esval = min(fpvsl(Tl1_1), pval) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' esval=',esval,' pval=',pval,' eps=',eps qs1 = eps * esval / (pval-0.378d0*esval) ELSE IF (Tl1_1 <= tbgmin) THEN lstarn1 = lsub @@ -1640,8 +1575,6 @@ subroutine assumed_pdf() s1 = qw1_1 - wrk ! A.17 cthl1 = cqt1*wrk*cpolv*beta1*pkap ! A.20 -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc s1=',s1,' qw1_1=',qw1_1,'wrk=',wrk,& -! ' qs1=',qs1,' beta1=',beta1,' cqt1=',cqt1 wrk1 = cthl1 * cthl1 wrk2 = cqt1 * cqt1 ! std_s1 = sqrt(max(zero,wrk1*thl2_1+wrk2*qw2_1-2.*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) @@ -1655,9 +1588,6 @@ subroutine assumed_pdf() wrk = s1 / (std_s1*sqrt2) C1 = max(zero, min(one, half*(one+erf(wrk)))) ! A.15 -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc wrk=',wrk,' s1=',s1,'std=',std_s1,& -! ' c1=',c1*100,' qs1=',qs1,' qw1_1=',qw1_1,' k=',k - IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 ELSEIF (s1 >= qcmin) THEN C1 = one @@ -1716,11 +1646,6 @@ subroutine assumed_pdf() qi1 = qn1 - ql1 qi2 = qn2 - ql2 -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc qi=',qi1,qi2,' ql=',ql1,ql2,& -! ' c1=',c1,' c2=',c2,' s1=',s1,' s2=',s2,' k=',k,' tl1=',tl1_1,tl1_2,' om1=',om1,'om2=',om2& -! ,' tbgmin=',tbgmin,'a_bg=',a_bg - - diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,k)) diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) diag_qi = diag_qn - diag_ql @@ -1733,10 +1658,6 @@ subroutine assumed_pdf() + fac_sub *(diag_qi+qpi(i,k)) & + tkesbdiss(i,k) * (dtn/cp) ! tke dissipative heating -! if (lprnt .and. i == ipr .and. k < 40) write(0,*)' tabsout=',tabs(ipr,k),' k=',k& -! ,' hl=',hl(i,k),' gamaz=',gamaz(i,k),' diag_ql=',diag_ql,' qpl=',qpl(i,k)& -! ,' diag_qi=',diag_qi,' qpi=',qpi(i,k),' diag_qn =',diag_qn ,' aterm=',aterm,' onema=',onema& -! ,' qn1=',qn1 ,' qn2=',qn2,' ql1=',ql1,' ql2=',ql2 ! Update moisture fields ! Update ncpl and ncpi Anning Cheng 03/11/2016 diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index fb4d7e515..07f014356 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -124,14 +124,6 @@ kind = kind_phys intent = in optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [prsl] standard_name = air_pressure long_name = mean layer pressure @@ -411,22 +403,6 @@ kind = kind_phys intent = inout optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 694060acd..f0947b9b4 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -20,7 +20,7 @@ module m_micro !! \htmlinclude m_micro_init.html !! subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, cpair,& - tmelt, latvap, latice, mg_dcs, mg_qcvar, mg_ts_auto_ice, & + eps, tmelt, latvap, latice, mg_dcs, mg_qcvar, mg_ts_auto_ice, & mg_rhmini, microp_uniform, do_cldice, hetfrz_classnuc, & mg_precip_frac_method, mg_berg_eff_factor, sed_supersat, & do_sb_physics, mg_do_hail, mg_do_graupel, mg_nccons, & @@ -38,7 +38,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, sed_supersat, do_sb_physics, mg_do_hail, & mg_do_graupel, mg_nccons, mg_nicons, mg_ngcons, & mg_do_ice_gmao, mg_do_liq_liu - real(kind=kind_phys), intent(in) :: gravit, rair, rh2o, cpair, tmelt, latvap, latice + real(kind=kind_phys), intent(in) :: gravit, rair, rh2o, cpair, eps, tmelt, latvap, latice real(kind=kind_phys), intent(in) :: mg_dcs, mg_qcvar, mg_ts_auto_ice(2), mg_rhmini, & mg_berg_eff_factor, mg_ncnst, mg_ninst, mg_ngnst character(len=16), intent(in) :: mg_precip_frac_method @@ -60,7 +60,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, call ini_micro (mg_dcs, mg_qcvar, mg_ts_auto_ice(1)) elseif (fprcp == 1) then call micro_mg_init2_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, mg_rhmini, & + eps, tmelt, latvap, latice, mg_rhmini,& mg_dcs, mg_ts_auto_ice, & mg_qcvar, & microp_uniform, do_cldice, & @@ -73,7 +73,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, mg_ncnst, mg_ninst) elseif (fprcp == 2) then call micro_mg_init3_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, mg_rhmini, & + eps, tmelt, latvap, latice, mg_rhmini,& mg_dcs, mg_ts_auto_ice, & mg_qcvar, & mg_do_hail, mg_do_graupel, & @@ -136,9 +136,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & &, CLDREFFG, aerfld_i & &, aero_in, naai_i, npccn_i, iccn & &, skip_macro & - &, lprnt, alf_fac, qc_min, pdfflag & - &, ipr, kdt, xlat, xlon, rhc_i, & - & me, errmsg, errflg) + &, alf_fac, qc_min, pdfflag & + &, kdt, xlat, xlon, rhc_i, & + & errmsg, errflg) use machine , only: kind_phys use physcons, grav => con_g, pi => con_pi, & @@ -182,8 +182,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & fourb3=4.0/3.0, RL_cub=1.0e-15, nmin=1.0 integer, parameter :: ncolmicro = 1 - integer,intent(in) :: im, ix,lm, ipr, kdt, fprcp, pdfflag, me - logical,intent(in) :: flipv, aero_in, skip_macro, lprnt, iccn + integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag + logical,intent(in) :: flipv, aero_in, skip_macro, iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) real (kind=kind_phys), dimension(ix,lm),intent(in) :: & @@ -379,7 +379,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & type (AerProps) :: AeroAux, AeroAux_b real, allocatable, dimension(:,:,:) :: AERMASSMIX - logical :: use_average_v, ltrue, lprint + logical :: use_average_v, ltrue, lprint, lprnt + integer :: ipr !================================== !====2-moment Microhysics= @@ -407,6 +408,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & errmsg = '' errflg = 0 + lprnt = .false. + ipr = 1 + ! rhr8 = 1.0 if(flipv) then DO K=1, LM diff --git a/physics/m_micro.meta b/physics/m_micro.meta index b3a42c709..7fc28c8a9 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -61,6 +61,15 @@ kind = kind_phys intent = in optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [tmelt] standard_name = triple_point_temperature_of_water long_name = triple point temperature of water @@ -823,14 +832,6 @@ type = logical intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = in - optional = F [alf_fac] standard_name = mg_tuning_factor_for_alphas long_name = tuning factor for alphas (alpha = 1 - critical relative humidity) @@ -857,14 +858,6 @@ type = integer intent = in optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F [kdt] standard_name = index_of_time_step long_name = current forecast iteration @@ -900,14 +893,6 @@ kind = kind_phys intent = in optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/micro_mg2_0.F90 b/physics/micro_mg2_0.F90 index 6588a375a..135c11e49 100644 --- a/physics/micro_mg2_0.F90 +++ b/physics/micro_mg2_0.F90 @@ -95,7 +95,6 @@ module micro_mg2_0 ! 2) saturation vapor pressure and specific humidity over water ! 3) svp over ice use machine, only : r8 => kind_phys -use physcons, only : epsqs => con_eps, fv => con_fvirt use funcphys, only : fpvsl, fpvsi !use wv_sat_methods, only: & @@ -183,7 +182,7 @@ module micro_mg2_0 real(r8) :: gamma_br_plus1, gamma_bs_plus1, gamma_bi_plus1, gamma_bj_plus1 real(r8) :: gamma_br_plus4, gamma_bs_plus4, gamma_bi_plus4, gamma_bj_plus4 real(r8) :: xxlv_squared, xxls_squared -real(r8) :: omeps +real(r8) :: omeps, epsqs character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor @@ -200,7 +199,7 @@ module micro_mg2_0 !>\ingroup mg2_0_mp !! This subroutine calculates subroutine micro_mg_init( & - kind, gravit, rair, rh2o, cpair, & + kind, gravit, rair, rh2o, cpair, eps, & tmelt_in, latvap, latice, & rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & microp_uniform_in, do_cldice_in, use_hetfrz_classnuc_in, & @@ -226,6 +225,8 @@ subroutine micro_mg_init( & real(r8), intent(in) :: rair real(r8), intent(in) :: rh2o real(r8), intent(in) :: cpair + real(r8), intent(in) :: eps +! real(r8), intent(in) :: fv real(r8), intent(in) :: tmelt_in !< Freezing point of water (K) real(r8), intent(in) :: latvap real(r8), intent(in) :: latice @@ -321,6 +322,7 @@ subroutine micro_mg_init( & xxlv_squared = xxlv * xxlv xxls_squared = xxls * xxls + epsqs = eps omeps = one - epsqs tmn = 173.16_r8 tmx = 375.16_r8 @@ -1678,7 +1680,7 @@ subroutine micro_mg_tend ( & if (do_cldice) then call ice_deposition_sublimation(t(:,k), q(:,k), qi(:,k), ni(:,k), & - cldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & + icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) do i=1,mgncol diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 9a9971df5..047f9ef8a 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -124,7 +124,6 @@ module micro_mg3_0 ! 2) saturation vapor pressure and specific humidity over water ! 3) svp over ice use machine, only : r8 => kind_phys -use physcons, only : epsqs => con_eps, fv => con_fvirt use funcphys, only : fpvsl, fpvsi !use wv_sat_methods, only: & @@ -232,7 +231,7 @@ module micro_mg3_0 real(r8) :: gamma_br_plus1, gamma_bs_plus1, gamma_bi_plus1, gamma_bj_plus1, gamma_bg_plus1 real(r8) :: gamma_br_plus4, gamma_bs_plus4, gamma_bi_plus4, gamma_bj_plus4, gamma_bg_plus4 real(r8) :: xxlv_squared, xxls_squared -real(r8) :: omeps +real(r8) :: omeps, epsqs character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor @@ -247,7 +246,7 @@ module micro_mg3_0 !=============================================================================== subroutine micro_mg_init( & - kind, gravit, rair, rh2o, cpair, & + kind, gravit, rair, rh2o, cpair, eps, & tmelt_in, latvap, latice, & rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & !++ag @@ -277,6 +276,8 @@ subroutine micro_mg_init( & real(r8), intent(in) :: rair real(r8), intent(in) :: rh2o real(r8), intent(in) :: cpair + real(r8), intent(in) :: eps +! real(r8), intent(in) :: fv real(r8), intent(in) :: tmelt_in ! Freezing point of water (K) real(r8), intent(in) :: latvap real(r8), intent(in) :: latice @@ -408,6 +409,7 @@ subroutine micro_mg_init( & xxlv_squared = xxlv * xxlv xxls_squared = xxls * xxls + epsqs = eps omeps = one - epsqs tmn = 173.16_r8 tmx = 375.16_r8 diff --git a/physics/moninshoc.f b/physics/moninshoc.f index 560d6bbfe..eb6ccd7e7 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -31,7 +31,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & prsi,del,prsl,prslk,phii,phil,delt, & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, & kinver,xkzm_m,xkzm_h,xkzm_s,xkzminv, - & lprnt,ipr,me, & grav, rd, cp, hvap, fv, & errmsg,errflg) ! @@ -42,9 +41,8 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! arguments ! - logical, intent(in) :: lprnt integer, intent(in) :: ix, im, - & km, ntrac, ntcw, ncnd, ntke, ipr, me + & km, ntrac, ntcw, ncnd, ntke integer, dimension(im), intent(in) :: kinver real(kind=kind_phys), intent(in) :: delt, @@ -119,14 +117,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! if (ix < im) stop ! -! if (lprnt) write(0,*)' in moninshoc tsea=',tsea(ipr) -! &, ' grav=',grav, rd, cp, hvap, fv,' ipr=',ipr -! &,' ntke=',ntke,' ntcw=',ntcw -! if (lprnt) write(0,*)' in moninshoc tin=',t1(ipr,:) -! if (lprnt) write(0,*)' in moninshoc qin=',q1(ipr,:,1) -! if (lprnt) write(0,*)' in moninshoc qwin=',q1(ipr,:,2) -! if (lprnt) write(0,*)' in moninshoc qiin=',q1(ipr,:,3) - dt2 = delt rdt = 1. / dt2 km1 = km - 1 @@ -170,12 +160,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, endif enddo enddo - -! if (lprnt) then -! write(0,*)' tx1=',tx1(ipr),' kinver=',kinver(ipr) -! write(0,*)' xkzo=',xkzo(ipr,:) -! write(0,*)' xkzmo=',xkzmo(ipr,:) -! endif ! ! diffusivity in the inversion layer is set to be xkzminv (m^2/s) ! @@ -219,7 +203,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo enddo ! -! if (lprnt) write(0,*)' heat=',heat(ipr),' evap=',evap(ipr) do i = 1,im sflux(i) = heat(i) + evap(i)*fv*theta(i,1) if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. @@ -380,9 +363,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, dkt(i,k) = max(min(tkh(i,kp1)+xkzo(i,k), dkmax), xkzo(i,k)) enddo enddo - -! if (lprnt) write(0,*)' tkh=',tkh(ipr,:) -! if (lprnt) write(0,*)' dkt=',dkt(ipr,:) ! ! compute tridiagonal matrix elements for heat and moisture ! @@ -391,8 +371,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, a1(i,1) = t1(i,1) + beta(i) * heat(i) a2(i,1) = q1(i,1,1) + beta(i) * evap(i) enddo -! if (lprnt) write(0,*)' a1=',a1(ipr,1),' beta=',beta(ipr) -! &,' heat=',heat(ipr), ' t1=',t1(ipr,1) ntloc = 1 if(ntrac > 1) then @@ -557,8 +535,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo endif ! -! if (lprnt) write(0,*)' in moninshoc tau=',tau(ipr,:)*86400 - return end subroutine moninshoc_run diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 480cc419d..80d8f71fc 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -424,30 +424,6 @@ kind = kind_phys intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = flag for printing diagnostics to output - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [grav] standard_name = gravitational_acceleration long_name = gravitational acceleration diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 7ae82acca..be3b928a8 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -5,12 +5,6 @@ module rascnv USE machine , ONLY : kind_phys - use physcons, grav => con_g, cp => con_cp, alhl => con_hvap& - &, alhf => con_hfus, rgas => con_rd, rkap => con_rocp& - &, nu => con_FVirt, pi => con_pi, t0c => con_t0c & - &, rv => con_rv, cvap => con_cvap & - &, cliq => con_cliq, csol => con_csol, ttp=> con_ttp & - &, eps => con_eps, epsm1 => con_epsm1 implicit none public :: rascnv_init, rascnv_run, rascnv_finalize private @@ -36,27 +30,16 @@ module rascnv &, ONE_M6=1.E-6, ONE_M5=1.E-5 & &, ONE_M2=1.E-2, ONE_M1=1.E-1 & &, oneolog10=one/log(10.0) & - &, deg2rad=pi/180.d0 & ! conversion factor from degree to radians &, facmb = 0.01 & ! conversion factor from Pa to hPa (or mb) &, cmb2pa = 100.0 ! Conversion from hPa to Pa ! - real(kind=kind_phys), parameter :: & - & ONEBG = ONE / GRAV, GRAVCON = cmb2pa * ONEBG & - &, onebcp = one / cp & - &, GRAVFAC = GRAV / CMB2PA, ELOCP = ALHL * onebcp & - &, ELFOCP = (ALHL+ALHF) * onebcp & - &, oneoalhl = one/alhl & - &, CMPOR = CMB2PA / RGAS & - &, picon = half*pi*onebg & - &, zfac = 0.28888889E-4 * ONEBG -! - real(kind=kind_phys), parameter :: frac=0.5, crtmsf=0.0 & &, rhfacs=0.70, rhfacl=0.70 & &, face=5.0, delx=10000.0 & &, ddfac=face*delx*0.001 & &, max_neg_bouy=0.15 & ! &, max_neg_bouy=pt25 & + &, testmb=0.1, testmbi=one/testmb & &, dpd=0.5, rknob=1.0, eknob=1.0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -69,9 +52,6 @@ module rascnv ! &, advcld=.true., advups=.false.,advtvd=.false. -! real(kind=kind_phys), parameter :: TF=160.16, TCR=160.16 & -! real(kind=kind_phys), parameter :: TF=230.16, TCR=260.16 & -! real(kind=kind_phys), parameter :: TF=233.16, TCR=263.16 & real(kind=kind_phys), parameter :: TF=233.16, TCR=273.16 & &, TCRF=1.0/(TCR-TF), TCL=2.0 @@ -97,13 +77,20 @@ module rascnv real(kind=kind_phys) AC(16), AD(16) ! integer, parameter :: nqrp=500001 - real(kind=kind_phys) C1XQRP, C2XQRP, TBQRP(NQRP), TBQRA(NQRP) & + real(kind=kind_phys) C1XQRP, C2XQRP, TBQRP(NQRP), TBQRA(NQRP) & &, TBQRB(NQRP) ! integer, parameter :: nvtp=10001 real(kind=kind_phys) C1XVTP, C2XVTP, TBVTP(NVTP) ! - real(kind=kind_phys) afc, facdt + real(kind=kind_phys) afc, facdt, & + grav, cp, alhl, alhf, rgas, rkap, nu, pi, & + t0c, rv, cvap, cliq, csol, ttp, eps, epsm1,& +! + ONEBG, GRAVCON, onebcp, GRAVFAC, ELOCP, & + ELFOCP, oneoalhl, CMPOR, picon, zfac, & + deg2rad, PIINV, testmboalhl, & + rvi, facw, faci, hsub, tmix, DEN contains @@ -117,12 +104,19 @@ module rascnv !> \section arg_table_rascnv_init Argument Table !! \htmlinclude rascnv_init.html !! - subroutine rascnv_init(me, dt, errmsg, errflg) + subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & + con_rv, con_hvap, con_hfus, con_fvirt, & + con_t0c, con_ttp, con_cvap, con_cliq, & + con_csol, con_eps, con_epsm1, & + errmsg, errflg) ! Implicit none ! integer, intent(in) :: me - real(kind=kind_phys), intent(in) :: dt + real(kind=kind_phys), intent(in) :: dt, & + con_g, con_cp, con_rd, con_rv, con_hvap, & + con_hfus, con_fvirt, con_t0c, con_cvap, con_cliq, & + con_csol, con_ttp, con_eps, con_epsm1 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -174,6 +168,27 @@ subroutine rascnv_init(me, dt, errmsg, errflg) ! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 ! AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 +! + grav = con_g ; cp = con_cp ; alhl = con_hvap + alhf = con_hfus ; rgas = con_rd + nu = con_FVirt ; t0c = con_t0c + rv = con_rv ; cvap = con_cvap + cliq = con_cliq ; csol = con_csol ; ttp = con_ttp + eps = con_eps ; epsm1 = con_epsm1 +! + pi = four*atan(one) ; PIINV = one/PI + ONEBG = ONE / GRAV ; GRAVCON = cmb2pa * ONEBG + onebcp = one / cp ; GRAVFAC = GRAV / CMB2PA + rkap = rgas * onebcp ; deg2rad = pi/180.d0 + ELOCP = ALHL * onebcp ; ELFOCP = (ALHL+ALHF) * onebcp + oneoalhl = one/alhl ; CMPOR = CMB2PA / RGAS + picon = half*pi*onebg ; zfac = 0.28888889E-4 * ONEBG + testmboalhl = testmb/alhl +! + rvi = one/rv ; facw=CVAP-CLIQ + faci = CVAP-CSOL ; hsub=alhl+alhf + tmix = TTP-20.0 ; DEN=one/(TTP-TMIX) +! if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & &, ' DETRAINING AT NORMALIZED PRESSURE ABOVE ',DPD @@ -249,8 +264,6 @@ end subroutine rascnv_finalize !! qw0 - real, min cloud water before autoconversion !! qi0 - real, min cloud ice before autoconversion !! dlqfac - real,fraction of condensated detrained in layers -!! lprnt - logical, true for debug print -!! ipr - integer, horizontal grid point to print when lprnt=true !! kdt - integer, current teime step !! revap - logial, when true reevaporate falling rain/snow !! qlcn - real @@ -277,8 +290,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, ccwf, area, dxmin, dxinv & &, psauras, prauras, wminras, dlqf, flipv & &, me, rannum, nrcm, mp_phys, mp_phys_mg & - &, ntk, lprnt, ipr, kdt, rhc & -! &, ntk, lprnt, ipr, kdt, trcmin, rhc & + &, ntk, kdt, rhc & &, tin, qin, uin, vin, ccin, fscav & &, prsi, prsl, prsik, prslk, phil, phii & &, KPBL, CDRAG, RAINC, kbot, ktop, kcnv & @@ -305,12 +317,12 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! Implicit none ! - LOGICAL FLIPV, lprnt + LOGICAL FLIPV ! ! input ! - integer, intent(in) :: im, ix, k, ntr, me, nrcm, ntk, ipr & - &, kdt, mp_phys, mp_phys_mg + integer, intent(in) :: im, ix, k, ntr, me, nrcm, ntk, kdt & + &, mp_phys, mp_phys_mg integer, dimension(im) :: kbot, ktop, kcnv, kpbl ! real(kind=kind_phys), intent(in) :: dxmin, dxinv, ccwf(2) & @@ -369,9 +381,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & &, kblmn, ksfc, ncrnd real(kind=kind_phys) sgcs(k,im) -! - LOGICAL lprint -! LOGICAL lprint, ctei ! ! Scavenging related parameters ! @@ -390,14 +399,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & errmsg = '' errflg = 0 - -! if (me == 0) write(0,*)' in ras ntr=',ntr,' kdt=',kdt,' ntk=',ntk -! if (me == 0) write(0,*)' in ras tke=',ccin(1,:,ntk),' kdt=',kdt & -! &, ' ntk=',ntk -! if (me == 0) write(0,*)' rann=',rannum(1,:),' kdt=',kdt -! if (lprnt) write(0,*)' in RAS fscav=',fscav_, ' mp_phys=',mp_phys & -! &, ' fscav=',fscav,' ntr=',ntr & -! &, ' rannum=',rannum(1,:) ! km1 = k - 1 kp1 = k + 1 @@ -406,7 +407,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & else ksfc = kp1 endif - ia = ipr ! ntrc = ntr IF (CUMFRC) THEN @@ -458,9 +458,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & enddo DO IPT=1,IM - lprint = lprnt .and. ipt == ipr - ia = ipr - tem1 = max(zero, min(one, (log(area(ipt)) - dxmin) * dxinv)) tem2 = one - tem1 ccwfac = ccwf(1)*tem1 + ccwf(2)*tem2 @@ -470,9 +467,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & c0 = (prauras(1)*tem1 + prauras(2)*tem2) * tem if (ccwfac == zero) ccwfac = half -! if (lprint) write(0,*)' c0=',c0,' c0i=',c0i,' dlq_fac=',dlq_fac, & -! & ' ccwf=',ccwf - ! ! ctei = .false. ! if (ctei_r(ipt) > ctei_rm) ctei = .true. @@ -506,9 +500,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ENDDO krmin = max(krmin,2) -! if (kdt == 1 .and. ipt == 1) write(0,*)' kblmn=',kblmn,kblmx -! if (lprint) write(0,*)' krmin=',krmin,' krmax=', & -! &krmax,' kfmax=',kfmax,' tem=',tem ! if (fix_ncld_hr) then !!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 @@ -530,11 +521,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & KTEM = MIN(K,KFMAX) KFX = KTEM - KCR -! if(lprint)write(0,*)' enter RASCNV k=',k,' ktem=',ktem & -! &, ' krmax=',krmax,' kfmax=',kfmax & -! &, ' krmin=',krmin,' ncrnd=',ncrnd & -! &, ' kcr=',kcr, ' cdrag=',cdrag(ipr) - IF (KFX > 0) THEN IF (BOTOP) THEN DO NC=1,KFX @@ -556,19 +542,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ENDDO ENDIF ! -! if (me == 0) write(0,*)' in rascnv: k=',k,' lprnt=',lprnt -! if (lprint) then -! if (me == 0) then -! write(0,*)' ic=',ic(1:kfx+ncrnd) -! write(0,*)' tin',(tin(ia,l),l=k,1,-1),' kdt=',kdt,' me=',me -! write(0,*)' qin',(qin(ia,l),l=k,1,-1),' kdt=',kdt,' me=',me -! write(0,*)' qwin',(ccin(ia,l,2),l=k,1,-1) -! write(0,*)' qiin',(ccin(ia,l,1),l=k,1,-1) -! endif -! -! -! lprint = lprnt .and. ipt == ipr - do l=1,k CLW(l) = zero CLI(l) = zero @@ -687,18 +660,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! endif ! end of if (flipv) then ! -! if (lprint) write(0,*)' phi_h=',phi_h(:) -! lprint = kdt == 1 .and. me == 0 .and. ipt == 1 -! if(lprint) write(0,*)' PRS=',PRS -! if(lprint) write(0,*)' PRSM=',PRSM -! if (lprint) then -! write(0,*)' qns=',qns(ia),' qoi=',qn0(ia,k),'qin=',qin(ia,1) -! if (me == 0) then -! write(0,*)' toi',(tn0(ia,l),l=1,k) -! write(0,*)' qoi',(qn0(ia,l),l=1,k),' kbl=',kbl -! endif -! -! ! do l=k,kctop(1),-1 !! DPI(L) = 1.0 / (PRS(L+1) - PRS(L)) ! enddo @@ -806,16 +767,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & enddo endif ! -! lprint = lprnt .and. ipt == ipr - -! if (lprint) then -! write(0,*)' trcfac=',trcfac(krmin:k,1+ntr) -! write(0,*)' alfint=',alfint(krmin:k,1) -! write(0,*)' alfinq=',alfint(krmin:k,2) -! write(0,*)' alfini=',alfint(krmin:k,4) -! write(0,*)' alfinu=',alfint(krmin:k,5) -! endif -! ! if (calkbl) kbl = k if (calkbl) then @@ -829,11 +780,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & IB = IC(NC) ! cloud top level index if (ib > kbl-1) cycle -! lprint = lprnt .and. ipt == ipr .and. ib == 57 -! -! if (lprint) write(0,*)' calling cloud type ib=',ib,' kbl=',kbl& -! &, ' kpbl=',kpbl,' alfint=',alfint,' frac=',frac & -! &, ' ntrc=',ntrc,' ipt=',ipt ! !**************************************************************************** ! if (advtvd) then ! TVD flux limiter scheme for updraft @@ -897,48 +843,23 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! endif ! endif !**************************************************************************** -! -! if (lprint) then -! ia = ipt -! write(0,*)' toi=',(toi(ia,l),l=1,K) -! write(0,*)' qoi=',(qoi(ia,l),l=1,K),' kbl=',kbl -! write(0,*)' toi=',(toi(l),l=1,K) -! write(0,*)' qoi=',(qoi(l),l=1,K),' kbl=',kbl -! write(0,*)' prs=',(prs(l),l=1,K) -! endif ! WFNC = zero do L=IB,KP1 FLX(L) = zero FLXD(L) = zero enddo -! -! if(lprint)then -! write(0,*) ' CALLING CLOUD TYPE IB= ', IB,' DT=',DT,' K=',K -! &, 'ipt=',ipt -! write(0,*) ' TOI=',(TOI(L),L=IB,K) -! write(0,*) ' QOI=',(QOI(L),L=IB,K) -! write(0,*) ' qliin=',qli -! write(0,*) ' qiiin=',qii -! endif ! TLA = -10.0 ! qiid = qii(ib) ! cloud top level ice before convection qlid = qli(ib) ! cloud top level water before convection ! -! if(lprint) write(0,*)' uvitke=',uvi(ib:k,ntk-2), ' ib=',ib & -! &,' trcmin=',trcmin(ntk-2) -! if (lprnt) then -! qoi_l(ib:k) = qoi(ib:k) -! qli_l(ib:k) = qli(ib:k) -! qii_l(ib:k) = qii(ib:k) -! endif rainp = rain CALL CLOUD(K, KP1, IB, ntrc, kblmx, kblmn & &, FRAC, MAX_NEG_BOUY, vsmooth, do_aw & - &, REVAP, WRKFUN, CALKBL, CRTFUN, lprint & + &, REVAP, WRKFUN, CALKBL, CRTFUN & &, DT, KDT, TLA, DPD & &, ALFINT, rhfacl, rhfacs, area(ipt) & &, ccwfac, CDRAG(ipt), trcfac & @@ -949,25 +870,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, dlq_fac) ! &, ctei) -! if(lprint) write(0,*)' uvitkea=',uvi(ib:k,ntk-2),' ib=',ib -! if (lprint) then -! write(0,*) ' rain=',rain,' ipt=',ipt -! write(0,*) ' after calling CLOUD TYPE IB= ', IB & -! &,' rain=',rain,' prskd=',prs(ib),' qli=',qli(ib),' qii=',qii(ib) & -! &,' rainp=',rainp -! write(0,*) ' phi_h=',phi_h(K-5:KP1) -! write(0,*) ' TOI=',(TOI(L),L=1,K),' me=',me,' ib=',ib -! write(0,*) ' QOI=',(QOI(L),L=1,K) -! write(0,*) ' qliou=',qli -! write(0,*) ' qiiou=',qii -! sumq = 0.0 -! do l=ib,k -! sumq = sumq+(qoi(l)+qli(l)+qii(l)-qoi_l(l)-qli_l(l)-qii_l(l)) -! & * (prs(l+1)-prs(l)) * (100.0/grav) -! enddo -! write(0,*)' sumq=',sumq,' rainib=',rain-rainp,' ib=',ib - -! endif ! if (flipv) then do L=IB,K @@ -980,14 +882,8 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 -! if (lprint) write(0,*)' ib=',ib,' flx=',flx(ib),' ll=',ll -! &,' ud_mf=',ud_mf(ipt,:) - CNV_MFD(ipt,ll) = CNV_MFD(ipt,ll) + flx(ib)/dt -! if (lprint) write(0,*)' ib=',ib,' CNV_MFD=',CNV_MFD(ipt,ll) -! &,' ll=',ll,' kp1=',kp1 - ! CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) ! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) + flx(ib)* & @@ -1006,11 +902,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & dt_mf(ipt,ib) = dt_mf(ipt,ib) + flx(ib) if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 -! if (lprint) write(0,*)' ib=',ib,' flx=',flx(ib),' ib=',ib -! &,' ud_mf=',ud_mf(ipt,:) CNV_MFD(ipt,ib) = CNV_MFD(ipt,ib) + flx(ib)/dt -! if (lprint) write(0,*)' ib=',ib,' CNV_MFD=',CNV_MFD(ipt,ib) -! &,' ib=',ib,' kp1=',kp1 ! CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) ! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* & @@ -1022,7 +914,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & endif ! ! -! Warining!!!! +! Warning!!!! ! ------------ ! By doing the following, CLOUD does not contain environmental ! condensate! @@ -1040,13 +932,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! RAINC(ipt) = rain * 0.001 ! Output rain is in meters -! if (lprint) then -! write(0,*) ' convective precip=',rain*86400/dt,' mm/day' & -! &, ' ipt=',ipt,' kdt=',kdt -! write(0,*) ' toi',(tn0(imax,l),l=1,k) -! write(0,*) ' qoi',(qn0(imax,l),l=1,k) -! endif -! ktop(ipt) = kp1 kbot(ipt) = 0 @@ -1093,14 +978,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & QICN(ipt,ll) = qii(l) CNV_FICE(ipt,ll) = qii(l)/max(1.e-10,qii(l)+qli(l)) endif -!! CNV_PRC3(ipt,ll) = PCU(l)/dt -! CNV_PRC3(ipt,ll) = zero -! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,ll cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ & & 500*ud_mf(ipt,ll)/dt), cfmax)) ! & 500*ud_mf(ipt,ll)/dt), 0.60)) -! if (lprint) write(0,*)' ll=',ll,' cf_upi=',cf_upi(ipt,ll) -! &,' ud_mf=',ud_mf(ipt,ll),' dt=',dt,' cfmax=',cfmax CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / & & (dt*max(cf_upi(ipt,ll),1.e-12)*prsl(ipt,ll)) @@ -1128,11 +1008,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! ktop(ipt) = kp1 - ktop(ipt) kbot(ipt) = kp1 - kbot(ipt) -! -! if (lprint) then -! write(0,*) ' tin',(tin(ia,l),l=k,1,-1) -! write(0,*) ' qin',(qin(ia,l),l=k,1,-1) -! endif ! else @@ -1184,23 +1059,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & endif endif ! -! if (lprint) then -! write(0,*) ' endtin',(tin(ia,l),l=k,1,-1) -! write(0,*) ' endqin',(qin(ia,l),l=k,1,-1) -! write(0,*) ' endqwin',(ccin(ia,l,2),l=k,1,-1) -! write(0,*) ' endqiin',(ccin(ia,l,1),l=k,1,-1) -! endif -! -! ! Velocity scale from the downdraft! ! -! if (lprint) write(0,*)' ddvelbef=',ddvel(ipt),' ddfac=',ddfac & -! &, 'grav=',grav,' k=',k,'kp1=',kp1,'prs=',prs(k),prs(kp1) - DDVEL(ipt) = DDVEL(ipt) * DDFAC * GRAV / (prs(KP1)-prs(K)) - -! if (lprint) write(0,*)' ddvel=',ddvel(ipt),' ddfac=',ddfac - ! ENDDO ! End of the IPT Loop! @@ -1211,7 +1072,7 @@ end subroutine rascnv_run SUBROUTINE CLOUD( & & K, KP1, KD, NTRC, KBLMX, kblmn & &, FRACBL, MAX_NEG_BOUY, vsmooth, do_aw & - &, REVAP, WRKFUN, CALKBL, CRTFUN, lprnt & + &, REVAP, WRKFUN, CALKBL, CRTFUN & &, DT, KDT, TLA, DPD & &, ALFINT, RHFACL, RHFACS, area, ccwf, cd, trcfac & &, alfind, rhc_ls, phil, phih, prs, prsm, sgcs & @@ -1292,8 +1153,6 @@ SUBROUTINE CLOUD( & &, qudfac=quad_lam*half & &, shalfac=3.0 & ! &, qudfac=quad_lam*pt25, shalfac=3.0 !& ! Yogesh's - &, testmb=0.1, testmbi=one/testmb& - &, testmboalhl=testmb/alhl & &, c0ifac=0.07 & ! following Han et al, 2016 MWR &, dpnegcr = 150.0 ! &, dpnegcr = 100.0 @@ -1313,7 +1172,7 @@ SUBROUTINE CLOUD( & ! LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP, ctei LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP - logical vsmooth, do_aw, lprnt + logical vsmooth, do_aw INTEGER K, KP1, KD, NTRC, kblmx, kblmn, ntk @@ -1400,16 +1259,6 @@ SUBROUTINE CLOUD( & tcd(L) = zero qcd(L) = zero enddo -! -! if (lprnt) then -! write(0,*) ' IN CLOUD for KD=',kd -! write(0,*) ' prs=',prs(Kd:KP1) -! write(0,*) ' phil=',phil(KD:K) -!! write(0,*) ' phih=',phih(kd:KP1),' kdt=',kdt -! write(0,*) ' phih=',phih(KD:KP1) -! write(0,*) ' toi=',toi(kd:k) -! write(0,*) ' qoi=',qoi(kd:k) -! endif ! CLDFRD = zero DOF = zero @@ -1454,7 +1303,6 @@ SUBROUTINE CLOUD( & AKT(L) = (PRL(L+1) - PL) * DPI ! CALL QSATCN(TL, PL, QS, DQS) -! CALL QSATCN(TL, PL, QS, DQS,lprnt) ! QST(L) = QS GAM(L) = DQS * ELOCP @@ -1520,22 +1368,9 @@ SUBROUTINE CLOUD( & HOL(L) = HOL(L) + ETA(L) HST(L) = HST(L) + ETA(L) ! -! if (kd == 37) then -! if (lprnt) then -! write(0,*) ' IN CLOUD for KD=',KD,' K=',K -! write(0,*) ' l=',l,' hol=',hol(l),' hst=',hst(l) -! write(0,*) ' TOL=',tol -! write(0,*) ' qol=',qol -! write(0,*) ' hol=',hol -! write(0,*) ' hst=',hst -! endif -! endif -! ! To determine KBL internally -- If KBL is defined externally ! the following two loop should be skipped ! -! if (lprnt) write(0,*) ' calkbl=',calkbl - hcrit = hcritd if (sgcs(kd) > 0.65) hcrit = hcrits IF (CALKBL) THEN @@ -1595,7 +1430,6 @@ SUBROUTINE CLOUD( & enddo endif -! if(lprnt) write(0,*)' kbl=',kbl,' kbls=',kbls,' kmax=',kmax ! klcl = kd1 if (kmax > kd1) then @@ -1606,7 +1440,6 @@ SUBROUTINE CLOUD( & endif enddo endif -! if(lprnt) write(0,*)' klcl=',klcl,' ii=',ii ! if (klcl == kd .or. klcl < ktem) return ! This is to handle mid-level convection from quasi-uniform h @@ -1625,7 +1458,6 @@ SUBROUTINE CLOUD( & tem = min(50.0,max(10.0,(prl(kmaxp1)-prl(kd))*0.10)) if (prl(kmaxp1) - prl(ii) > tem .and. ii > kbl) kbl = ii -! if(lprnt) write(0,*)' kbl2=',kbl,' ii=',ii if (kbl .ne. ii) then if (PRL(kmaxp1)-PRL(KBL) > bldmax) kbl = max(kbl,ii) @@ -1659,30 +1491,19 @@ SUBROUTINE CLOUD( & KPBL = KBL -! if(lprnt)write(0,*)' 1st kbl=',kbl,' kblmx=',kblmx,' kd=',kd -! if(lprnt)write(0,*)' tx3=',tx3,' tx1=',tx1,' tem=',tem & -! &, ' hcrit=',hcrit - ELSE KBL = KPBL -! if(lprnt)write(0,*)' 2nd kbl=',kbl ENDIF - -! if(lprnt)write(0,*)' after CALKBL l=',l,' hol=',hol(l) & -! &, ' hst=',hst(l) ! KBL = min(kmax,MAX(KBL,KD+2)) KB1 = KBL - 1 !! -! if (lprnt) write(0,*)' kbl=',kbl,' prlkbl=',prl(kbl),prl(kp1) if (PRL(Kmaxp1)-PRL(KBL) > bldmax .or. kb1 <= kd ) then ! & .or. PRL(Kmaxp1)-PRL(KBL) < bldmin) then return endif ! -! if (lprnt) write(0,*)' kbl=',kbl -! write(0,*)' kbl=',kbl,' kmax=',kmax,' kmaxp1=',kmaxp1,' k=',k ! PRIS = ONE / (PRL(KP1)-PRL(KBL)) PRISM = ONE / (PRL(Kmaxp1)-PRL(KBL)) @@ -1704,7 +1525,6 @@ SUBROUTINE CLOUD( & ETA(L) = ZET(L) - ZET(L+1) GMS(L) = XI(L) - XI(L+1) ENDIF -! if (lprnt) write(0,*)' l=',l,' eta=',eta(l),' kbl=',kbl ENDDO if (kmax < k) then do l=kmaxp1,kp1 @@ -1732,7 +1552,6 @@ SUBROUTINE CLOUD( & ! qbl = qbl * hpert_fac ! endif -! if (lprnt) write(0,*)' hbl=',hbl,' qbl=',qbl ! Find Min value of HOL in TX2 TX2 = HOL(KD) IDH = KD1 @@ -1766,13 +1585,6 @@ SUBROUTINE CLOUD( & cnvflg = (TEM > ZERO .OR. (LOWEST .AND. TEM1 >= ZERO)) & & .AND. TX1 < RHRAM -! if(lprnt) write(0,*)' cnvflg=',cnvflg,' tem=',tem,' tem1=',tem1 & -! &,' tx1=',tx1,' rhram=',rhram,' kbl=',kbl,' kd=',kd,' lowest=' & -! &,lowest,' rhfacs=',rhfacs,' ltl=',ltl(kd1),' qol=',qol(kd1) & -! &,' qst=',qst(kd1),' hst=',hst(kd1),' nu=',nu -! if(lprnt .and. (.not. cnvflg)) write(0,*)' tx1=',tx1,' rhfacs=' & -! &,rhfacs, ' tem=',tem,' hst=',hst(kd1) - IF (.NOT. cnvflg) RETURN ! RHC = MAX(ZERO, MIN(ONE, EXP(-20.0*TX1) )) @@ -1796,9 +1608,6 @@ SUBROUTINE CLOUD( & endif endif -! if (lprnt) write(0,*)' wcbase=',wcbase,' rbl=', & -! & rbl(ntk),' ntk=',ntk - endif ! TX4 = zero @@ -1808,7 +1617,6 @@ SUBROUTINE CLOUD( & DO L=KBL,K QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) ENDDO -! if (lprnt) write(0,*)' qil=',qil(kbl:k),' gaf=',gaf(kbl) ! DO L=KB1,KD1,-1 lp1 = l + 1 @@ -1818,10 +1626,6 @@ SUBROUTINE CLOUD( & ! FCO(LP1) = TEM1 + ST2 * HBL -! if(lprnt) write(0,*)' fco=',fco(l+1),' tem1=',tem1,' st2=',st2 & -! &,' hbl=',hbl,' tx3=',tx3,' tem=',tem,' gaf=',gaf(l),' l=',l & -! &,'gaflp1=',gaf(lp1),' half=',half,' qst=',qst(l),' hst=',hst(l) - RNN(LP1) = ZET(LP1) * TEM1 + ST2 * TX4 GMH(LP1) = XI(LP1) * TEM1 + ST2 * TX5 ! @@ -1831,8 +1635,6 @@ SUBROUTINE CLOUD( & ! QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) QLL(LP1) = (half*ALHF) * ST2 * (QIL(L)+QIL(LP1)) + ONE -! if (lprnt) write(0,*)' qil=',qil(l),' qll=',qll(lp1), & -! & ' rcr=',tcr,' tcl=',tcl,' tcrf=',tcrf ENDDO ! ! FOR THE CLOUD TOP -- L=KD @@ -1861,12 +1663,6 @@ SUBROUTINE CLOUD( & QIL(KD) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(KD))*TCRF)) QLL(KD1) = (half*ALHF) * ST2 * (QIL(KD) + QIL(KD1)) + ONE QLL(KD ) = ALHF * GAF(KD) * QIL(KD) + ONE -! -! if (lprnt) then -! write(0,*)' fco=',fco(kd:kbl) -! write(0,*)' qil=',qil(kd:kbl) -! write(0,*)' qll=',qll(kd:kbl) -! endif ! st1 = qil(kd) st2 = c0i * st1 * exp(c0ifac*min(tol(kd)-t0c,0.0)) @@ -1886,13 +1682,8 @@ SUBROUTINE CLOUD( & ! tem1 = (one-akt(l)) * eta(l) -! if(lprnt) write(0,*)' qll=',qll(l),' st2=',st2,' tem=',tem & -! &,' tx2=',tx2,' akt=',akt(l),' eta=',eta(l) - AKT(L) = QLL(L) + (st2 + tem) * tx2 -! if(lprnt) write(0,*)' akt==',akt(l),' l==',l - AKC(L) = one / AKT(L) ! st1 = half * (qil(l)+qil(lp1)) @@ -1909,15 +1700,10 @@ SUBROUTINE CLOUD( & GMH(L) = GMH(L) + tx1*xi(lp1) ENDDO -! if(lprnt) write(0,*)' akt=',akt(kd:kb1) -! if(lprnt) write(0,*)' akc=',akc(kd:kb1) - qw00 = qw0 qi00 = qi0 ii = 0 777 continue -! -! if (lprnt) write(0,*)' after 777 ii=',ii,' ep_wfn=',ep_wfn ! ep_wfn = .false. RNN(KBL) = zero @@ -1926,8 +1712,6 @@ SUBROUTINE CLOUD( & TX5 = zero DO L=KB1,KD1,-1 TEM = BKC(L-1) * AKC(L) -! if (lprnt) write(0,*)' tx3=',tx3,' fco=',fco(l),' akc=',akc(l) & -! &,' bkc=',bkc(l-1), ' l=',l TX3 = (TX3 + FCO(L)) * TEM TX4 = (TX4 + RNN(L)) * TEM TX5 = (TX5 + GMH(L)) * TEM @@ -1938,8 +1722,6 @@ SUBROUTINE CLOUD( & HSD = HBL ENDIF ! -! if (lprnt) write(0,*)' tx3=',tx3,' fco=',fco(kd),' akc=',akc(kd) - TX3 = (TX3 + FCO(KD)) * AKC(KD) TX4 = (TX4 + RNN(KD)) * AKC(KD) TX5 = (TX5 + GMH(KD)) * AKC(KD) @@ -1947,8 +1729,6 @@ SUBROUTINE CLOUD( & ! HSU = HST(KD) + LTL(KD) * NU * (QOL(KD)-QST(KD)) -! if (lprnt) write(0,*)' hsu=',hsu,' hst=',hst(kd), & -! &' ltl=',ltl(kd),' qol=',qol(kd),' qst=',qst(kd) ! !===> VERTICAL INTEGRALS NEEDED TO COMPUTE THE ENTRAINMENT PARAMETER ! @@ -1963,8 +1743,6 @@ SUBROUTINE CLOUD( & ! ! MODIFY HSU TO INCLUDE CLOUD LIQUID WATER AND ICE TERMS ! -! if (lprnt) write(0,*)' hsu=',hsu,' alm=',alm,' tx3=',tx3 - HSU = HSU - ALM * TX3 ! CLP = ZERO @@ -1976,9 +1754,6 @@ SUBROUTINE CLOUD( & cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4 -! if (lprnt) write(0,*)' ii=',ii,' cnvflg=',cnvflg,' hsu=',hsu & -! &,' hbl=',hbl,' tx1=',tx1,' hsd=',hsd - !*********************************************************************** ST1 = HALF*(HSU + HSD) @@ -1992,8 +1767,6 @@ SUBROUTINE CLOUD( & clp = one st2 = hbl - hsu -! if(lprnt) write(0,*)' tx2=',tx2,' tx1=',tx1,' st2=',st2 -! if (tx2 == zero) then alm = - st2 / tx1 if (alm > almax) alm = -100.0 @@ -2009,14 +1782,9 @@ SUBROUTINE CLOUD( & if (tem2 > almax) tem2 = -100.0 alm = max(tem1,tem2) -! if (lprnt) write(0,*) ' tem1=',tem1,' tem2=',tem2,' alm=',alm & -! &,' tx1=',tx1,' tem=',tem,' epp=',epp,' x00=',x00,' st2=',st2 - endif endif -! if (lprnt) write(0,*)' almF=',alm,' ii=',ii,' qw00=',qw00 & -! &,' qi00=',qi00 ! ! CLIP CASE: ! NON-ENTRAINIG CLOUD DETRAINS IN LOWER HALF OF TOP LAYER. @@ -2045,9 +1813,6 @@ SUBROUTINE CLOUD( & GO TO 888 ENDIF ! -! if (lprnt) write(0,*)' hstkd=',hst(kd),' qstkd=',qst(kd) & -! &,' ii=',ii,' clp=',clp - st1s = ONE IF(CLP > ZERO .AND. CLP < ONE) THEN ST1 = HALF*(ONE+CLP) @@ -2117,7 +1882,6 @@ SUBROUTINE CLOUD( & ENDDO ETAI(KBL) = one -! if (lprnt) write(0,*)' eta=',eta,' ii=',ii,' alm=',alm ! !===> CLOUD WORKFUNCTION ! @@ -2148,12 +1912,6 @@ SUBROUTINE CLOUD( & DETP = (BKC(L)*DET - (QTVP-QTV) & & + DEL_ETA*(QOL(L)+CLL(L)+CIL(L)) + ST1) * AKC(L) -! if(lprnt) write(0,*)' detp=',detp,' bkc=',bkc(l),' det=',det & -! if (lprnt .and. kd == 15) -! & write(0,*)' detp=',detp,' bkc=',bkc(l),' det=',det & -! &,' qtvp=',qtvp,' qtv=',qtv,' del_eta=',del_eta,' qol=' & -! &,qol(l),' st1=',st1,' akc=',akc(l) -! TEM1 = AKT(L) - QLL(L) TEM2 = QLL(LP1) - BKC(L) RNS(L) = TEM1*DETP + TEM2*DET - ST1 @@ -2172,37 +1930,16 @@ SUBROUTINE CLOUD( & TEM2 = HCCP + DETP * QTP * ALHF ! -! if(lprnt) write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu & -! if (lprnt .and. kd == 15) -! & write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu & -! &,' qst=',qst(l),' qol=',qol(l),' hccp=',hccp,' detp=',detp & -! &,' qtp=',qtp,' alhf=',alhf,' vtf=',vtf(l) - ST2 = LTL(L) * VTF(L) TEM5 = CLL(L) + CIL(L) TEM3 = (TX1 - ETA(LP1)*ST1 - ST2*(DET-TEM5*eta(lp1))) * DLB(L) TEM4 = (TEM2 - ETA(L )*ST1 - ST2*(DETP-TEM5*eta(l))) * DLT(L) ! -! if (lprnt) then -! if (lprnt .and. kd == 12) then -! write(0,*)' tem3=',tem3,' tx1=',tx1,' st1=',st1,' eta1=',eta(l+1) & -! &, ' st2=',st2,' det=',det,' tem5=',tem5,' dlb=',dlb(l) & -! write(0,*)' tem4=',tem4,' tem2=',tem2,' detp=',detp & -! &, ' eta=',eta(l),' dlt=',dlt(l),' rns=',rns(l),' l=',l & -! write(0,*)' bt1=',tem3/(eta(l+1)*qrb(l)) & -! &, ' bt2=',tem4/(eta(l)*qrt(l)) -! endif - ST1 = TEM3 + TEM4 -! if (lprnt) write(0,*)' wfn=',wfn,' st1=',st1,' l=',l,' ep_wfn=', & -! &ep_wfn,' akm=',akm - WFN = WFN + ST1 AKM = AKM - min(ST1,ZERO) -! if (lprnt) write(0,*)' wfn=',wfn,' akm=',akm - if (st1 < zero .and. wfn < zero) then dpneg = dpneg + prl(lp1) - prl(l) endif @@ -2235,9 +1972,6 @@ SUBROUTINE CLOUD( & ! 888 continue -! if (lprnt) write(0,*)' ep_wfn=',ep_wfn,' ii=',ii,' rns=',rns(kd) & -! &,' clp=',clp,' hst(kd)=',hst(kd) - if (ep_wfn) then IF ((qw00 == zero .and. qi00 == zero)) RETURN if (ii == 0) then @@ -2264,9 +1998,6 @@ SUBROUTINE CLOUD( & qw00 = zero qi00 = zero -! if (lprnt) write(0,*)' returning to 777 : ii=',ii,' qw00=',qw00, & -! & qi00,' clp=',clp,' hst(kd)=',hst(kd) - go to 777 else cnvflg = .true. @@ -2282,18 +2013,12 @@ SUBROUTINE CLOUD( & TEM5 = (QLS + QIS) * eta(kd1) ST1 = HALF * (TX1-ETA(KD1)*ST1-ST2*(DET-TEM5))*DLB(KD) ! -! if (lprnt) write(0,*)' st1=',st1,' st2=',st2,' ltl=',ltl(kd) & -! &,ltl(kd1),' qos=',qos,qol(kd1) - WFN = WFN + ST1 AKM = AKM - min(ST1,ZERO) ! Commented on 08/26/02 - does not include top ! BUY(KD) = ST1 / (ETA(KD1)*qrb(kd)) ! -! if (lprnt) write(0,*)' wfn=',wfn,' akm=',akm,' st1=',st1 & -! &,' dpneg=',dpneg - DET = DETP HCC = HCCP AKM = AKM / WFN @@ -2316,8 +2041,6 @@ SUBROUTINE CLOUD( & IF (.not. cnvflg .and. WFN > ACR .and. & & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. -! if (lprnt) write(0,*)' calcup=',calcup,' akm=',akm,' tem=',tem & -! &,' cnvflg=',cnvflg,' clp=',clp,' rhc=',rhc,' cd=',cd,' acr=',acr ! !===> IF NO SOUNDING MEETS THIRD CONDITION, RETURN ! @@ -2332,8 +2055,6 @@ SUBROUTINE CLOUD( & !! CLP = CLP * max(0.0, min(1.0,(0.1 + 0.9*(ALM-ALMIN1)*ST1))) ! ENDIF ! ENDIF -! -! if (lprnt) write(0,*)' clp=',clp ! CLP = CLP * RHC dlq = zero @@ -2345,7 +2066,6 @@ SUBROUTINE CLOUD( & DO L=KBL,K RNN(L) = zero ENDDO -! if (lprnt) write(0,*)' rnn=',rnn ! ! If downdraft is to be invoked, do preliminary check to see ! if enough rain is available and then call DDRFT. @@ -2363,12 +2083,6 @@ SUBROUTINE CLOUD( & IF (TRAIN > 1.0E-4 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. ENDIF ! -! if (lprnt) then -! write(0,*)' BEFORE CALLING DDRFT KD=',kd,' DDFT=',DDFT -! &, ' PL=',PL,' TRAIN=',TRAIN -! write(0,*)' buy=',(buy(l),l=kd,kb1) -! endif - IF (DDFT) THEN ! Downdraft scheme based on (Cheng and Arakawa, 1997) CALL DDRFT( & & K, KP1, KD & @@ -2378,7 +2092,7 @@ SUBROUTINE CLOUD( & &, QRB, QRT, BUY, KBL, IDH, ETA, RNN, ETAI & &, ALM, WFN, TRAIN, DDFT & &, ETD, HOD, QOD, EVP, DOF, CLDFR, ETZ & - &, GMS, GSD, GHD, wvl, lprnt) + &, GMS, GSD, GHD, wvl) ENDIF ! @@ -2399,10 +2113,6 @@ SUBROUTINE CLOUD( & ENDIF -! if (lprnt) write(0,*) ' hod=',hod -! if (lprnt) write(0,*) ' etd=',etd -! if (lprnt) write(0,*) ' aft dd wvl=',wvl -! ! !===> CALCULATE GAMMAS i.e. TENDENCIES PER UNIT CLOUD BASE MASSFLUX ! Includes downdraft terms! @@ -2430,9 +2140,6 @@ SUBROUTINE CLOUD( & GMS(KD) = (DS + st1 - tem1*det*alhl-tem*alhf) * PRI(KD) GMH(KD) = PRI(KD) * (HCC-ETA(KD)*HOS + DH) - -! if (lprnt) write(0,*)' gmhkd=',gmh(kd),' gmskd=',gms(kd) -! &,' det=',det,' tem=',tem,' tem1=',tem1,' tem2=',tem2 ! ! TENDENCY FOR SUSPENDED ENVIRONMENTAL ICE AND/OR LIQUID WATER ! @@ -2473,10 +2180,6 @@ SUBROUTINE CLOUD( & GMH(L) = DH * PRI(L) GMS(L) = DS * PRI(L) -! if (lprnt) write(0,*)' gmh=',gmh(l),' gms=',gms(l) -! &,' dh=',dh,' ds=',ds,' qb=',qb,' qol=',qol(l),' eta=',eta(l) -! &,' hb=',hb,' hol=',hol(l),' l=',l,' hod=',hod(l) -! &,' etd=',etd(l),' qod=',qod(l),' tem5=',tem5,' tem6=',tem6 ! GHD(L) = TEM5 * PRI(L) GSD(L) = (TEM5 - ALHL * TEM6) * PRI(L) @@ -2493,21 +2196,12 @@ SUBROUTINE CLOUD( & GMH(LM1) = GMH(LM1) + DH * PRI(LM1) GMS(LM1) = GMS(LM1) + DS * PRI(LM1) -! -! if (lprnt) write(0,*)' gmh1=',gmh(l-1),' gms1=',gms(l-1) -! &,' dh=',dh,' ds=',ds,' qb=',qb,' qol=',qol(l-1) -! &,' hb=',hb,' hol=',hol(l-1),' evp=',evp(l-1) ! GHD(LM1) = GHD(LM1) - TEM5 * PRI(LM1) GSD(LM1) = GSD(LM1) - (TEM5-ALHL*(TEM6-EVP(LM1))) * PRI(LM1) QIL(LM1) = QIL(LM1) + TEM1 * PRI(LM1) QLL(LM1) = QLL(LM1) + TEM3 * PRI(LM1) - - -! if (lprnt) write(0,*)' gmh=',gmh(l),' gms=',gms(l) -! &,' dh=',dh,' ds=',ds,' qb=',qb,' qol=',qol(l),' eta=',eta(l) -! &,' hb=',hb,' hol=',hol(l),' l=',l ! avh = avh + gmh(lm1)*(prs(l)-prs(lm1)) @@ -2526,8 +2220,6 @@ SUBROUTINE CLOUD( & GHD(K) = GHD(K) + TEM1 GSD(K) = GSD(K) + TEM2 -! if (lprnt) write(0,*)' gmhk=',gmh(k),' gmsk=',gms(k) -! &,' tem1=',tem1,' tem2=',tem2,' dh=',dh,' ds=',ds ! avh = avh + gmh(K)*(prs(KP1)-prs(K)) ! @@ -2544,11 +2236,6 @@ SUBROUTINE CLOUD( & avh = avh + tx1*(prs(l+1)-prs(l)) ENDDO -! -! if (lprnt) then -! write(0,*)' gmh=',gmh -! write(0,*)' gms=',gms(KD:K) -! endif ! !*********************************************************************** !*********************************************************************** @@ -2611,7 +2298,6 @@ SUBROUTINE CLOUD( & ! qbl = qbl * hpert_fac ! endif -! if (lprnt) write(0,*)' hbla=',hbl,' qbla=',qbl !*********************************************************************** @@ -2683,10 +2369,6 @@ SUBROUTINE CLOUD( & ! AMB = - (WFN-ACR) / AKM ! -! if(lprnt) write(0,*)' wfn=',wfn,' acr=',acr,' akm=',akm & -! &,' amb=',amb,' KD=',kd,' cldfrd=',cldfrd & -! &,' rel_fac=',rel_fac,' prskd=',prs(kd),' revap=',revap - !===> RELAXATION AND CLIPPING FACTORS ! AMB = AMB * CLP * rel_fac @@ -2699,7 +2381,6 @@ SUBROUTINE CLOUD( & AMB = MAX(MIN(AMB, AMBMAX),ZERO) -! if(lprnt) write(0,*)' AMB=',amb,' clp=',clp,' ambmax=',ambmax !*********************************************************************** !*************************RESULTS*************************************** !*********************************************************************** @@ -2716,14 +2397,9 @@ SUBROUTINE CLOUD( & if (do_aw) then tx1 = (0.2 / max(alm, 1.0e-5)) tx2 = one - min(one, pi * tx1 * tx1 / area) -! if(lprnt) write(0,*)' kd=',kd,' alm=',alm,' tx1=',tx1 & -! &,' area=',area,' pi=',pi,' tx2=',tx2 tx2 = tx2 * tx2 -! if(lprnt) write(0,*)' kd=',kd,' wvl=',wvl(kd:k+1) -! if(lprnt) write(0,*)' kd=',kd,' eta=',eta(kd:k+1) -! if(lprnt) write(0,*)' kd=',kd,' rho=',rho(kd:k) ! comnet out the following for now - 07/23/18 ! do l=kd1,kbl ! lp1 = min(K, l+1) @@ -2744,7 +2420,6 @@ SUBROUTINE CLOUD( & else sigf(kd:k) = one endif -! if(lprnt) write(0,*)' for kd=',kd,'sigf=',sigf(kd:k) ! avt = zero avq = zero @@ -2752,11 +2427,9 @@ SUBROUTINE CLOUD( & ! DSFC = DSFC + AMB * ETD(K) * (one/DT) * sigf(kbl) ! -! DO L=KBL,KD,-1 DO L=K,KD,-1 PCU(L) = PCU(L) + AMB*RNN(L)*sigf(l) ! (A40) avr = avr + rnn(l) * sigf(l) -! if(lprnt) write(0,*)' avr=',avr,' rnn=',rnn(l),' l=',l ENDDO pcu(k) = pcu(k) + amb * dof * sigf(kbl) ! @@ -2795,9 +2468,6 @@ SUBROUTINE CLOUD( & ! avr = avr + (QLL(L) + QIL(L)*(1+alhf/alhl)) avr = avr + (QLL(L) + QIL(L)) * delp * sigf(l) * gravcon -! if(lprnt) write(0,*)' avr=',avr,' qll=',qll(l),' l=',l & -! &, ' qil=',qil(l) - ! Correction for negative condensate! if (qii(l) < zero) then tem = qii(l) * elfocp @@ -2836,29 +2506,10 @@ SUBROUTINE CLOUD( & ! endif ! -! -! if (lprnt) then -! write(0,*)' For KD=',KD -! avt = avt * cp * 100.0*86400.0 / (alhl*DT*grav) -! avq = avq * 100.0*86400.0 / (DT*grav) -! avr = avr * 86400.0 / DT -! write(0,*) ' avt=',avt,' avq=',avq,' avr=',avr,' avh=' & -! * ,avh,' alm=',alm,' DDFT=',DDFT,' KD=',KD & -! &,' TOIK-',toi(k),' TOIK-1=',toi(k-1),' TOIK-2=',toi(k-2) -! if (kd == 12 .and. .not. ddft) stop -! if (avh > 0.1 .or. abs(avt+avq) > 1.0e-5 .or. & -! & abs(avt-avr) > 1.0e-5 .or. abs(avr+avq) > 1.0e-5) stop -! -! if (lprnt) then -! write(0,*) ' in CLOUD For KD=',KD -! write(0,*) ' TCU=',(tcu(l),l=kd,k) -! write(0,*) ' QCU=',(Qcu(l),l=kd,k) -! endif ! TX1 = zero TX2 = zero ! -! if (lprnt) write(0,*)' revap=',revap IF (REVAP) THEN ! REEVAPORATION OF FALLING CONVECTIVE RAIN ! tem = zero @@ -2869,27 +2520,10 @@ SUBROUTINE CLOUD( & enddo tem = tem + amb * dof * sigf(kbl) tem = tem * (3600.0/dt) -!!!! tem1 = max(1.0, min(100.0,sqrt((5.0E10/max(area,one))))) -! tem1 = max(1.0, min(100.0,(7.5E10/max(area,one)))) -! tem1 = max(1.0, min(100.0,(5.0E10/max(area,one)))) -! tem1 = max(1.0, min(100.0,(4.0E10/max(area,one)))) -!! tem1 = sqrt(max(1.0, min(100.0,(4.0E10/max(area,one))))) ! 20100902 tem1 = sqrt(max(one, min(100.0,(6.25E10/max(area,one))))) ! 20110530 -! if (lprnt) write(0,*)' clfr0=',clf(tem),' tem=',tem,' tem1=', & -! & tem1 - -! clfrac = max(ZERO, min(ONE, rknob*clf(tem)*tem1)) -! clfrac = max(ZERO, min(0.25, rknob*clf(tem)*tem1)) clfrac = max(ZERO, min(half, rknob*clf(tem)*tem1)) -! if (lprnt) then -! write(0,*) ' cldfrd=',cldfrd,' amb=',amb,' clfrac=',clfrac -! write(0,*) ' tx3=',tx3,' etakd=',eta(kd),' pri=',pri(kd) -! write(0,*) ' RNN=',RNN(kd:k) -! endif -! -!cnt DO L=KD,K DO L=KD,KBL ! Testing on 20070926 ! for L=KD,K IF (L >= IDH .AND. DDFT) THEN @@ -2911,7 +2545,6 @@ SUBROUTINE CLOUD( & ST2 = ST1*ELFOCP + (one-ST1)*ELOCP CALL QSATCN ( TEQ,PL,QSTEQ,DQDT) -! CALL QSATCN ( TEQ,PL,QSTEQ,DQDT,.false.) ! DELTAQ = half * (QSTEQ*rhc_ls(l)-QEQ) / (one+ST2*DQDT) ! @@ -2922,7 +2555,6 @@ SUBROUTINE CLOUD( & TEM2 = TEM1*ELFOCP + (one-TEM1)*ELOCP CALL QSATCN ( TEQ,PL,QSTEQ,DQDT) -! CALL QSATCN ( TEQ,PL,QSTEQ,DQDT,.false.) ! DELTAQ = (QSTEQ*rhc_ls(l)-QEQ) / (one+TEM2*DQDT) ! @@ -2935,20 +2567,14 @@ SUBROUTINE CLOUD( & tem4 = zero if (tx1 > zero) & & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778 ) ) -! & TEM4 = POTEVAP * (1. - EXP( AFC*tx4*SQRT(TX1) ) ) ACTEVAP = MIN(TX1, TEM4*CLFRAC) -! if(lprnt) write(0,*)' L=',L,' actevap=',actevap,' tem4=',tem4, & -! &' clfrac=' & -! &,clfrac,' potevap=',potevap,'efac=',AFC*SQRT(TX1*TEM3) & -! &,' tx1=',tx1 if (tx1 < rainmin*dt) actevap = min(tx1, potevap) ! tem4 = zero if (tx2 > zero) & & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778 ) ) -! & TEM4 = POTEVAP * (1. - EXP( AFC*tx4*SQRT(TX2) ) ) TEM4 = min(MIN(TX2, TEM4*CLDFRD), potevap-actevap) if (tx2 < rainmin*dt) tem4 = min(tx2, potevap-actevap) ! @@ -2974,10 +2600,6 @@ SUBROUTINE CLOUD( & CUP = CUP + TX1 + DOF * AMB * sigf(kbl) ENDIF -! if (lprnt) write(0,*)' tx1=',tx1,' tx2=',tx2,' dof=',dof & -! &,' cup=',cup*86400/dt,' amb=',amb & -! &,' amb=',amb,' cup=',cup,' clfrac=',clfrac,' cldfrd=',cldfrd & -! &,' ddft=',ddft,' kd=',kd,' kbl=',kbl,' k=',k ! ! Convective transport (mixing) of passive tracers ! @@ -3062,30 +2684,11 @@ SUBROUTINE CLOUD( & st2 = zero endif -! ROI(L,N) = HOL(L) + ST1 -! RCU(L,N) = RCU(L,N) + ST1 - -! if (l < k) then -! if (lprnt .and. n == ntk) write(0,*)' in ras roifin=',roi(l,n), -! &' hol=',hol(l),' gmh=',GMH(L),' amb=',amb,' l=',l -! &,' st2=',st2,' st3=',st3,' trcmin=',trcmin(n) -! &,' roi=',roi(l,n),' n=',n,' prl=',prl(l+1),prl(l),' pri=', -! & pri(l+1) -! else -! if (lprnt .and. n == ntk) write(0,*)' in ras roifin=',roi(l,n), -! &' hol=',hol(l),' gmh=',GMH(L),' amb=',amb,' l=',l -! &,' st2=',st2,' st3=',st3,' trcmin=',trcmin(n) -! &,' roi=',roi(l,n),' n=',n -! endif - ENDDO ENDDO ! Tracer loop NTRC endif endif ! amb > zero -! if (lprnt) write(0,*)' toio=',toi -! if (lprnt) write(0,*)' qoio=',qoi - RETURN end subroutine cloud @@ -3097,7 +2700,7 @@ SUBROUTINE DDRFT( & &, QRB, QRT, BUY, KBL, IDH, ETA, RNN, ETAI & &, ALM, WFN, TRAIN, DDFT & &, ETD, HOD, QOD, EVP, DOF, CLDFRD, WCB & - &, GMS, GSD, GHD, wvlu, lprnt) + &, GMS, GSD, GHD, wvlu) ! !*********************************************************************** @@ -3172,7 +2775,6 @@ SUBROUTINE DDRFT( & parameter (ERRMIN=0.0001, ERRMI2=0.1*ERRMIN) ! parameter (ERRMIN=0.00001, ERRMI2=0.1*ERRMIN) ! - real (kind=kind_phys), parameter :: PIINV=one/PI ! real (kind=kind_phys), parameter :: PIINV=one/PI, pio2=half*pi ! parameter (ONPG=one+half, GMF=one/ONPG, RPART=zero) @@ -3200,11 +2802,10 @@ SUBROUTINE DDRFT( & real(kind=kind_phys) ELM(K), AA(KD:K,KD:KP1), QW(KD:K,KD:K) & &, VT(2), VRW(2), TRW(2), QA(3), WA(3) - LOGICAL SKPUP, cnvflg, DDFT, UPDRET, DDLGK, lprnt + LOGICAL SKPUP, cnvflg, DDFT, UPDRET, DDLGK !*********************************************************************** -! if(lprnt) write(0,*)' K=',K,' KD=',KD,' In Downdrft' KD1 = KD + 1 KM1 = K - 1 @@ -3342,10 +2943,6 @@ SUBROUTINE DDRFT( & tla = tla + del_tla STLA = SIN(TLA*deg2rad) ! sine of tilting angle CTL2 = one - STLA * STLA ! cosine square of tilting angle -! -! if (lprnt) write(0,*)' tla=',tla,' al2=',al2,' ptop=' & -! &,0.5*(prl(kd)+prl(kd1)),' ntla=',ntla,' f2=',f2,' stla=',stla & -! if (lprnt) write(0,*)' buy=',(buy(l),l=kd,kbl) ! STLA = F2 * STLA * AL2 CTL2 = DD1 * CTL2 @@ -3383,7 +2980,6 @@ SUBROUTINE DDRFT( & ST1 = WCB(L) + QW(L,L)*QRP(L) + TX1*GSD(L) ! if (st1 > wc2min) then if (st1 > zero) then -! if (lprnt) write(0,*)' l=',l,' st1=',st1,' wvl=',wvl(l) WVL(L) = max(ddunc1*SQRT(ST1) + ddunc2*WVL(L), wcmin) ! WVL(L) = SQRT(ST1) ! WVL(L) = max(half * (SQRT(ST1) + WVL(L)), wcmin) @@ -3391,10 +2987,6 @@ SUBROUTINE DDRFT( & ! & + qrp(l)) else -! if (lprnt) write(0,*)' l=',l,' st1=',st1,' wcb=',wcb(l),' qw='& -! &,qw(l,l),' qrp=',qrp(l),' tx1=',tx1,' gsd=',gsd(l),' itr=',itr & -! &,' wvl=',wvl(l) - ! wvl(l) = 0.5*(wcmin+wvl(l)) ! wvl(l) = max(half*(wvl(l) + wvl(l+1)), wcmin) wvl(l) = max(wvl(l),wcmin) @@ -3408,14 +3000,6 @@ SUBROUTINE DDRFT( & QRPI(L) = one / QRP(L) ENDDO ! -! if (lprnt) then -! write(0,*) ' ITR=',ITR,' ITRMU=',ITRMU,' kd=',kd,' kbl=',kbl -! write(0,*) ' WVL=',(WVL(L),L=KD,KBL) -! write(0,*) ' qrp=',(qrp(L),L=KD,KBL) -! write(0,*) ' qrpi=',(qrpi(L),L=KD,KBL) -! write(0,*) ' rnf=',(rnf(L),L=KD,KBL) -! endif -! !-----CALCULATING TRW, VRW AND OF ! ! VT(1) = GMS(KD) * QRP(KD)**0.1364 @@ -3652,8 +3236,6 @@ SUBROUTINE DDRFT( & KK1 = KK + 1 AA(KK,KK1) = AA(KK,KK1) / AA(KK,KK) ! Qr correction ! TX2 = ABS(AA(KK,KK1)) * QRPI(KK) ! Error Measure ! -! if (lprnt) write(0,*) ' tx2a=',tx2,' aa1=',aa(kk,kk1) & -! &,' qrpi=',qrpi(kk) ! KK = KBL + 1 DO L=KB1,KD,-1 @@ -3664,10 +3246,6 @@ SUBROUTINE DDRFT( & ENDDO AA(L,KK) = (AA(L,KK) - TX1) / AA(L,L) ! Qr correction ! TX2 = MAX(TX2, ABS(AA(L,KK))*QRPI(L)) ! Error Measure ! - -! if (lprnt) write(0,*)' tx2b=',tx2,' aa1=',aa(l,kk) & -! &,' qrpi=',qrpi(l),' L=',L - ENDDO ! ! tem = 0.5 @@ -3684,8 +3262,6 @@ SUBROUTINE DDRFT( & QRP(L) = MAX(QRP(L)+AA(L,KBL+1)*tem, QRMIN) ENDDO ! -! if (lprnt) write(0,*)' itr=',itr,' tx2=',tx2 - IF (ITR < ITRMIN) THEN TEM = ABS(ERRQ-TX2) IF (TEM >= ERRMI2 .AND. TX2 >= ERRMIN) THEN @@ -3693,8 +3269,6 @@ SUBROUTINE DDRFT( & ELSE SKPUP = .TRUE. ! Converges ! ERRQ = zero ! Rain profile exists! -! if (lprnt) write(0,*)' here1',' tem=',tem,' tx2=',tx2,' errmi2=', & -! &errmi2,' errmin=',errmin ENDIF ELSE TEM = ERRQ - TX2 @@ -3702,14 +3276,12 @@ SUBROUTINE DDRFT( & IF (TEM < ZERO .AND. ERRQ > 0.5) THEN ! IF (TEM < ZERO .and. & ! & (ntla < numtla .or. ERRQ > 0.5)) THEN -! if (lprnt) write(0,*)' tx2=',tx2,' errq=',errq,' tem=',tem SKPUP = .TRUE. ! No convergence ! ERRQ = 10.0 ! No rain profile! !!!! ELSEIF (ABS(TEM) < ERRMI2 .OR. TX2 < ERRMIN) THEN ELSEIF (TX2 < ERRMIN) THEN SKPUP = .TRUE. ! Converges ! ERRQ = zero ! Rain profile exists! -! if (lprnt) write(0,*)' here2' elseif (tem < zero .and. errq < 0.1) then skpup = .true. ! if (ntla == numtla .or. tem > -0.003) then @@ -3719,23 +3291,14 @@ SUBROUTINE DDRFT( & ! endif ELSE ERRQ = TX2 ! Further iteration ! -! if (lprnt) write(0,*)' itr=',itr,' errq=',errq ! if (itr == itrmu .and. ERRQ > ERRMIN*10 & ! & .and. ntla == 1) ERRQ = 10.0 ENDIF ENDIF ! -! if (lprnt) write(0,*)' ERRQ=',ERRQ - ENDIF ! SKPUP ENDIF! ! ENDDO ! End of the ITR Loop!! -! -! if(lprnt) then -! write(0,*)' QRP=',(QRP(L),L=KD,KBL) -! write(0,*)'RNF=',(RNF(L),L=KD,KBL),' RNT=',RNT,' RNB=',RNB & -! &,' errq=',errq -! endif ! IF (ERRQ < 0.1) THEN DDFT = .TRUE. @@ -3757,9 +3320,7 @@ SUBROUTINE DDRFT( & DO L=KD,KB1 TX1 = TX1 + RNF(L) ENDDO -! if (lprnt) write(0,*)' tx1+rnt+rnb=',tx1+rnt+rnb, ' train=',train TX1 = TRAIN / (TX1+RNT+RNB) -! if (lprnt) write(0,*)' tx1= ', tx1 IF (ABS(TX1-one) < 0.2) THEN RNT = MAX(RNT*TX1,ZERO) RNB = RNB * TX1 @@ -3768,9 +3329,6 @@ SUBROUTINE DDRFT( & ENDDO ! rain flux adjustment is over -! if (lprnt) write(0,*)' TRAIN=',TRAIN -! if (lprnt) write(0,*)' RNF=',RNF - ELSE DDFT = .FALSE. ERRQ = 10.0 @@ -3789,7 +3347,6 @@ SUBROUTINE DDRFT( & wvlu(kd:kp1) = wvl(kd:kp1) ! save updraft vertical velocity for output -! if (lprnt) write(0,*)' in ddrft kd=',kd,'wvlu=',wvlu(kd:kp1) ! ! Downdraft calculation begins ! ---------------------------- @@ -3814,7 +3371,6 @@ SUBROUTINE DDRFT( & STLT(L) = zero ENDIF ENDDO -! if (lprnt) write(0,*)' STLT=',stlt rsum1 = zero rsum2 = zero @@ -3839,9 +3395,6 @@ SUBROUTINE DDRFT( & RNTP = zero TX5 = TX1 QA(1) = zero -! if(lprnt) write(0,*)' stlt=',stlt(kd),' qrb=',qrb(kd) & -! &,' tx1=',tx1,' ror=',ror(kd),' gms=',gms(kd),' rpart=',rpart & -! &,' rnt=',rnt ! ! Here we assume RPART of detrained rain RNT goes to Pd ! @@ -3899,9 +3452,6 @@ SUBROUTINE DDRFT( & ! VT(1) = GMS(L-1) * QRP(L-1) ** 0.1364 VT(1) = GMS(L-1) * QRPF(QRP(L-1)) RNT = ROR(L-1) * (WVL(L-1)+VT(1))*QRP(L-1) -! if(lprnt) write(0,*)' l=',l,' qa=',qa(1), ' tx1RNT=',RNT*tx1,& -! &' wvl=',wvl(l-1) & -! &,' qrp=',qrp(l-1),' tx5=',tx5,' tx1=',tx1,' rnt=',rnt ! @@ -3979,8 +3529,6 @@ SUBROUTINE DDRFT( & ! ! Iteration loop for a given level L begins ! -! if (lprnt) write(0,*)' tx8=',tx8,' tx9=',tx9,' tx5=',tx5 & -! &, ' tx1=',tx1 else DO ITR=1,ITRMD ! @@ -4002,9 +3550,6 @@ SUBROUTINE DDRFT( & TEM2 = TX8 ST1 = zero ENDIF -! if (lprnt) write(0,*)' st1=',st1,' tem=',tem,' ror=',ror(l) & -! &,' qrp=',qrp(l),' rnt=',rnt,' ror1=',ror(l-1),' wvl=',wvl(l) & -! &,' wvl1=',wvl(l-1),' tem2=',tem2,' vt=',vt(1),' tx3=',tx3 ! st2 = tx5 TEM = ROR(L)*WVL(L) - ROR(L-1)*WVL(L-1) @@ -4023,17 +3568,6 @@ SUBROUTINE DDRFT( & ! else ! TX5 = (TX1 - tem*tx6 - ST1 + TEM2 + TX3) ! endif -! -! if(lprnt) write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' & -! if(tx5 <= 0.0 .and. l > kd+2) & -! & write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' & -! &,tem2,' tx3=',tx3,' tem=',tem,' tem1=',tem1,' wvl=',wvl(l-1), & -! &wvl(l),' l=',l,' itr=',itr,' evp=',evp(l-1),' vt=',vt(1) & -! &,' qrp=',qrp(l),' rnt=',rnt,' kd=',kd -! if (lprnt) write(0,*)' etd=',etd(l),' wvl=',wvl(l) & -! &,' trw=',trw(1),trw(2),' ror=',ror(l),' wa=',wa - - ! TEM1 = ETD(L) ETD(L) = ROR(L) * TX5 * MAX(WVL(L),ZERO) @@ -4077,8 +3611,6 @@ SUBROUTINE DDRFT( & ENDIF ERRH = HOD(L) - TEM1 ERRQ = ABS(ERRH/HOD(L)) + ABS(ERRE/MAX(ETD(L),ONE_M5)) -! if (lprnt) write(0,*)' ERRQP=',errq,' errh=',errh,' hod=',hod(l) & -! &,' erre=',erre,' etd=',etd(l),' del_eta=',del_eta DOF = DDZ VT(2) = QQQ ! @@ -4120,9 +3652,6 @@ SUBROUTINE DDRFT( & EVP(L-1) = (QOD(L)-TEM4) * (ETD(L)+DDZ) ! Calculate Pd (L+1/2) QA(1) = TX1*RNT + RNF(L-1) - EVP(L-1) -! -! if(lprnt) write(0,*)' etd=',etd(l),' tx5=',tx5,' rnt=',rnt & -! &,' rnf=',rnf(l-1),' evp=',evp(l-1),' itr=',itr,' L=',L ! if (qa(1) > zero) then IF (ETD(L) > zero) THEN @@ -4140,9 +3669,6 @@ SUBROUTINE DDRFT( & ! Compute Buoyancy TEM1 = WA(3) + (HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & & * onebcp -! if (lprnt) write(0,*)' tem1=',tem1,' wa3=',wa(3),' hod=' & -! &,hod(l),' wa1=',wa(1),' qod=',qod(l),' wa2=',wa(2),' alhl=',alhl & -! &,' cmpor=',cmpor,' dofw=',dofw,' prl=',prl(l),' qrp=',qrp(l) TEM1 = TEM1 * (one + NU*QOD(L)) ROR(L) = CMPOR * PRL(L) / TEM1 TEM1 = TEM1 * DOFW @@ -4152,14 +3678,8 @@ SUBROUTINE DDRFT( & ! Compute W (L+1/2) TEM1 = WVL(L) -! IF (ETD(L) > 0.0) THEN WVL(L) = VT(2) * (ETD(L-1)*WVL(L-1) - FACG & & * (BUY(L-1)*QRT(L-1)+BUY(L)*QRB(L-1))) -! -! if (lprnt) write(0,*)' wvl=',wvl(l),'vt2=',vt(2),' buy1=' & -! &,buy(l-1),' buy=',buy(l),' qrt1=',qrt(l-1),' qrb1=',qrb(l-1) & -! &,' etd1=',etd(l-1),' wvl1=',wvl(l-1) -! ENDIF ! if (wvl(l) < zero) then ! WVL(L) = max(wvl(l), 0.1*tem1) @@ -4178,20 +3698,9 @@ SUBROUTINE DDRFT( & ! ERRQ = ERRQ + ABS(ERRW/MAX(WVL(L),ONE_M5)) -! if (lprnt) write(0,*)' errw=',errw,' wvl=',wvl(l) -! if(lprnt .or. tx5 == 0.0) then -! if(tx5 == 0.0 .and. l > kbl) then -! write(0,*)' errq=',errq,' itr=',itr,' l=',l,' wvl=',wvl(l) & -! &,' tx5=',tx5,' idnm=',idnm,' etd1=',etd(l-1),' etd=',etd(l) & -! &,' kbl=',kbl -! endif -! -! if(lprnt) write(0,*)' itr=',itr,' itrmnd=',itrmnd,' itrmd=',itrmd ! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN -! if(lprnt) write(0,*)' itr=',itr,' etd1=',etd(l-1),' errq=',errq IF (ETD(L-1) == zero .AND. ERRQ > 0.2) THEN -! if(lprnt) write(0,*)' bud=',bud(kd),' wa=',wa(1),wa(2) ROR(L) = BUD(KD) ETD(L) = zero WVL(L) = zero @@ -4206,24 +3715,11 @@ SUBROUTINE DDRFT( & & + STLT(KBL) * QRB(KB1)) * (0.5*FAC) endif -! if(lprnt) write(0,*)' tx1=',tx1,' rnt=',rnt,' rnf=',rnf(l-1) & -! &,' evp=',evp(l-1),' l=',l - EVP(L-1) = zero TEM = MAX(TX1*RNT+RNF(L-1),ZERO) QA(1) = TEM - EVP(L-1) ! IF (QA(1) > 0.0) THEN -! if(lprnt) write(0,*)' ror=',ror(l),' tx5=',tx5,' tx1=',tx1 & -! &,' tx9=',tx9,' gms=',gms(l),' qa=',qa(1) -! if(lprnt) call mpi_quit(13) -! if (tx5 == 0.0 .or. gms(l) == 0.0) -! if (lprnt) & -! & write(0,*)' Atx5=',tx5,' gms=',gms(l),' ror=',ror(l) & -! &,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & -! &,' kbl=',kbl,' etd1=',etd(l-1),' idnm=',idnm,' idn=',idn(idnm) & -! &,' errq=',errq - QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & & ** (one/1.1364) ! endif @@ -4294,13 +3790,6 @@ SUBROUTINE DDRFT( & QA(1) = QA(1) - EVP(L-1) qrp(l) = zero -! -! if (tx5 == 0.0 .or. gms(l) == 0.0) -! if (lprnt) & -! & write(0,*)' Btx5=',tx5,' gms=',gms(l),' ror=',ror(l) & -! &,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & -! &,' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA & -! &,' evp=',evp(l-1) ! ! IF (QA(1) > 0.0) THEN !! RNS(L-1) = QA(1) @@ -4381,12 +3870,6 @@ SUBROUTINE DDRFT( & endif ENDIF -! if (lprnt) then -! write(0,*)' ERRQ=',ERRQ,' IDN=',IDN(idnm),' idnm=',idnm -! write(0,*)' L=',L,' QRP=',QRP(L),' ETD=',ETD(L),' QA=',QA(1) & -! &, ' evp=',evp(l-1),' rnf=',rnf(l-1) -! endif - ! ! If downdraft properties are not obtainable, (i.e.solution does ! not converge) , no downdraft is assumed @@ -4422,7 +3905,6 @@ SUBROUTINE DDRFT( & TX1 = EVP(KD) TX2 = RNTP + RNB + DOF -! if (lprnt) write(0,*)' tx2=',tx2 II = IDH IF (II >= KD1+1) THEN RNN(KD) = RNN(KD) + RNF(KD) @@ -4430,7 +3912,6 @@ SUBROUTINE DDRFT( & RNN(II-1) = zero TX1 = EVP(II-1) ENDIF -! if (lprnt) write(0,*)' tx2=',tx2,' idnm=',idnm,' idn=',idn(idnm) DO L=KD,K II = IDH @@ -4449,7 +3930,6 @@ SUBROUTINE DDRFT( & RNN(L) = RNF(L) + RNS(L) TX2 = TX2 + RNN(L) ENDIF -! if (lprnt) write(0,*)' tx2=',tx2,' L=',L,' rnn=',rnn(l) ENDDO ! ! For Downdraft case the rain is that falls thru the bottom @@ -4464,8 +3944,6 @@ SUBROUTINE DDRFT( & ! conservation of precip! ! -! if (lprnt) write(0,*)' train=',train,' tx2=',tx2,' tx1=',tx1 - IF (TX1 > zero) THEN TX1 = (TRAIN - TX2) / TX1 ELSE @@ -4485,7 +3963,6 @@ SUBROUTINE DDRFT( & end subroutine ddrft SUBROUTINE QSATCN(TT,P,Q,DQDT) -! SUBROUTINE QSATCN(TT,P,Q,DQDT,lprnt) ! USE FUNCPHYS , ONLY : fpvs @@ -4493,12 +3970,11 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) ! real(kind=kind_phys) TT, P, Q, DQDT ! - real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & - &, rvi=one/rv, facw=CVAP-CLIQ & - &, faci=CVAP-CSOL, hsub=alhl+alhf & - &, tmix=TTP-20.0 & - &, DEN=one/(TTP-TMIX) -! logical lprnt +! real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & +! &, rvi=one/rv, facw=CVAP-CLIQ & +! &, faci=CVAP-CSOL, hsub=alhl+alhf & +! &, tmix=TTP-20.0 & +! &, DEN=one/(TTP-TMIX) ! real(kind=kind_phys) es, d, hlorv, W ! @@ -4508,9 +3984,6 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) D = one / (p+epsm1*es) ! q = MIN(eps*es*D, ONE) - -! if (lprnt) write(0,*)' q=',q,' eps=',eps,' es=',es,' d=',d, & -! &' one=',one,' tt=',tt,' p=',p,' epsm1=',epsm1,' fpvs=',fpvs(tt) ! W = max(ZERO, min(ONE, (TT - TMIX)*DEN)) hlorv = ( W * (alhl + FACW * (tt-ttp)) & @@ -4521,7 +3994,6 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) end subroutine qsatcn SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) -! use module_ras , only : refp, refr, tlac, plac, tlbpl, drdp implicit none real(kind=kind_phys) PRES, ALM, AL2, TLA, TEM @@ -4572,7 +4044,6 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) end subroutine angrad SUBROUTINE SETQRP -! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB,one implicit none real(kind=kind_phys) tem2,tem1,x,xinc,xmax,xmin @@ -4597,7 +4068,6 @@ SUBROUTINE SETQRP end subroutine setqrp SUBROUTINE QRABF(QRP,QRAF,QRBF) -! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB, one implicit none ! real(kind=kind_phys) QRP, QRAF, QRBF, XJ, REAL_NQRP @@ -4614,7 +4084,6 @@ SUBROUTINE QRABF(QRP,QRAF,QRBF) end subroutine qrabf SUBROUTINE SETVTP -! use module_ras , only : NVTP,C1XVTP,C2XVTP,TBVTP implicit none real(kind=kind_phys), parameter :: vtpexp=-0.3636, one=1.0 diff --git a/physics/rascnv.meta b/physics/rascnv.meta index 7201888bc..0a201e74d 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -18,6 +18,132 @@ kind = kind_phys intent = in optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_ttp] + standard_name = triple_point_temperature_of_water + long_name = triple point temperature of water + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -241,22 +367,6 @@ type = integer intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F [kdt] standard_name = index_of_time_step long_name = current forecast iteration From 85b04fb327d5c651d527ac5d79efc8d824be3a6d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 30 Jan 2020 15:44:51 -0700 Subject: [PATCH 15/24] Adjust long names for hydrometeors --- physics/GFS_suite_interstitial.meta | 6 ++--- physics/cs_conv.meta | 6 ++--- physics/cu_gf_driver.meta | 4 ++-- physics/gfdl_cloud_microphys.meta | 2 +- physics/gscond.meta | 4 ++-- physics/m_micro.meta | 14 ++++++------ physics/m_micro_interstitial.meta | 34 ++++++++++++++--------------- physics/module_MYNNPBL_wrapper.meta | 4 ++-- physics/module_MYNNSFC_wrapper.meta | 2 +- physics/module_MYNNrad_post.meta | 8 +++---- physics/module_MYNNrad_pre.meta | 8 +++---- physics/mp_fer_hires.meta | 6 ++--- physics/sascnvn.meta | 4 ++-- physics/sfc_drv_ruc.meta | 2 +- physics/shalcnv.meta | 4 ++-- 15 files changed, 54 insertions(+), 54 deletions(-) diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index f8a8109da..9cda625ab 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -534,7 +534,7 @@ optional = F [qgrs_cloud_water] standard_name = cloud_condensed_water_mixing_ratio - long_name = mixing ratio of cloud water (condensate) + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -1457,7 +1457,7 @@ optional = F [save_qc] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -1690,7 +1690,7 @@ optional = F [save_qc] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta index 8d6ea6804..d499885c7 100644 --- a/physics/cs_conv.meta +++ b/physics/cs_conv.meta @@ -54,7 +54,7 @@ optional = F [clw1] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -63,7 +63,7 @@ optional = F [clw2] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -144,7 +144,7 @@ optional = F [save_q2] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 808f80f7a..cce69c43b 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -280,7 +280,7 @@ optional = F [cliw] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -289,7 +289,7 @@ optional = F [clcw] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = mixing ratio of cloud water in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/gfdl_cloud_microphys.meta b/physics/gfdl_cloud_microphys.meta index 7f31637bf..3d202722b 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/gfdl_cloud_microphys.meta @@ -235,7 +235,7 @@ optional = F [gq0_ntgl] standard_name = graupel_mixing_ratio_updated_by_physics - long_name = moist mixing ratio of graupel updated by physics + long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/gscond.meta b/physics/gscond.meta index a25c268b3..f2046df0a 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -82,7 +82,7 @@ optional = F [clw1] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -91,7 +91,7 @@ optional = F [clw2] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 7fc28c8a9..749b627f7 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -389,7 +389,7 @@ optional = F [qlls_i] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -407,7 +407,7 @@ optional = F [qils_i] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -596,7 +596,7 @@ optional = F [lwm_o] standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = mixing ratio of cloud condensed water updated by physics + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -605,7 +605,7 @@ optional = F [qi_o] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = mixing ratio of ice water updated by physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -667,7 +667,7 @@ optional = F [rnw_io] standard_name = local_rain_water_mixing_ratio - long_name = mixing ratio of rain water local to physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -676,7 +676,7 @@ optional = F [snw_io] standard_name = local_snow_water_mixing_ratio - long_name = mixing ratio of snow water local to physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -685,7 +685,7 @@ optional = F [qgl_io] standard_name = local_graupel_mixing_ratio - long_name = mixing ratio of graupel local to physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/m_micro_interstitial.meta b/physics/m_micro_interstitial.meta index 4749ff128..0b5b56b2f 100644 --- a/physics/m_micro_interstitial.meta +++ b/physics/m_micro_interstitial.meta @@ -56,7 +56,7 @@ optional = F [gq0_ice] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = mixing ratio of ice water updated by physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -65,7 +65,7 @@ optional = F [gq0_water] standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = mixing ratio of cloud condensed water updated by physics + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -74,7 +74,7 @@ optional = F [gq0_rain] standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = mixing ratio of rain water updated by physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -83,7 +83,7 @@ optional = F [gq0_snow] standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = mixing ratio of snow water updated by physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -92,7 +92,7 @@ optional = F [gq0_graupel] standard_name = graupel_mixing_ratio_updated_by_physics - long_name = mixing ratio of graupel updated by physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -182,7 +182,7 @@ optional = F [qrn] standard_name = local_rain_water_mixing_ratio - long_name = mixing ratio of rain water local to physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -191,7 +191,7 @@ optional = F [qsnw] standard_name = local_snow_water_mixing_ratio - long_name = mixing ratio of snow water local to physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -200,7 +200,7 @@ optional = F [qgl] standard_name = local_graupel_mixing_ratio - long_name = mixing ratio of graupel local to physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -245,7 +245,7 @@ optional = F [clw_water] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -254,7 +254,7 @@ optional = F [clw_ice] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -363,7 +363,7 @@ optional = F [qrn] standard_name = local_rain_water_mixing_ratio - long_name = mixing ratio of rain water local to physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -372,7 +372,7 @@ optional = F [qsnw] standard_name = local_snow_water_mixing_ratio - long_name = mixing ratio of snow water local to physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -381,7 +381,7 @@ optional = F [qgl] standard_name = local_graupel_mixing_ratio - long_name = mixing ratio of graupel local to physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -390,7 +390,7 @@ optional = F [gq0_ice] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = mixing ratio of ice water updated by physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -399,7 +399,7 @@ optional = F [gq0_rain] standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = mixing ratio of rain water updated by physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -408,7 +408,7 @@ optional = F [gq0_snow] standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = mixing ratio of snow water updated by physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -417,7 +417,7 @@ optional = F [gq0_graupel] standard_name = graupel_mixing_ratio_updated_by_physics - long_name = mixing ratio of graupel updated by physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index a202b4bef..fb145afd5 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -157,7 +157,7 @@ optional = F [qgrs_liquid_cloud] standard_name = cloud_condensed_water_mixing_ratio - long_name = mixing ratio of cloud water (condensate) + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -166,7 +166,7 @@ optional = F [qgrs_ice_cloud] standard_name = ice_water_mixing_ratio - long_name = mixing ratio of ice water + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 3cd1781a3..da86a054b 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -105,7 +105,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio - long_name = mixing ratio of cloud water (condensate) + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_MYNNrad_post.meta b/physics/module_MYNNrad_post.meta index 79aa27ff3..f6d1a41d7 100644 --- a/physics/module_MYNNrad_post.meta +++ b/physics/module_MYNNrad_post.meta @@ -43,7 +43,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio - long_name = no condensates) mixing ratio of cloud water (condensate) + long_name = no condensates) ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -52,7 +52,7 @@ optional = F [qi] standard_name = ice_water_mixing_ratio - long_name = mixing ratio of ice water + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -61,7 +61,7 @@ optional = F [qc_save] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -70,7 +70,7 @@ optional = F [qi_save] standard_name = ice_water_mixing_ratio_save - long_name = mixing ratio of ice water before entering a physics scheme + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_MYNNrad_pre.meta b/physics/module_MYNNrad_pre.meta index a08174a7a..3b6a9ccbc 100644 --- a/physics/module_MYNNrad_pre.meta +++ b/physics/module_MYNNrad_pre.meta @@ -43,7 +43,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio - long_name = mixing ratio of cloud water (condensate) + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -52,7 +52,7 @@ optional = F [qi] standard_name = ice_water_mixing_ratio - long_name = mixing ratio of ice water + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -70,7 +70,7 @@ optional = F [qc_save] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -79,7 +79,7 @@ optional = F [qi_save] standard_name = ice_water_mixing_ratio_save - long_name = mixing ratio of ice water before entering a physics scheme + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index 36b40a95c..a7a33378a 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -268,7 +268,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -277,7 +277,7 @@ optional = F [qi] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -286,7 +286,7 @@ optional = F [qr] standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta index 48c56d4b9..f330dd94d 100644 --- a/physics/sascnvn.meta +++ b/physics/sascnvn.meta @@ -222,7 +222,7 @@ optional = F [qlc] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -231,7 +231,7 @@ optional = F [qli] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 7b9c1e360..6eaadfbb4 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -429,7 +429,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio_at_lowest_model_layer - long_name = mixing ratio of cloud water at lowest model layer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) at lowest model layer units = kg kg-1 dimensions = (horizontal_dimension) type = real diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta index a8f8a8ba3..533b9cd0e 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -238,7 +238,7 @@ optional = F [qlc] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -247,7 +247,7 @@ optional = F [qli] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real From 5c7252fc206274da9601eea2d89eae496b86d2ea Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 30 Jan 2020 17:35:48 -0700 Subject: [PATCH 16/24] Restore scientific documentation in physics/micro_mg3_0.F90 --- physics/micro_mg3_0.F90 | 600 +++++++++++++++++++++------------------- 1 file changed, 310 insertions(+), 290 deletions(-) diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 047f9ef8a..5c7b7ceee 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -1,75 +1,75 @@ -module micro_mg3_0 -!--------------------------------------------------------------------------------- -! Purpose: -! MG microphysics version 3.0 - Update of MG microphysics with -! prognostic hail OR graupel. -! -! Author: Andrew Gettelman, Hugh Morrison -! -! -! Version 3 history: Sep 2016: development begun for hail, graupel -! This version:https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/mg3_tags/mg3_33_cam5_4_153/ -! -! Version 2 history: Sep 2011: Development begun. -! Feb 2013: Added of prognostic precipitation. -! Aug 2015: Published and released version -! Contributions from: Sean Santos, Peter Caldwell, Xiaohong Liu and Steve Ghan -! -! Anning Cheng adopted mg2 for FV3GFS 9/29/2017 -! add GMAO ice conversion and Liu et. al liquid water -! conversion in 10/12/2017 -! Anning showed promising results for FV3GFS on 10/15/2017 -! S. Moorthi - Oct/Nov 2017 - optimized the MG2 code -! S. Moorthi - Nov 2017 - made the sedimentation quasi-implicit -! S. Moorthi - Feb 2018 - updated to MG3 - modified graupel sedimentation -! other modifications to eliminate blowup. -! S. Moorthi - Mar 2018 - fixed a few bugs and added option to run as MG2 -! S. Moorthi - Oct,29,2018 - change nlb from nlev/3 to levels with p/ps < 0.05 (nlball) -! -! invoked in CAM by specifying -microphys=mg3 -! -! References: -! -! Gettelman, A. and H. Morrison, Advanced Two-Moment Microphysics for Global Models. -! -! Part I: Off line tests and comparisons with other schemes. -! -! J. Climate, 28, 1268-1287. doi: 10.1175/JCLI-D-14-00102.1, 2015. -! -! -! -! Gettelman, A., H. Morrison, S. Santos, P. Bogenschutz and P. H. Caldwell -! -! Advanced Two-Moment Microphysics for Global Models. -! -! Part II: Global model solutions and Aerosol-Cloud Interactions. -! -! J. Climate, 28, 1288-1307. doi:10.1175/JCLI-D-14-00103.1 , 2015. -! -! for questions contact Hugh Morrison, Andrew Gettelman -! e-mail: morrison@ucar.edu, andrew@ucar.edu -!--------------------------------------------------------------------------------- -! -! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice -! microphysics in cooperation with the MG liquid microphysics. This is -! controlled by the do_cldice variable. -! -! If do_cldice is false, then MG microphysics should not update CLDICE or -! NUMICE; it is assumed that the other microphysics scheme will have updated -! CLDICE and NUMICE. The other microphysics should handle the following -! processes that would have been done by MG: -! - Detrainment (liquid and ice) -! - Homogeneous ice nucleation -! - Heterogeneous ice nucleation -! - Bergeron process -! - Melting of ice -! - Freezing of cloud drops -! - Autoconversion (ice -> snow) -! - Growth/Sublimation of ice -! - Sedimentation of ice -! -! This option has not been updated since the introduction of prognostic -! precipitation, and probably should be adjusted to cover snow as well. +!>\file micro_mg3_0.F90 +!! This file contains Morrison-Gettelman MP version 3.0 - +!! Update of MG microphysics with prognostic hail OR graupel. + +!>\ingroup mg2mg3 +!>\defgroup mg3_mp Morrison-Gettelman MP version 3.0 +!> @{ +!!--------------------------------------------------------------------------------- +!! Purpose: +!! MG microphysics version 3.0 - Update of MG microphysics with +!! prognostic hail OR graupel. +!! +!! \authors Andrew Gettelman, Hugh Morrison +!! +!! \version 3 history: Sep 2016: development begun for hail, graupel +!! This version:https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/mg3_tags/mg3_33_cam5_4_153/ +!! +!! \version 2 history: Sep 2011: Development begun. +!!\n Feb 2013: Added of prognostic precipitation. +!!\n Aug 2015: Published and released version +!! +!! Contributions from: Sean Santos, Peter Caldwell, Xiaohong Liu and Steve Ghan +!! +!! - Anning Cheng adopted mg2 for FV3GFS 9/29/2017 +!!\n add GMAO ice conversion and Liu et. al liquid water +!!\n conversion in 10/12/2017 +!! +!! - Anning showed promising results for FV3GFS on 10/15/2017 +!! - S. Moorthi - Oct/Nov 2017 - optimized the MG2 code +!! - S. Moorthi - Nov 2017 - made the sedimentation quasi-implicit +!! - S. Moorthi - Feb 2018 - updated to MG3 - modified graupel sedimentation +!! other modifications to eliminate blowup. +!! - S. Moorthi - Mar 2018 - fixed a few bugs and added option to run as MG2 +!! - S. Moorthi - Oct,29,2018 - change nlb from nlev/3 to levels with p/ps < 0.05 (nlball) +!! +!! invoked in CAM by specifying -microphys=mg3 +!! +!! References: +!! +!! Gettelman, A. and H. Morrison, Advanced Two-Moment Microphysics for Global Models. +!! Part I: Off line tests and comparisons with other schemes. +!! J. Climate, 28, 1268-1287. doi: 10.1175/JCLI-D-14-00102.1, 2015. +!! +!! Gettelman, A., H. Morrison, S. Santos, P. Bogenschutz and P. H. Caldwell +!! Advanced Two-Moment Microphysics for Global Models. +!! Part II: Global model solutions and Aerosol-Cloud Interactions. +!! J. Climate, 28, 1288-1307. doi:10.1175/JCLI-D-14-00103.1 , 2015. +!! +!! for questions contact Hugh Morrison, Andrew Gettelman +!! e-mail: morrison@ucar.edu, andrew@ucar.edu +!!--------------------------------------------------------------------------------- +!! +!! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice +!! microphysics in cooperation with the MG liquid microphysics. This is +!! controlled by the do_cldice variable. +!! +!! If do_cldice is false, then MG microphysics should not update CLDICE or +!! NUMICE; it is assumed that the other microphysics scheme will have updated +!! CLDICE and NUMICE. The other microphysics should handle the following +!! processes that would have been done by MG: +!! - Detrainment (liquid and ice) +!! - Homogeneous ice nucleation +!! - Heterogeneous ice nucleation +!! - Bergeron process +!! - Melting of ice +!! - Freezing of cloud drops +!! - Autoconversion (ice -> snow) +!! - Growth/Sublimation of ice +!! - Sedimentation of ice +!! +!! This option has not been updated since the introduction of prognostic +!! precipitation, and probably should be adjusted to cover snow as well. ! !--------------------------------------------------------------------------------- !Version 3.O based on micro_mg2_0.F90 and WRF3.8.1 module_mp_morr_two_moment.F @@ -123,6 +123,9 @@ module micro_mg3_0 ! 1) An implementation of the gamma function (if not intrinsic). ! 2) saturation vapor pressure and specific humidity over water ! 3) svp over ice + +module micro_mg3_0 + use machine, only : r8 => kind_phys use funcphys, only : fpvsl, fpvsi @@ -154,25 +157,25 @@ module micro_mg3_0 ! (mnuccd) are based on the fixed cloud ice number. Calculation of ! mnuccd follows from the prognosed ice crystal number ni. -logical :: nccons ! nccons = .true. to specify constant cloud droplet number -logical :: nicons ! nicons = .true. to specify constant cloud ice number +logical :: nccons !< nccons = .true. to specify constant cloud droplet number +logical :: nicons !< nicons = .true. to specify constant cloud ice number !++ag kt -logical :: ngcons ! ngcons = .true. to specify constant graupel number +logical :: ngcons !< ngcons = .true. to specify constant graupel number !--ag kt ! specified ice and droplet number concentrations ! note: these are local in-cloud values, not grid-mean -real(r8) :: ncnst ! droplet num concentration when nccons=.true. (m-3) -real(r8) :: ninst ! ice num concentration when nicons=.true. (m-3) +real(r8) :: ncnst !< droplet num concentration when nccons=.true. (m-3) +real(r8) :: ninst !< ice num concentration when nicons=.true. (m-3) !++ag kt -real(r8) :: ngnst ! graupel num concentration when ngcons=.true. (m-3) +real(r8) :: ngnst !< graupel num concentration when ngcons=.true. (m-3) !--ag kt !========================================================= ! Private module parameters !========================================================= -!Range of cloudsat reflectivities (dBz) for analytic simulator +!> Range of cloudsat reflectivities (dBz) for analytic simulator real(r8), parameter :: csmin = -30._r8 real(r8), parameter :: csmax = 26._r8 real(r8), parameter :: mindbz = -99._r8 @@ -197,18 +200,18 @@ module micro_mg3_0 !========================================================= ! Set using arguments to micro_mg_init -real(r8) :: g ! gravity -real(r8) :: r ! dry air gas constant -real(r8) :: rv ! water vapor gas constant -real(r8) :: cpp ! specific heat of dry air -real(r8) :: tmelt ! freezing point of water (K) +real(r8) :: g !< gravity +real(r8) :: r !< dry air gas constant +real(r8) :: rv !< water vapor gas constant +real(r8) :: cpp !< specific heat of dry air +real(r8) :: tmelt !< freezing point of water (K) ! latent heats of: -real(r8) :: xxlv ! vaporization -real(r8) :: xlf ! freezing -real(r8) :: xxls ! sublimation +real(r8) :: xxlv !< vaporization +real(r8) :: xlf !< freezing +real(r8) :: xxls !v sublimation -real(r8) :: rhmini ! Minimum rh for ice cloud fraction > 0. +real(r8) :: rhmini !v Minimum rh for ice cloud fraction > 0. ! flags logical :: microp_uniform, do_cldice, use_hetfrz_classnuc, & @@ -216,16 +219,16 @@ module micro_mg3_0 do_hail, do_graupel !--ag -real(r8) :: rhosu ! typical 850mn air density +real(r8) :: rhosu !< typical 850mn air density -real(r8) :: icenuct ! ice nucleation temperature: currently -5 degrees C +real(r8) :: icenuct !< ice nucleation temperature: currently -5 degrees C -real(r8) :: snowmelt ! what temp to melt all snow: currently 2 degrees C -real(r8) :: rainfrze ! what temp to freeze all rain: currently -5 degrees C +real(r8) :: snowmelt !< what temp to melt all snow: currently 2 degrees C +real(r8) :: rainfrze !< what temp to freeze all rain: currently -5 degrees C -real(r8) :: rhogtmp ! hail or graupel density (kg m-3) -real(r8) :: agtmp ! tmp ag/ah parameter -real(r8) :: bgtmp ! tmp fall speed parameter +real(r8) :: rhogtmp !< hail or graupel density (kg m-3) +real(r8) :: agtmp !< tmp ag/ah parameter +real(r8) :: bgtmp !< tmp fall speed parameter ! additional constants to help speed up code real(r8) :: gamma_br_plus1, gamma_bs_plus1, gamma_bi_plus1, gamma_bj_plus1, gamma_bg_plus1 @@ -233,11 +236,11 @@ module micro_mg3_0 real(r8) :: xxlv_squared, xxls_squared real(r8) :: omeps, epsqs -character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method -real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor +character(len=16) :: micro_mg_precip_frac_method !< type of precipitation fraction method +real(r8) :: micro_mg_berg_eff_factor !< berg efficiency factor -logical :: allow_sed_supersat ! Allow supersaturated conditions after sedimentation loop -logical :: do_sb_physics ! do SB 2001 autoconversion or accretion physics +logical :: allow_sed_supersat !< Allow supersaturated conditions after sedimentation loop +logical :: do_sb_physics !< do SB 2001 autoconversion or accretion physics logical :: do_ice_gmao logical :: do_liq_liu @@ -245,6 +248,10 @@ module micro_mg3_0 contains !=============================================================================== +!>\ingroup mg3_mp +!! This subroutine initializes the microphysics +!! and needs to be called once at start of simulation. +!!\author Andrew Gettelman, Dec 2005 subroutine micro_mg_init( & kind, gravit, rair, rh2o, cpair, eps, & tmelt_in, latvap, latice, & @@ -415,6 +422,7 @@ subroutine micro_mg_init( & tmx = 375.16_r8 trice = 35.00_r8 ip = .true. +!> - call gestbl() call gestbl(tmn ,tmx ,trice ,ip ,epsqs , latvap ,latice ,rh2o , & cpair ,tmelt_in ) @@ -425,6 +433,12 @@ end subroutine micro_mg_init !=============================================================================== !microphysics routine for each timestep goes here... +!>\ingroup mg3_mp +!! This subroutine calculates the MG3 microphysical processes. +!>\authors Hugh Morrison, Andrew Gettelman, NCAR, Peter Caldwell, LLNL +!! e-mail: morrison@ucar.edu, andrew@ucar.edu +!!\section mg3_micro_mg_tend MG3 micro_mg_tend General Algorithm +!> @{ subroutine micro_mg_tend ( & mgncol, nlev, deltatin, & t, q, & @@ -559,194 +573,196 @@ subroutine micro_mg_tend ( & ! e-mail: morrison@ucar.edu, andrew@ucar.edu ! input arguments - integer, intent(in) :: mgncol ! number of microphysics columns - integer, intent(in) :: nlev ! number of layers - integer, intent(in) :: nlball(mgncol) ! sedimentation start level - real(r8), intent(in) :: xlat,xlon ! number of layers - real(r8), intent(in) :: deltatin ! time step (s) - real(r8), intent(in) :: t(mgncol,nlev) ! input temperature (K) - real(r8), intent(in) :: q(mgncol,nlev) ! input h20 vapor mixing ratio (kg/kg) + integer, intent(in) :: mgncol !< number of microphysics columns + integer, intent(in) :: nlev !< number of layers + integer, intent(in) :: nlball(mgncol) !< sedimentation start level + real(r8), intent(in) :: xlat,xlon !< number of layers + real(r8), intent(in) :: deltatin !< time step (s) + real(r8), intent(in) :: t(mgncol,nlev) !< input temperature (K) + real(r8), intent(in) :: q(mgncol,nlev) !< input h20 vapor mixing ratio (kg/kg) ! note: all input cloud variables are grid-averaged - real(r8), intent(in) :: qcn(mgncol,nlev) ! cloud water mixing ratio (kg/kg) - real(r8), intent(in) :: qin(mgncol,nlev) ! cloud ice mixing ratio (kg/kg) - real(r8), intent(in) :: ncn(mgncol,nlev) ! cloud water number conc (1/kg) - real(r8), intent(in) :: nin(mgncol,nlev) ! cloud ice number conc (1/kg) - - real(r8), intent(in) :: qrn(mgncol,nlev) ! rain mixing ratio (kg/kg) - real(r8), intent(in) :: qsn(mgncol,nlev) ! snow mixing ratio (kg/kg) - real(r8), intent(in) :: nrn(mgncol,nlev) ! rain number conc (1/kg) - real(r8), intent(in) :: nsn(mgncol,nlev) ! snow number conc (1/kg) + real(r8), intent(in) :: qcn(mgncol,nlev) !< cloud water mixing ratio (kg/kg) + real(r8), intent(in) :: qin(mgncol,nlev) !< cloud ice mixing ratio (kg/kg) + real(r8), intent(in) :: ncn(mgncol,nlev) !< cloud water number conc (1/kg) + real(r8), intent(in) :: nin(mgncol,nlev) !< cloud ice number conc (1/kg) + + real(r8), intent(in) :: qrn(mgncol,nlev) !< rain mixing ratio (kg/kg) + real(r8), intent(in) :: qsn(mgncol,nlev) !< snow mixing ratio (kg/kg) + real(r8), intent(in) :: nrn(mgncol,nlev) !< rain number conc (1/kg) + real(r8), intent(in) :: nsn(mgncol,nlev) !< snow number conc (1/kg) !++ag - real(r8), intent(in) :: qgr(mgncol,nlev) ! graupel/hail mixing ratio (kg/kg) - real(r8), intent(in) :: ngr(mgncol,nlev) ! graupel/hail number conc (1/kg) + real(r8), intent(in) :: qgr(mgncol,nlev) !< graupel/hail mixing ratio (kg/kg) + real(r8), intent(in) :: ngr(mgncol,nlev) !< graupel/hail number conc (1/kg) !--ag - real(r8) :: relvar(mgncol,nlev) ! cloud water relative variance (-) - real(r8) :: accre_enhan(mgncol,nlev)! optional accretion -! real(r8), intent(in) :: relvar_i ! cloud water relative variance (-) - real(r8), intent(in) :: accre_enhan_i ! optional accretion - ! enhancement factor (-) + real(r8) :: relvar(mgncol,nlev) !< cloud water relative variance (-) + real(r8) :: accre_enhan(mgncol,nlev)!< optional accretion +! real(r8), intent(in) :: relvar_i !< cloud water relative variance (-) + real(r8), intent(in) :: accre_enhan_i !< optional accretion + !< enhancement factor (-) - real(r8), intent(in) :: p(mgncol,nlev) ! air pressure (pa) - real(r8), intent(in) :: pdel(mgncol,nlev) ! pressure difference across level (pa) + real(r8), intent(in) :: p(mgncol,nlev) !< air pressure (pa) + real(r8), intent(in) :: pdel(mgncol,nlev) !< pressure difference across level (pa) - real(r8), intent(in) :: cldn(mgncol,nlev) ! cloud fraction (no units) - real(r8), intent(in) :: liqcldf(mgncol,nlev) ! liquid cloud fraction (no units) - real(r8), intent(in) :: icecldf(mgncol,nlev) ! ice cloud fraction (no units) - real(r8), intent(in) :: qsatfac(mgncol,nlev) ! subgrid cloud water saturation scaling factor (no units) - logical, intent(in) :: lprnt, iccn, aero_in + real(r8), intent(in) :: cldn(mgncol,nlev) !< cloud fraction (no units) + real(r8), intent(in) :: liqcldf(mgncol,nlev) !< liquid cloud fraction (no units) + real(r8), intent(in) :: icecldf(mgncol,nlev) !< ice cloud fraction (no units) + real(r8), intent(in) :: qsatfac(mgncol,nlev) !< subgrid cloud water saturation scaling factor (no units) + logical, intent(in) :: lprnt !< control flag for diagnostic print out + logical, intent(in) :: iccn !< flag for IN and CCN forcing for Morrison-Gettelman microphysics + logical, intent(in) :: aero_in !< flag for using aerosols in Morrison-Gettelman microphysics ! used for scavenging ! Inputs for aerosol activation - real(r8), intent(inout) :: naai(mgncol,nlev) ! ice nucleation number (from microp_aero_ts) (1/kg) - real(r8), intent(in) :: npccnin(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s) -! real(r8), intent(in) :: npccn(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s) - real(r8) :: npccn(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s) + real(r8), intent(inout) :: naai(mgncol,nlev) !< ice nucleation number (from microp_aero_ts) (1/kg) + real(r8), intent(in) :: npccnin(mgncol,nlev) !< ccn activated number tendency (from microp_aero_ts) (1/kg*s) +! real(r8), intent(in) :: npccn(mgncol,nlev) !< ccn activated number tendency (from microp_aero_ts) (1/kg*s) + real(r8) :: npccn(mgncol,nlev) !< ccn activated number tendency (from microp_aero_ts) (1/kg*s) ! Note that for these variables, the dust bin is assumed to be the last index. ! (For example, in CAM, the last dimension is always size 4.) - real(r8), intent(in) :: rndst(mgncol,nlev,10) ! radius of each dust bin, for contact freezing (from microp_aero_ts) (m) - real(r8), intent(in) :: nacon(mgncol,nlev,10) ! number in each dust bin, for contact freezing (from microp_aero_ts) (1/m^3) + real(r8), intent(in) :: rndst(mgncol,nlev,10) !< radius of each dust bin, for contact freezing (from microp_aero_ts) (m) + real(r8), intent(in) :: nacon(mgncol,nlev,10) !< number in each dust bin, for contact freezing (from microp_aero_ts) (1/m^3) ! output arguments - real(r8), intent(out) :: qcsinksum_rate1ord(mgncol,nlev) ! 1st order rate for - ! direct cw to precip conversion - real(r8), intent(out) :: tlat(mgncol,nlev) ! latent heating rate (W/kg) - real(r8), intent(out) :: qvlat(mgncol,nlev) ! microphysical tendency qv (1/s) - real(r8), intent(out) :: qctend(mgncol,nlev) ! microphysical tendency qc (1/s) - real(r8), intent(out) :: qitend(mgncol,nlev) ! microphysical tendency qi (1/s) - real(r8), intent(out) :: nctend(mgncol,nlev) ! microphysical tendency nc (1/(kg*s)) - real(r8), intent(out) :: nitend(mgncol,nlev) ! microphysical tendency ni (1/(kg*s)) - - real(r8), intent(out) :: qrtend(mgncol,nlev) ! microphysical tendency qr (1/s) - real(r8), intent(out) :: qstend(mgncol,nlev) ! microphysical tendency qs (1/s) - real(r8), intent(out) :: nrtend(mgncol,nlev) ! microphysical tendency nr (1/(kg*s)) - real(r8), intent(out) :: nstend(mgncol,nlev) ! microphysical tendency ns (1/(kg*s)) + real(r8), intent(out) :: qcsinksum_rate1ord(mgncol,nlev) !< 1st order rate for + !! direct cw to precip conversion + real(r8), intent(out) :: tlat(mgncol,nlev) !< latent heating rate (W/kg) + real(r8), intent(out) :: qvlat(mgncol,nlev) !< microphysical tendency qv (1/s) + real(r8), intent(out) :: qctend(mgncol,nlev) !< microphysical tendency qc (1/s) + real(r8), intent(out) :: qitend(mgncol,nlev) !< microphysical tendency qi (1/s) + real(r8), intent(out) :: nctend(mgncol,nlev) !< microphysical tendency nc (1/(kg*s)) + real(r8), intent(out) :: nitend(mgncol,nlev) !< microphysical tendency ni (1/(kg*s)) + + real(r8), intent(out) :: qrtend(mgncol,nlev) !< microphysical tendency qr (1/s) + real(r8), intent(out) :: qstend(mgncol,nlev) !< microphysical tendency qs (1/s) + real(r8), intent(out) :: nrtend(mgncol,nlev) !< microphysical tendency nr (1/(kg*s)) + real(r8), intent(out) :: nstend(mgncol,nlev) !< microphysical tendency ns (1/(kg*s)) !++ag - real(r8), intent(out) :: qgtend(mgncol,nlev) ! microphysical tendency qg (1/s) - real(r8), intent(out) :: ngtend(mgncol,nlev) ! microphysical tendency ng (1/(kg*s)) + real(r8), intent(out) :: qgtend(mgncol,nlev) !< microphysical tendency qg (1/s) + real(r8), intent(out) :: ngtend(mgncol,nlev) !< microphysical tendency ng (1/(kg*s)) !--ag - real(r8), intent(out) :: effc(mgncol,nlev) ! droplet effective radius (micron) - real(r8), intent(out) :: effc_fn(mgncol,nlev) ! droplet effective radius, assuming nc = 1.e8 kg-1 - real(r8), intent(out) :: effi(mgncol,nlev) ! cloud ice effective radius (micron) - real(r8), intent(out) :: sadice(mgncol,nlev) ! cloud ice surface area density (cm2/cm3) - real(r8), intent(out) :: sadsnow(mgncol,nlev) ! cloud snow surface area density (cm2/cm3) - real(r8), intent(out) :: prect(mgncol) ! surface precip rate (m/s) - real(r8), intent(out) :: preci(mgncol) ! cloud ice/snow precip rate (m/s) - real(r8), intent(out) :: nevapr(mgncol,nlev) ! evaporation rate of rain + snow (1/s) - real(r8), intent(out) :: evapsnow(mgncol,nlev) ! sublimation rate of snow (1/s) - real(r8), intent(out) :: am_evp_st(mgncol,nlev) ! stratiform evaporation area (frac) - real(r8), intent(out) :: prain(mgncol,nlev) ! production of rain + snow (1/s) - real(r8), intent(out) :: prodsnow(mgncol,nlev) ! production of snow (1/s) - real(r8), intent(out) :: cmeout(mgncol,nlev) ! evap/sub of cloud (1/s) - real(r8), intent(out) :: deffi(mgncol,nlev) ! ice effective diameter for optics (radiation) (micron) - real(r8), intent(out) :: pgamrad(mgncol,nlev) ! ice gamma parameter for optics (radiation) (no units) - real(r8), intent(out) :: lamcrad(mgncol,nlev) ! slope of droplet distribution for optics (radiation) (1/m) - real(r8), intent(out) :: qsout(mgncol,nlev) ! snow mixing ratio (kg/kg) - real(r8), intent(out) :: dsout(mgncol,nlev) ! snow diameter (m) - real(r8), intent(out) :: lflx(mgncol,2:nlev+1) ! grid-box average liquid condensate flux (kg m^-2 s^-1) - real(r8), intent(out) :: iflx(mgncol,2:nlev+1) ! grid-box average ice condensate flux (kg m^-2 s^-1) - real(r8), intent(out) :: rflx(mgncol,2:nlev+1) ! grid-box average rain flux (kg m^-2 s^-1) - real(r8), intent(out) :: sflx(mgncol,2:nlev+1) ! grid-box average snow flux (kg m^-2 s^-1) + real(r8), intent(out) :: effc(mgncol,nlev) !< droplet effective radius (micron) + real(r8), intent(out) :: effc_fn(mgncol,nlev) !< droplet effective radius, assuming nc = 1.e8 kg-1 + real(r8), intent(out) :: effi(mgncol,nlev) !< cloud ice effective radius (micron) + real(r8), intent(out) :: sadice(mgncol,nlev) !< cloud ice surface area density (cm2/cm3) + real(r8), intent(out) :: sadsnow(mgncol,nlev) !< cloud snow surface area density (cm2/cm3) + real(r8), intent(out) :: prect(mgncol) !< surface precip rate (m/s) + real(r8), intent(out) :: preci(mgncol) !< cloud ice/snow precip rate (m/s) + real(r8), intent(out) :: nevapr(mgncol,nlev) !< evaporation rate of rain + snow (1/s) + real(r8), intent(out) :: evapsnow(mgncol,nlev) !< sublimation rate of snow (1/s) + real(r8), intent(out) :: am_evp_st(mgncol,nlev) !< stratiform evaporation area (frac) + real(r8), intent(out) :: prain(mgncol,nlev) !< production of rain + snow (1/s) + real(r8), intent(out) :: prodsnow(mgncol,nlev) !< production of snow (1/s) + real(r8), intent(out) :: cmeout(mgncol,nlev) !< evap/sub of cloud (1/s) + real(r8), intent(out) :: deffi(mgncol,nlev) !< ice effective diameter for optics (radiation) (micron) + real(r8), intent(out) :: pgamrad(mgncol,nlev) !< ice gamma parameter for optics (radiation) (no units) + real(r8), intent(out) :: lamcrad(mgncol,nlev) !< slope of droplet distribution for optics (radiation) (1/m) + real(r8), intent(out) :: qsout(mgncol,nlev) !< snow mixing ratio (kg/kg) + real(r8), intent(out) :: dsout(mgncol,nlev) !< snow diameter (m) + real(r8), intent(out) :: lflx(mgncol,2:nlev+1) !< grid-box average liquid condensate flux (kg m^-2 s^-1) + real(r8), intent(out) :: iflx(mgncol,2:nlev+1) !< grid-box average ice condensate flux (kg m^-2 s^-1) + real(r8), intent(out) :: rflx(mgncol,2:nlev+1) !< grid-box average rain flux (kg m^-2 s^-1) + real(r8), intent(out) :: sflx(mgncol,2:nlev+1) !< grid-box average snow flux (kg m^-2 s^-1) !++ag - real(r8), intent(out) :: gflx(mgncol,2:nlev+1) ! grid-box average graupel/hail flux (kg m^-2 s^-1) + real(r8), intent(out) :: gflx(mgncol,2:nlev+1) !< grid-box average graupel/hail flux (kg m^-2 s^-1) !--ag - real(r8), intent(out) :: qrout(mgncol,nlev) ! grid-box average rain mixing ratio (kg/kg) - real(r8), intent(out) :: reff_rain(mgncol,nlev) ! rain effective radius (micron) - real(r8), intent(out) :: reff_snow(mgncol,nlev) ! snow effective radius (micron) + real(r8), intent(out) :: qrout(mgncol,nlev) !< grid-box average rain mixing ratio (kg/kg) + real(r8), intent(out) :: reff_rain(mgncol,nlev) !< rain effective radius (micron) + real(r8), intent(out) :: reff_snow(mgncol,nlev) !< snow effective radius (micron) !++ag - real(r8), intent(out) :: reff_grau(mgncol,nlev) ! graupel effective radius (micron) + real(r8), intent(out) :: reff_grau(mgncol,nlev) !< graupel effective radius (micron) !--ag - real(r8), intent(out) :: qcsevap(mgncol,nlev) ! cloud water evaporation due to sedimentation (1/s) - real(r8), intent(out) :: qisevap(mgncol,nlev) ! cloud ice sublimation due to sedimentation (1/s) - real(r8), intent(out) :: qvres(mgncol,nlev) ! residual condensation term to ensure RH < 100% (1/s) - real(r8), intent(out) :: cmeitot(mgncol,nlev) ! grid-mean cloud ice sub/dep (1/s) - real(r8), intent(out) :: vtrmc(mgncol,nlev) ! mass-weighted cloud water fallspeed (m/s) - real(r8), intent(out) :: vtrmi(mgncol,nlev) ! mass-weighted cloud ice fallspeed (m/s) - real(r8), intent(out) :: umr(mgncol,nlev) ! mass weighted rain fallspeed (m/s) - real(r8), intent(out) :: ums(mgncol,nlev) ! mass weighted snow fallspeed (m/s) + real(r8), intent(out) :: qcsevap(mgncol,nlev) !< cloud water evaporation due to sedimentation (1/s) + real(r8), intent(out) :: qisevap(mgncol,nlev) !< cloud ice sublimation due to sedimentation (1/s) + real(r8), intent(out) :: qvres(mgncol,nlev) !< residual condensation term to ensure RH < 100% (1/s) + real(r8), intent(out) :: cmeitot(mgncol,nlev) !< grid-mean cloud ice sub/dep (1/s) + real(r8), intent(out) :: vtrmc(mgncol,nlev) !< mass-weighted cloud water fallspeed (m/s) + real(r8), intent(out) :: vtrmi(mgncol,nlev) !< mass-weighted cloud ice fallspeed (m/s) + real(r8), intent(out) :: umr(mgncol,nlev) !< mass weighted rain fallspeed (m/s) + real(r8), intent(out) :: ums(mgncol,nlev) !< mass weighted snow fallspeed (m/s) !++ag - real(r8), intent(out) :: umg(mgncol,nlev) ! mass weighted graupel/hail fallspeed (m/s) - real(r8), intent(out) :: qgsedten(mgncol,nlev) ! qg sedimentation tendency (1/s) + real(r8), intent(out) :: umg(mgncol,nlev) !< mass weighted graupel/hail fallspeed (m/s) + real(r8), intent(out) :: qgsedten(mgncol,nlev) !< qg sedimentation tendency (1/s) !--ag - real(r8), intent(out) :: qcsedten(mgncol,nlev) ! qc sedimentation tendency (1/s) - real(r8), intent(out) :: qisedten(mgncol,nlev) ! qi sedimentation tendency (1/s) - real(r8), intent(out) :: qrsedten(mgncol,nlev) ! qr sedimentation tendency (1/s) - real(r8), intent(out) :: qssedten(mgncol,nlev) ! qs sedimentation tendency (1/s) + real(r8), intent(out) :: qcsedten(mgncol,nlev) !< qc sedimentation tendency (1/s) + real(r8), intent(out) :: qisedten(mgncol,nlev) !< qi sedimentation tendency (1/s) + real(r8), intent(out) :: qrsedten(mgncol,nlev) !< qr sedimentation tendency (1/s) + real(r8), intent(out) :: qssedten(mgncol,nlev) !< qs sedimentation tendency (1/s) ! microphysical process rates for output (mixing ratio tendencies) (all have units of 1/s) - real(r8), intent(out) :: pratot(mgncol,nlev) ! accretion of cloud by rain - real(r8), intent(out) :: prctot(mgncol,nlev) ! autoconversion of cloud to rain - real(r8), intent(out) :: mnuccctot(mgncol,nlev) ! mixing ratio tend due to immersion freezing - real(r8), intent(out) :: mnuccttot(mgncol,nlev) ! mixing ratio tend due to contact freezing - real(r8), intent(out) :: msacwitot(mgncol,nlev) ! mixing ratio tend due to H-M splintering - real(r8), intent(out) :: psacwstot(mgncol,nlev) ! collection of cloud water by snow - real(r8), intent(out) :: bergstot(mgncol,nlev) ! bergeron process on snow - real(r8), intent(out) :: bergtot(mgncol,nlev) ! bergeron process on cloud ice - real(r8), intent(out) :: melttot(mgncol,nlev) ! melting of cloud ice - real(r8), intent(out) :: homotot(mgncol,nlev) ! homogeneous freezing cloud water - real(r8), intent(out) :: qcrestot(mgncol,nlev) ! residual cloud condensation due to removal of excess supersat - real(r8), intent(out) :: prcitot(mgncol,nlev) ! autoconversion of cloud ice to snow - real(r8), intent(out) :: praitot(mgncol,nlev) ! accretion of cloud ice by snow - real(r8), intent(out) :: qirestot(mgncol,nlev) ! residual ice deposition due to removal of excess supersat - real(r8), intent(out) :: mnuccrtot(mgncol,nlev) ! mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s) - real(r8), intent(out) :: mnuccritot(mgncol,nlev)! mixing ratio tendency due to heterogeneous freezing of rain to ice (1/s) - real(r8), intent(out) :: pracstot(mgncol,nlev) ! mixing ratio tendency due to accretion of rain by snow (1/s) - real(r8), intent(out) :: meltsdttot(mgncol,nlev)! latent heating rate due to melting of snow (W/kg) - real(r8), intent(out) :: frzrdttot(mgncol,nlev) ! latent heating rate due to homogeneous freezing of rain (W/kg) - real(r8), intent(out) :: mnuccdtot(mgncol,nlev) ! mass tendency from ice nucleation + real(r8), intent(out) :: pratot(mgncol,nlev) !< accretion of cloud by rain + real(r8), intent(out) :: prctot(mgncol,nlev) !< autoconversion of cloud to rain + real(r8), intent(out) :: mnuccctot(mgncol,nlev) !< mixing ratio tend due to immersion freezing + real(r8), intent(out) :: mnuccttot(mgncol,nlev) !< mixing ratio tend due to contact freezing + real(r8), intent(out) :: msacwitot(mgncol,nlev) !< mixing ratio tend due to H-M splintering + real(r8), intent(out) :: psacwstot(mgncol,nlev) !< collection of cloud water by snow + real(r8), intent(out) :: bergstot(mgncol,nlev) !< bergeron process on snow + real(r8), intent(out) :: bergtot(mgncol,nlev) !< bergeron process on cloud ice + real(r8), intent(out) :: melttot(mgncol,nlev) !< melting of cloud ice + real(r8), intent(out) :: homotot(mgncol,nlev) !< homogeneous freezing cloud water + real(r8), intent(out) :: qcrestot(mgncol,nlev) !< residual cloud condensation due to removal of excess supersat + real(r8), intent(out) :: prcitot(mgncol,nlev) !< autoconversion of cloud ice to snow + real(r8), intent(out) :: praitot(mgncol,nlev) !< accretion of cloud ice by snow + real(r8), intent(out) :: qirestot(mgncol,nlev) !< residual ice deposition due to removal of excess supersat + real(r8), intent(out) :: mnuccrtot(mgncol,nlev) !< mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s) + real(r8), intent(out) :: mnuccritot(mgncol,nlev)!< mixing ratio tendency due to heterogeneous freezing of rain to ice (1/s) + real(r8), intent(out) :: pracstot(mgncol,nlev) !< mixing ratio tendency due to accretion of rain by snow (1/s) + real(r8), intent(out) :: meltsdttot(mgncol,nlev)!< latent heating rate due to melting of snow (W/kg) + real(r8), intent(out) :: frzrdttot(mgncol,nlev) !< latent heating rate due to homogeneous freezing of rain (W/kg) + real(r8), intent(out) :: mnuccdtot(mgncol,nlev) !< mass tendency from ice nucleation !++ag Hail/Graupel Tendencies - real(r8), intent(out) :: pracgtot(mgncol,nlev) ! change in q collection rain by graupel (precipf) - real(r8), intent(out) :: psacwgtot(mgncol,nlev) ! change in q collection droplets by graupel (lcldm) - real(r8), intent(out) :: pgsacwtot(mgncol,nlev) ! conversion q to graupel due to collection droplets by snow (lcldm) - real(r8), intent(out) :: pgracstot(mgncol,nlev) ! conversion q to graupel due to collection rain by snow (precipf) - real(r8), intent(out) :: prdgtot(mgncol,nlev) ! dep of graupel (precipf) -! real(r8), intent(out) :: eprdgtot(mgncol,nlev) ! sub of graupel (precipf) - real(r8), intent(out) :: qmultgtot(mgncol,nlev) ! change q due to ice mult droplets/graupel (lcldm) - real(r8), intent(out) :: qmultrgtot(mgncol,nlev)! change q due to ice mult rain/graupel (precipf) - real(r8), intent(out) :: psacrtot(mgncol,nlev) ! conversion due to coll of snow by rain (precipf) - real(r8), intent(out) :: npracgtot(mgncol,nlev) ! change n collection rain by graupel (precipf) - real(r8), intent(out) :: nscngtot(mgncol,nlev) ! change n conversion to graupel due to collection droplets by snow (lcldm) - real(r8), intent(out) :: ngracstot(mgncol,nlev) ! change n conversion to graupel due to collection rain by snow (precipf) - real(r8), intent(out) :: nmultgtot(mgncol,nlev) ! ice mult due to acc droplets by graupel (lcldm) - real(r8), intent(out) :: nmultrgtot(mgncol,nlev)! ice mult due to acc rain by graupel (precipf) - real(r8), intent(out) :: npsacwgtot(mgncol,nlev)! change n collection droplets by graupel (lcldm?) + real(r8), intent(out) :: pracgtot(mgncol,nlev) !< change in q collection rain by graupel (precipf) + real(r8), intent(out) :: psacwgtot(mgncol,nlev) !< change in q collection droplets by graupel (lcldm) + real(r8), intent(out) :: pgsacwtot(mgncol,nlev) !< conversion q to graupel due to collection droplets by snow (lcldm) + real(r8), intent(out) :: pgracstot(mgncol,nlev) !< conversion q to graupel due to collection rain by snow (precipf) + real(r8), intent(out) :: prdgtot(mgncol,nlev) !< dep of graupel (precipf) +! real(r8), intent(out) :: eprdgtot(mgncol,nlev) !< sub of graupel (precipf) + real(r8), intent(out) :: qmultgtot(mgncol,nlev) !< change q due to ice mult droplets/graupel (lcldm) + real(r8), intent(out) :: qmultrgtot(mgncol,nlev)!< change q due to ice mult rain/graupel (precipf) + real(r8), intent(out) :: psacrtot(mgncol,nlev) !< conversion due to coll of snow by rain (precipf) + real(r8), intent(out) :: npracgtot(mgncol,nlev) !< change n collection rain by graupel (precipf) + real(r8), intent(out) :: nscngtot(mgncol,nlev) !< change n conversion to graupel due to collection droplets by snow (lcldm) + real(r8), intent(out) :: ngracstot(mgncol,nlev) !< change n conversion to graupel due to collection rain by snow (precipf) + real(r8), intent(out) :: nmultgtot(mgncol,nlev) !< ice mult due to acc droplets by graupel (lcldm) + real(r8), intent(out) :: nmultrgtot(mgncol,nlev)!< ice mult due to acc rain by graupel (precipf) + real(r8), intent(out) :: npsacwgtot(mgncol,nlev)!< change n collection droplets by graupel (lcldm?) !--ag - real(r8), intent(out) :: nrout(mgncol,nlev) ! rain number concentration (1/m3) - real(r8), intent(out) :: nsout(mgncol,nlev) ! snow number concentration (1/m3) - real(r8), intent(out) :: refl(mgncol,nlev) ! analytic radar reflectivity - real(r8), intent(out) :: arefl(mgncol,nlev) ! average reflectivity will zero points outside valid range - real(r8), intent(out) :: areflz(mgncol,nlev) ! average reflectivity in z. - real(r8), intent(out) :: frefl(mgncol,nlev) ! fractional occurrence of radar reflectivity - real(r8), intent(out) :: csrfl(mgncol,nlev) ! cloudsat reflectivity - real(r8), intent(out) :: acsrfl(mgncol,nlev) ! cloudsat average - real(r8), intent(out) :: fcsrfl(mgncol,nlev) ! cloudsat fractional occurrence of radar reflectivity - real(r8), intent(out) :: rercld(mgncol,nlev) ! effective radius calculation for rain + cloud - real(r8), intent(out) :: ncai(mgncol,nlev) ! output number conc of ice nuclei available (1/m3) - real(r8), intent(out) :: ncal(mgncol,nlev) ! output number conc of CCN (1/m3) - real(r8), intent(out) :: qrout2(mgncol,nlev) ! copy of qrout as used to compute drout2 - real(r8), intent(out) :: qsout2(mgncol,nlev) ! copy of qsout as used to compute dsout2 - real(r8), intent(out) :: nrout2(mgncol,nlev) ! copy of nrout as used to compute drout2 - real(r8), intent(out) :: nsout2(mgncol,nlev) ! copy of nsout as used to compute dsout2 - real(r8), intent(out) :: drout2(mgncol,nlev) ! mean rain particle diameter (m) - real(r8), intent(out) :: dsout2(mgncol,nlev) ! mean snow particle diameter (m) - real(r8), intent(out) :: freqs(mgncol,nlev) ! fractional occurrence of snow - real(r8), intent(out) :: freqr(mgncol,nlev) ! fractional occurrence of rain - real(r8), intent(out) :: nfice(mgncol,nlev) ! fractional occurrence of ice - real(r8), intent(out) :: qcrat(mgncol,nlev) ! limiter for qc process rates (1=no limit --> 0. no qc) + real(r8), intent(out) :: nrout(mgncol,nlev) !< rain number concentration (1/m3) + real(r8), intent(out) :: nsout(mgncol,nlev) !< snow number concentration (1/m3) + real(r8), intent(out) :: refl(mgncol,nlev) !< analytic radar reflectivity + real(r8), intent(out) :: arefl(mgncol,nlev) !< average reflectivity will zero points outside valid range + real(r8), intent(out) :: areflz(mgncol,nlev) !< average reflectivity in z. + real(r8), intent(out) :: frefl(mgncol,nlev) !< fractional occurrence of radar reflectivity + real(r8), intent(out) :: csrfl(mgncol,nlev) !< cloudsat reflectivity + real(r8), intent(out) :: acsrfl(mgncol,nlev) !< cloudsat average + real(r8), intent(out) :: fcsrfl(mgncol,nlev) !< cloudsat fractional occurrence of radar reflectivity + real(r8), intent(out) :: rercld(mgncol,nlev) !< effective radius calculation for rain + cloud + real(r8), intent(out) :: ncai(mgncol,nlev) !< output number conc of ice nuclei available (1/m3) + real(r8), intent(out) :: ncal(mgncol,nlev) !< output number conc of CCN (1/m3) + real(r8), intent(out) :: qrout2(mgncol,nlev) !< copy of qrout as used to compute drout2 + real(r8), intent(out) :: qsout2(mgncol,nlev) !< copy of qsout as used to compute dsout2 + real(r8), intent(out) :: nrout2(mgncol,nlev) !< copy of nrout as used to compute drout2 + real(r8), intent(out) :: nsout2(mgncol,nlev) !< copy of nsout as used to compute dsout2 + real(r8), intent(out) :: drout2(mgncol,nlev) !< mean rain particle diameter (m) + real(r8), intent(out) :: dsout2(mgncol,nlev) !< mean snow particle diameter (m) + real(r8), intent(out) :: freqs(mgncol,nlev) !< fractional occurrence of snow + real(r8), intent(out) :: freqr(mgncol,nlev) !< fractional occurrence of rain + real(r8), intent(out) :: nfice(mgncol,nlev) !< fractional occurrence of ice + real(r8), intent(out) :: qcrat(mgncol,nlev) !< limiter for qc process rates (1=no limit --> 0. no qc) !++ag - real(r8), intent(out) :: qgout(mgncol,nlev) ! graupel/hail mixing ratio (kg/kg) - real(r8), intent(out) :: dgout(mgncol,nlev) ! graupel/hail diameter (m) - real(r8), intent(out) :: ngout(mgncol,nlev) ! graupel/hail number concentration (1/m3) + real(r8), intent(out) :: qgout(mgncol,nlev) !< graupel/hail mixing ratio (kg/kg) + real(r8), intent(out) :: dgout(mgncol,nlev) !< graupel/hail diameter (m) + real(r8), intent(out) :: ngout(mgncol,nlev) !< graupel/hail number concentration (1/m3) !Not sure if these are needed since graupel/hail is prognostic? - real(r8), intent(out) :: qgout2(mgncol,nlev) ! copy of qgout as used to compute dgout2 - real(r8), intent(out) :: ngout2(mgncol,nlev) ! copy of ngout as used to compute dgout2 - real(r8), intent(out) :: dgout2(mgncol,nlev) ! mean graupel/hail particle diameter (m) - real(r8), intent(out) :: freqg(mgncol,nlev) ! fractional occurrence of graupel + real(r8), intent(out) :: qgout2(mgncol,nlev) !< copy of qgout as used to compute dgout2 + real(r8), intent(out) :: ngout2(mgncol,nlev) !< copy of ngout as used to compute dgout2 + real(r8), intent(out) :: dgout2(mgncol,nlev) !< mean graupel/hail particle diameter (m) + real(r8), intent(out) :: freqg(mgncol,nlev) !< fractional occurrence of graupel !--ag @@ -758,38 +774,38 @@ subroutine micro_mg_tend ( & ! Used with CARMA cirrus microphysics ! (or similar external microphysics model) - ! real(r8), intent(in) :: tnd_qsnow(:,:) ! snow mass tendency (kg/kg/s) - ! real(r8), intent(in) :: tnd_nsnow(:,:) ! snow number tendency (#/kg/s) - ! real(r8), intent(in) :: re_ice(:,:) ! ice effective radius (m) + ! real(r8), intent(in) :: tnd_qsnow(:,:) !< snow mass tendency (kg/kg/s) + ! real(r8), intent(in) :: tnd_nsnow(:,:) !< snow number tendency (#/kg/s) + ! real(r8), intent(in) :: re_ice(:,:) !< ice effective radius (m) ! From external ice nucleation. - !real(r8), intent(in) :: frzimm(:,:) ! Number tendency due to immersion freezing (1/cm3) - !real(r8), intent(in) :: frzcnt(:,:) ! Number tendency due to contact freezing (1/cm3) - !real(r8), intent(in) :: frzdep(:,:) ! Number tendency due to deposition nucleation (1/cm3) + !real(r8), intent(in) :: frzimm(:,:) !< Number tendency due to immersion freezing (1/cm3) + !real(r8), intent(in) :: frzcnt(:,:) !< Number tendency due to contact freezing (1/cm3) + !real(r8), intent(in) :: frzdep(:,:) !< Number tendency due to deposition nucleation (1/cm3) ! local workspace ! all units mks unless otherwise stated ! local copies of input variables - real(r8) :: qc(mgncol,nlev) ! cloud liquid mixing ratio (kg/kg) - real(r8) :: qi(mgncol,nlev) ! cloud ice mixing ratio (kg/kg) - real(r8) :: nc(mgncol,nlev) ! cloud liquid number concentration (1/kg) - real(r8) :: ni(mgncol,nlev) ! cloud liquid number concentration (1/kg) - real(r8) :: qr(mgncol,nlev) ! rain mixing ratio (kg/kg) - real(r8) :: qs(mgncol,nlev) ! snow mixing ratio (kg/kg) - real(r8) :: nr(mgncol,nlev) ! rain number concentration (1/kg) - real(r8) :: ns(mgncol,nlev) ! snow number concentration (1/kg) + real(r8) :: qc(mgncol,nlev) !< cloud liquid mixing ratio (kg/kg) + real(r8) :: qi(mgncol,nlev) !< cloud ice mixing ratio (kg/kg) + real(r8) :: nc(mgncol,nlev) !< cloud liquid number concentration (1/kg) + real(r8) :: ni(mgncol,nlev) !< cloud liquid number concentration (1/kg) + real(r8) :: qr(mgncol,nlev) !< rain mixing ratio (kg/kg) + real(r8) :: qs(mgncol,nlev) !< snow mixing ratio (kg/kg) + real(r8) :: nr(mgncol,nlev) !< rain number concentration (1/kg) + real(r8) :: ns(mgncol,nlev) !< snow number concentration (1/kg) !++ag - real(r8) :: qg(mgncol,nlev) ! graupel mixing ratio (kg/kg) - real(r8) :: ng(mgncol,nlev) ! graupel number concentration (1/kg) -! real(r8) :: rhogtmp ! hail or graupel density (kg m-3) + real(r8) :: qg(mgncol,nlev) !< graupel mixing ratio (kg/kg) + real(r8) :: ng(mgncol,nlev) !< graupel number concentration (1/kg) +! real(r8) :: rhogtmp !< hail or graupel density (kg m-3) !--ag ! general purpose variables - real(r8) :: deltat ! sub-time step (s) - real(r8) :: oneodt ! one / deltat - real(r8) :: mtime ! the assumed ice nucleation timescale + real(r8) :: deltat !< sub-time step (s) + real(r8) :: oneodt !< one / deltat + real(r8) :: mtime !< the assumed ice nucleation timescale ! physical properties of the air at a given point real(r8) :: rho(mgncol,nlev) ! density (kg m-3) @@ -1083,14 +1099,14 @@ subroutine micro_mg_tend ( & ! Process inputs - ! assign variable deltat to deltatin + !> - Assign variable deltat to deltatin deltat = deltatin oneodt = one / deltat ! nstep_def = max(1, nint(deltat/20)) nstep_def = max(1, nint(deltat/5)) ! tsfac = log(ts_au/ts_au_min) * qiinv - ! Copies of input concentrations that may be changed internally. + !> - Copies of input concentrations that may be changed internally. do k=1,nlev do i=1,mgncol qc(i,k) = qcn(i,k) @@ -1110,7 +1126,7 @@ subroutine micro_mg_tend ( & ! cldn: used to set cldm, unused for subcolumns ! liqcldf: used to set lcldm, unused for subcolumns ! icecldf: used to set icldm, unused for subcolumns - +!> - Calculation liquid/ice cloud fraction if (microp_uniform) then ! subcolumns, set cloud fraction variables to one ! if cloud water or ice is present, if not present @@ -1156,7 +1172,7 @@ subroutine micro_mg_tend ( & ! if (lprnt) write(0,*)' icldm=',icldm(1,nlev-20:nlev) ! if (lprnt) write(0,*)' qsfm=',qsfm(1,nlev-20:nlev) - ! Initialize local variables + !> - Initialize local variables ! local physical properties @@ -1227,7 +1243,7 @@ subroutine micro_mg_tend ( & ! set mtime here to avoid answer-changing mtime = deltat - ! initialize microphysics output + !> - initialize microphysics output do k=1,nlev do i=1,mgncol qcsevap(i,k) = zero @@ -1311,7 +1327,7 @@ subroutine micro_mg_tend ( & gflx(i,k+1) = zero !--ag - ! initialize precip output + !> - initialize precip output qrout(i,k) = zero qsout(i,k) = zero @@ -1326,12 +1342,12 @@ subroutine micro_mg_tend ( & ! for refl calc rainrt(i,k) = zero - ! initialize rain size + !> - initialize rain size rercld(i,k) = zero qcsinksum_rate1ord(i,k) = zero - ! initialize variables for trop_mozart + !> - initialize variables for trop_mozart nevapr(i,k) = zero prer_evap(i,k) = zero evapsnow(i,k) = zero @@ -1344,7 +1360,7 @@ subroutine micro_mg_tend ( & lamc(i,k) = zero - ! initialize microphysical tendencies + !> - initialize microphysical tendencies tlat(i,k) = zero qvlat(i,k) = zero @@ -1361,7 +1377,7 @@ subroutine micro_mg_tend ( & ngtend(i,k) = zero !--ag - ! initialize in-cloud and in-precip quantities to zero + !> - initialize in-cloud and in-precip quantities to zero qcic(i,k) = zero qiic(i,k) = zero qsic(i,k) = zero @@ -1378,7 +1394,7 @@ subroutine micro_mg_tend ( & !++ag ngic(i,k) = zero !--ag - ! initialize precip fallspeeds to zero + !> - initialize precip fallspeeds to zero ums(i,k) = zero uns(i,k) = zero umr(i,k) = zero @@ -1388,7 +1404,7 @@ subroutine micro_mg_tend ( & ung(i,k) = zero !--ag - ! initialize limiter for output + !> - initialize limiter for output qcrat(i,k) = one ! Many outputs have to be initialized here at the top to work around @@ -1442,7 +1458,7 @@ subroutine micro_mg_tend ( & npccn(i,k) = zero enddo enddo -! +!> - initialize ccn activated number tendency (\p npccn) if (iccn) then do k=1,nlev do i=1,mgncol @@ -1457,7 +1473,7 @@ subroutine micro_mg_tend ( & enddo endif - ! initialize precip at surface + !> - initialize precip at surface do i=1,mgncol prect(i) = zero @@ -4459,13 +4475,16 @@ subroutine micro_mg_tend ( & enddo end subroutine micro_mg_tend +!> @} !======================================================================== !OUTPUT CALCULATIONS !======================================================================== +!>\ingroup mg3_mp +!! This subroutine calculates effective radii for rain and cloud. subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol,nlev) - integer, intent(in) :: mgncol, nlev + integer, intent(in) :: mgncol, nlev ! horizontal and vertical dimension real(r8), dimension(mgncol,nlev), intent(in) :: lamr ! rain size parameter (slope) real(r8), dimension(mgncol,nlev), intent(in) :: n0r ! rain size parameter (intercept) real(r8), dimension(mgncol,nlev), intent(in) :: lamc ! size distribution parameter (slope) @@ -4506,3 +4525,4 @@ end subroutine calc_rercld !======================================================================== end module micro_mg3_0 +!>@} From b7e321b89dd6ddb724c6acd15108e87a6244c0e6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 31 Jan 2020 15:11:12 +0000 Subject: [PATCH 17/24] changing doxygen command in two lines in file micro_mg3.F90 --- physics/micro_mg3_0.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 5c7b7ceee..fd155bfa7 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -209,9 +209,9 @@ module micro_mg3_0 ! latent heats of: real(r8) :: xxlv !< vaporization real(r8) :: xlf !< freezing -real(r8) :: xxls !v sublimation +real(r8) :: xxls !< sublimation -real(r8) :: rhmini !v Minimum rh for ice cloud fraction > 0. +real(r8) :: rhmini !< Minimum rh for ice cloud fraction > 0. ! flags logical :: microp_uniform, do_cldice, use_hetfrz_classnuc, & From 8a8de1740807e24a9e7198fad48414845347b205 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 Feb 2020 00:46:27 +0000 Subject: [PATCH 18/24] setting the momentum, sensible and latent heat fluxes over land exported to ocean to large values. Also, over 100% ice, values are set to ice values imported from the ice model --- physics/GFS_PBL_generic.F90 | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index f8bbf247e..9f9033b42 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -331,6 +331,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + real(kind=kind_phys), parameter :: huge=1.0d30 integer :: i, k, kk, k1, n real(kind=kind_phys) :: tem, tem1, rho @@ -498,13 +499,13 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if (cplflx) then do i=1,im if (oceanfrac(i) > 0.0) then ! Ocean only, NO LAKES -! if (fice(i) == ceanfrac(i)) then ! use results from CICE -! dusfci_cpl(i) = dusfc_cice(i) -! dvsfci_cpl(i) = dvsfc_cice(i) -! dtsfci_cpl(i) = dtsfc_cice(i) -! dqsfci_cpl(i) = dqsfc_cice(i) -! elseif (dry(i) .or. icy(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point - if (wet(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point + if (fice(i) == oceanfrac(i)) then ! use results from CICE + dusfci_cpl(i) = dusfc_cice(i) + dvsfci_cpl(i) = dvsfc_cice(i) + dtsfci_cpl(i) = dtsfc_cice(i) + dqsfci_cpl(i) = dqsfc_cice(i) +! elseif (dry(i) .or. icy(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point + elseif (wet(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point if (icy(i) .or. dry(i)) then tem1 = max(q1(i), 1.e-8) rho = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) @@ -518,7 +519,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, endif dtsfci_cpl(i) = cp * rho * hflx_ocn(i) ! sensible heat flux over open ocean dqsfci_cpl(i) = hvap * rho * evap_ocn(i) ! latent heat flux over open ocean - else ! use results from PBL scheme for 100% open ocean + else ! use results from PBL scheme for 100% open ocean dusfci_cpl(i) = dusfc1(i) dvsfci_cpl(i) = dvsfc1(i) dtsfci_cpl(i) = dtsfc1(i) @@ -530,6 +531,12 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dvsfc_cpl (i) = dvsfc_cpl(i) + dvsfci_cpl(i) * dtf dtsfc_cpl (i) = dtsfc_cpl(i) + dtsfci_cpl(i) * dtf dqsfc_cpl (i) = dqsfc_cpl(i) + dqsfci_cpl(i) * dtf +! + else + dusfc_cpl(i) = huge + dvsfc_cpl(i) = huge + dtsfc_cpl(i) = huge + dqsfc_cpl(i) = huge !! endif ! Ocean only, NO LAKES enddo From 90b5d9a0a3d894681b01be870de12b0bdf31990c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 19 Feb 2020 16:39:58 +0000 Subject: [PATCH 19/24] update gcycle to define tsfco --- physics/GFS_surface_composites.F90 | 1 + physics/gcycle.F90 | 25 +++++++++++++++++-------- 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 2dd0d423d..20f103fc4 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -123,6 +123,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl wet(i) = .true. ! tsfco(i) = tgice if (.not. cplflx) tsfco(i) = max(tisfc(i), tgice) + ! if (.not. cplflx .or. lakefrac(i) > zero) tsfco(i) = max(tsfco(i), tisfc(i), tgice) ! tsfco(i) = max((tsfc(i) - cice(i)*tisfc(i)) & ! / (one - cice(i)), tgice) endif diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 411d41004..0395c39a7 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -1,5 +1,5 @@ !>\file gcycle.F90 -!! This file repopulates specific time-varying surface properties for +!! This file repopulates specific time-varying surface properties for !! atmospheric forecast runs. !>\ingroup mod_GFS_phys_time_vary @@ -41,7 +41,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) TG3FCS (Model%nx*Model%ny), & CNPFCS (Model%nx*Model%ny), & AISFCS (Model%nx*Model%ny), & -! F10MFCS(Model%nx*Model%ny), & +! F10MFCS(Model%nx*Model%ny), & VEGFCS (Model%nx*Model%ny), & VETFCS (Model%nx*Model%ny), & SOTFCS (Model%nx*Model%ny), & @@ -64,7 +64,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) character(len=6) :: tile_num_ch real(kind=kind_phys), parameter :: pifac=180.0/pi - real(kind=kind_phys) :: sig1t + real(kind=kind_phys) :: sig1t, dt_warm integer :: npts, len, nb, ix, jx, ls, ios logical :: exists ! @@ -110,7 +110,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ZORFCS (len) = Sfcprop(nb)%zorl (ix) TG3FCS (len) = Sfcprop(nb)%tg3 (ix) CNPFCS (len) = Sfcprop(nb)%canopy (ix) -! F10MFCS (len) = Sfcprop(nb)%f10m (ix) +! F10MFCS (len) = Sfcprop(nb)%f10m (ix) VEGFCS (len) = Sfcprop(nb)%vfrac (ix) VETFCS (len) = Sfcprop(nb)%vtype (ix) SOTFCS (len) = Sfcprop(nb)%stype (ix) @@ -191,21 +191,30 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) close (Model%nlunit) #endif - len = 0 + len = 0 do nb = 1,nblks do ix = 1,size(Grid(nb)%xlat,1) len = len + 1 Sfcprop(nb)%slmsk (ix) = SLIFCS (len) if ( Model%nstf_name(1) > 0 ) then Sfcprop(nb)%tref(ix) = TSFFCS (len) + dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & + / Sfcprop(nb)%xz(ix) + Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & + + dt_warm - Sfcprop(nb)%dt_cool(ix) else - Sfcprop(nb)%tsfc(ix) = TSFFCS (len) + Sfcprop(nb)%tsfc(ix) = TSFFCS (len) + Sfcprop(nb)%tsfco(ix) = TSFFCS (len) endif +! if (abs(slifcs(len) - 1.0) > 0.1) then +! if (sicfcs(len) < 1.0) then +! Sfcprop(nb)%tsfco(ix) = TSFFCS (len) +! endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) Sfcprop(nb)%zorl (ix) = ZORFCS (len) Sfcprop(nb)%tg3 (ix) = TG3FCS (len) Sfcprop(nb)%canopy (ix) = CNPFCS (len) -! Sfcprop(nb)%f10m (ix) = F10MFCS (len) +! Sfcprop(nb)%f10m (ix) = F10MFCS (len) Sfcprop(nb)%vfrac (ix) = VEGFCS (len) Sfcprop(nb)%vtype (ix) = VETFCS (len) Sfcprop(nb)%stype (ix) = SOTFCS (len) @@ -240,6 +249,6 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ! call mymaxmin(slifcs,len,len,1,'slifcs') ! ! if (Model%me .eq. 0) print*,'executed gcycle during hour=',fhour - + RETURN END From a8384f09d50a2ed398922c7c9a16489c0147c926 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 19 Feb 2020 17:13:07 +0000 Subject: [PATCH 20/24] seting tem(i) to 0.0 in ugwp_driver_v0.f --- physics/ugwp_driver_v0.F | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index b92fe7093..08ba2de5d 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -162,6 +162,7 @@ subroutine cires_ugwp_driver_v0(me, master, if (cdmbgwd(4) > 0.0) then do i=1,im turb_fac(i) = 0.0 + tem(i) = 0.0 enddo if (ntke > 0) then do k=1,(levs+levs)/3 From 08aa96dc1b98713cb241975c0631302db428dcc8 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 19 Feb 2020 20:08:51 +0000 Subject: [PATCH 21/24] removing some blanks in ugwp_driver_v0.F --- physics/ugwp_driver_v0.F | 336 +++++++++++++++++++-------------------- 1 file changed, 168 insertions(+), 168 deletions(-) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 08ba2de5d..4edd84a7a 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -8,7 +8,7 @@ module sso_coorde use machine, only: kind_phys real(kind=kind_phys),parameter :: pgwd = 1._kind_phys real(kind=kind_phys),parameter :: pgwd4 = 1._kind_phys - end module sso_coorde + end module sso_coorde ! ! ! Routine cires_ugwp_driver_v0 is replaced with cires_ugwp.F90/cires_ugwp_run in CCPP @@ -31,12 +31,12 @@ subroutine cires_ugwp_driver_v0(me, master, !----------------------------------------------------------- use machine, only : kind_phys use physcons, only : con_cp, con_g, con_rd, con_rv - + use ugwp_wmsdis_init, only : tamp_mpa, ilaunch use sso_coorde, only : pgwd, pgwd4 implicit none !input - + integer, intent(in) :: me, master integer, intent(in) :: im, levs, kdt, imx, nmtvr, ntke, ipr @@ -100,7 +100,7 @@ subroutine cires_ugwp_driver_v0(me, master, write(6,*) ' COORDE EXPER pgwd4 = ', pgwd4 print * endif - + do i=1,im zlwb(i) = 0. enddo @@ -155,7 +155,7 @@ subroutine cires_ugwp_driver_v0(me, master, ! GMAO GEOS-5/MERRA GW-forcing lat-dep !-------- call slat_geos5_tamp(im, tamp_mpa, xlatd, tau_ngw) - + ! call slat_geos5(im, xlatd, tau_ngw) ! if (abs(1.0-cdmbgwd(3)) > 1.0e-6) then @@ -216,7 +216,7 @@ subroutine cires_ugwp_driver_v0(me, master, enddo enddo endif - + if (pogw == 0.0) then ! zmtb = 0.; zogw =0. tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 @@ -224,7 +224,7 @@ subroutine cires_ugwp_driver_v0(me, master, endif return - + !============================================================================= ! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving ! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" @@ -255,11 +255,11 @@ subroutine cires_ugwp_driver_v0(me, master, end subroutine cires_ugwp_driver_v0 #endif -! -!===================================================================== +! +!===================================================================== ! !ugwp-v0 subroutines: GWDPS_V0 and fv3_ugwp_solv2_v0 -! +! !===================================================================== !>\ingroup cires_ugwp_run !> @{ @@ -278,8 +278,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! modified/revised version of gwdps.f (with bug fixes, tofd, appropriate ! computation of kref for OGW + COORDE diagnostics -! all constants/parameters inside cires_ugwp_initialize.F90 -!---------------------------------------- +! all constants/parameters inside cires_ugwp_initialize.F90 +!---------------------------------------- USE MACHINE , ONLY : kind_phys use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 @@ -336,7 +336,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! !--------------------------------------------------------------------- ! # of permissible sub-grid orography hills for "any" resolution < 25 -! correction for "elliptical" hills based on shilmin-area =sgrid/25 +! correction for "elliptical" hills based on shilmin-area =sgrid/25 ! 4.*gamma*b_ell*b_ell >= shilmin ! give us limits on [b_ell & gamma *b_ell] > 5 km =sso_min ! gamma_min = 1/4*shilmin/sso_min/sso_min @@ -354,21 +354,21 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, real(kind=kind_phys) :: belpmin, dsmin, dsmax ! real(kind=kind_phys) :: arhills(im) ! not used why do we need? real(kind=kind_phys) :: xlingfs - -! -! locals + +! +! locals ! mean flow real(kind=kind_phys), dimension(im,km) :: RI_N, BNV2, RO &, VTK, VTJ, VELCO -!mtb +!mtb real(kind=kind_phys), dimension(im) :: OA, CLX , elvmax, wk &, PE, EK, UP - + real(kind=kind_phys), dimension(im,km) :: DB, ANG, UDS real(kind=kind_phys) :: ZLEN, DBTMP, R, PHIANG, DBIM, ZR real(kind=kind_phys) :: ENG0, ENG1, COSANG2, SINANG2 - real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem + real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem ! ! TOFD ! Some constants now in "use ugwp_oro_init" + "use ugwp_common" @@ -379,7 +379,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, &, epstofd1, krf_tofd1 &, up1, vp1, zpm real(kind=kind_phys),dimension(im, km) :: axtms, aytms -! +! ! OGW ! LOGICAL ICRILV(IM) @@ -390,9 +390,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, real(kind=kind_phys) :: TAUP(IM,km+1), TAUD(IM,km) real(kind=kind_phys) :: taub(im), taulin(im), heff, hsat, hdis - integer, dimension(im) :: kref, idxzb, ipt, kreflm, + integer, dimension(im) :: kref, idxzb, ipt, kreflm, & iwklm, iwk, izlow -! +! !check what we need ! real(kind=kind_phys) :: bnv, fr, ri_gw @@ -406,15 +406,15 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, &, cdmb4, mtbridge &, kxridge, inv_b2eff, zw1, zw2 &, belps, aelps, nhills, selps - + integer :: kmm1, kmm2, lcap, lcapp1 &, npt, kbps, kbpsp1,kbpsm1 &, kmps, idir, nwd, klcap, kp1, kmpbl, kmll &, k_mtb, k_zlow, ktrial, klevm1, i, j, k -! +! rcpdt = 1.0 / (cpd*dtp) grav2 = grav + grav -! +! ! mtb-blocking sigma_min and dxres => cires_initialize ! sgrmax = maxval(sparea) ; sgrmin = minval(sparea) @@ -451,7 +451,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, idxzb(i) = 0 zmtb(i) = 0.0 zogw(i) = 0.0 - rdxzb(i) = 0.0 + rdxzb(i) = 0.0 tau_ogw(i) = 0.0 tau_mtb(i) = 0.0 dusfc(i) = 0.0 @@ -474,13 +474,13 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, dudt_tms(i,k) = 0.0 enddo enddo - + ! ---- for lm and gwd calculation points - + npt = 0 do i = 1,im if ( elvmaxd(i) >= hminmt .and. hprime(i) >= hpmin ) then - + npt = npt + 1 ipt(npt) = i ! arhills(i) = 1.0 @@ -495,7 +495,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! small-scale "turbulent" oro-scales < sso_min ! if( aelps < sso_min .and. do_adjoro) then - + ! a, b > sso_min upscale ellipse a/b > 0.1 a>sso_min & h/b=>new_sigm ! aelps = sso_min @@ -508,22 +508,22 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, sigma(i) = 2.*hprime(i)/aelps gamma(i) = min(aelps/belps, 1.0) endif - - selps = belps*belps*gamma(i)*4. ! ellipse area of the el-c hill + + selps = belps*belps*gamma(i)*4. ! ellipse area of the el-c hill nhills = min(nhilmax, sparea(i)/selps) ! arhills(i) = max(nhills, 1.0) -!333 format( ' nhil: ', I6, 4(2x, F9.3), 2(2x, E9.3)) +!333 format( ' nhil: ', I6, 4(2x, F9.3), 2(2x, E9.3)) ! if (kdt==1 ) ! & write(6,333) nint(nhills)+1,xlatd(i), hprime(i),aelps*1.e-3, ! & belps*1.e-3, sigma(i),gamma(i) endif enddo - + IF (npt == 0) then ! print *, 'oro-npt = 0 elvmax ', maxval(elvmaxd), hminmt -! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin +! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin RETURN ! No gwd/mb calculation done endif @@ -533,18 +533,18 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, IDXZB(i) = 0 kreflm(i) = 0 enddo - + do k=1,km do i=1,im db(i,k) = 0.0 ang(i,k) = 0.0 - uds(i,k) = 0.0 + uds(i,k) = 0.0 enddo enddo KMM1 = km - 1 ; KMM2 = km - 2 ; KMLL = kmm1 LCAP = km ; LCAPP1 = LCAP + 1 - + DO I = 1, npt j = ipt(i) ELVMAX(J) = min (ELVMAXd(J)*0. + sigfac * hprime(j), hncrit) @@ -595,18 +595,18 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, BVF2 = grav2 * RDZ * (VTK(I,K+1)-VTK(I,K)) & / (VTK(I,K+1)+VTK(I,K)) bnv2(i,k+1) = max( BVF2, bnv2min ) - RI_N(I,K+1) = Bnv2(i,k)/SHR2 ! Richardson number consistent with BNV2 + RI_N(I,K+1) = Bnv2(i,k)/SHR2 ! Richardson number consistent with BNV2 ! ! add here computation for Ktur and OGW-dissipation fro VE-GFS -! +! ENDDO ENDDO K = 1 DO I = 1, npt bnv2(i,k) = bnv2(i,k+1) ENDDO -! -! level iwklm =>phil(j,k)/g < sigfac * hprime(j) < phil(j,k+1)/g +! +! level iwklm =>phil(j,k)/g < sigfac * hprime(j) < phil(j,k+1)/g ! DO I = 1, npt J = ipt(i) @@ -625,13 +625,13 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, DO I = 1, npt k_zlow = izlow(I) if (k_zlow == iwklm(i)) k_zlow = 1 - DO K = k_zlow, iwklm(I)-1 ! Kreflm(I)= iwklm(I)-1 + DO K = k_zlow, iwklm(I)-1 ! Kreflm(I)= iwklm(I)-1 J = ipt(i) ! laye-aver Rho, U, V RDELKS = DEL(J,K) * DELKS(I) - UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below - VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below - ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below -! + UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below + VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below + ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below +! BNV2bar(I) = BNV2bar(I) + .5*(BNV2(I,K)+BNV2(I,K+1))* RDELKS ENDDO ENDDO @@ -641,7 +641,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! integrate from Ztoph = sigfac*hprime down to Zblk if exists ! find ph_blk, dz_blk like in LM-97 and IFS -! +! ph_blk =0. DO K = iwklm(I), 1, -1 PHIANG = atan2(V1(J,K),U1(J,K))*RAD_TO_DEG @@ -702,54 +702,54 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! --- The drag for mtn blocked flow -! +! cdmb4 = 0.25*cdmb DO I = 1, npt J = ipt(i) ! IF ( IDXZB(I) > 0 ) then -! (4.16)-IFS +! (4.16)-IFS gam2 = gamma(j)*gamma(j) BGAM = 1.0 - 0.18*gamma(j) - 0.04*gam2 CGAM = 0.48*gamma(j) + 0.30*gam2 DO K = IDXZB(I)-1, 1, -1 - ZLEN = SQRT( ( PHIL(J,IDXZB(I)) - PHIL(J,K) ) / + ZLEN = SQRT( ( PHIL(J,IDXZB(I)) - PHIL(J,K) ) / & ( PHIL(J,K ) + Grav * hprime(J) ) ) tem = cos(ANG(I,K)) COSANG2 = tem * tem SINANG2 = 1.0 - COSANG2 -! +! ! cos =1 sin =0 => 1/R= gam ZR = 2.-gam ! cos =0 sin =1 => 1/R= 1/gam ZR = 2.- 1/gam ! rdem = COSANG2 + GAM2 * SINANG2 rnom = COSANG2*GAM2 + SINANG2 -! +! ! metOffice Dec 2010 ! correction of H. Wells & A. Zadra for the ! aspect ratio of the hill seen by MF ! (1/R , R-inverse below: 2-R) - rdem = max(rdem, 1.e-6) + rdem = max(rdem, 1.e-6) R = sqrt(rnom/rdem) ZR = MAX( 2. - R, 0. ) sigres = max(sigmin, sigma(J)) if (hprime(J)/sigres > dxres) sigres = hprime(J)/dxres mtbridge = ZR * sigres*ZLEN / hprime(J) -! (4.15)-IFS +! (4.15)-IFS ! DBTMP = CDmb4 * mtbridge * ! & MAX(cos(ANG(I,K)), gamma(J)*sin(ANG(I,K))) ! (4.16)-IFS DBTMP = CDmb4*mtbridge*(bgam* COSANG2 +cgam* SINANG2) DB(I,K)= DBTMP * UDS(I,K) ENDDO -! +! endif ENDDO -! +! !............................. !............................. ! end mtn blocking section @@ -757,7 +757,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, !............................. ! !--- Orographic Gravity Wave Drag Section -! +! ! Scale cleff between IM=384*2 and 192*2 for T126/T170 and T62 ! inside "cires_ugwp_initialize.F90" now ! @@ -772,12 +772,12 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, j = ipt(i) tem = (prsi(j,1) - prsi(j,k)) if (tem < dpmin) iwk(i) = k ! dpmin=50 mb - -!=============================================================== -! lev=111 t=311.749 hkm=0.430522 Ps-P(iwk)=52.8958 + +!=============================================================== +! lev=111 t=311.749 hkm=0.430522 Ps-P(iwk)=52.8958 ! below "Hprime" - source of OGWs and below Zblk !!! ! 27 2 kpbl ~ 1-2 km < Hprime -!=============================================================== +!=============================================================== enddo enddo ! @@ -869,7 +869,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, BNV = SQRT( BNV2bar(I) ) heff = min(HPRIME(J),hpmax) - if( zmtb(j) > 0.) heff = max(sigfac*heff-zmtb(j), 0.)/sigfac + if( zmtb(j) > 0.) heff = max(sigfac*heff-zmtb(j), 0.)/sigfac if (heff <= 0) cycle hsat = fcrit_gfs*ULOW(I)/bnv @@ -910,7 +910,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! TAUB(I) = taulin(i) ! linear flux for FR <= fcrit_gfs ! endif -! +! ! K = MAX(1, kref(I)-1) TEM = MAX(VELCO(I,K)*VELCO(I,K), dw2min) @@ -920,7 +920,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! zogw(J) = PHII(j, kref(I)) *rgrav ENDDO -! +! !----SET UP BOTTOM VALUES OF STRESS ! DO K = 1, KBPS @@ -928,9 +928,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, IF (K <= kref(I)) TAUP(I,K) = TAUB(I) ENDDO ENDDO - + if (strsolver == 'PSS-1986') then - + !====================================================== ! V0-GFS OROGW-solver of Palmer et al 1986 -"PSS-1986" ! in V1-OROGW LINSATDIS of "WAM-2017" @@ -938,7 +938,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! rotational/non-hydrostat OGWs important for ! HighRES-FV3GFS with dx < 10 km !====================================================== - + DO K = KMPS, KMM1 ! Vertical Level Loop KP1 = K + 1 DO I = 1, npt @@ -993,9 +993,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ENDIF ENDDO ENDDO -! +! ! zero momentum deposition at the top model layer -! +! taup(1:npt,km+1) = taup(1:npt,km) ! ! Calculate wave acc-n: - (grav)*d(tau)/d(p) = taud @@ -1011,7 +1011,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! DO I = 1,npt ! TAUD(I, km) = TAUD(I,km) * FACTOP ! ENDDO - + !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ !------IF THE GRAVITY WAVE DRAG WOULD FORCE A CRITICAL LINE IN THE !------LAYERS BELOW SIGMA=RLOLEV DURING THE NEXT DELTIM TIMESTEP, @@ -1035,73 +1035,73 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ENDDO ! !--------------------------- OROGW-solver of GFS PSS-1986 -! - else +! + else ! !--------------------------- OROGW-solver of WAM2017 ! ! sigres = max(sigmin, sigma(J)) ! if (heff/sigres.gt.dxres) sigres=heff/dxres ! inv_b2eff = 0.5*sigres/heff -! XLINV(I) = max(kxridge, inv_b2eff) ! 0.5*sigma(j)/heff = 1./Lridge +! XLINV(I) = max(kxridge, inv_b2eff) ! 0.5*sigma(j)/heff = 1./Lridge dtfac(:) = 1.0 call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, - & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsL, + & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsL, & del, sigma, hprime, gamma, theta, & sinlat, xlatd, taup, taud, pkdis) endif ! oro_wam_2017 - LINSATDIS-solver of WAM-2017 -! +! !--------------------------- OROGW-solver of WAM2017 ! ! TOFD as in BELJAARS-2004 ! -! --------------------------- +! --------------------------- IF( do_tofd ) then - axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 + axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 if ( kdt == 1 .and. me == 0) then - print *, 'VAY do_tofd from surface to ', ztop_tofd + print *, 'VAY do_tofd from surface to ', ztop_tofd endif - DO I = 1,npt + DO I = 1,npt J = ipt(i) zpbl =rgrav*phil( j, kpbl(j) ) - + sigflt = min(sgh30(j), 0.3*hprime(j)) ! cannot exceed 30% of LS-SSO - + zsurf = phii(j,1)*rgrav do k=1,km zpm(k) = phiL(j,k)*rgrav up1(k) = u1(j,k) vp1(k) = v1(j,k) enddo - - call ugwp_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, + + call ugwp_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, & up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) - + do k=1,km axtms(j,k) = utofd1(k) aytms(j,k) = vtofd1(k) -! +! ! add TOFD to GW-tendencies -! +! pdvdt(J,k) = pdvdt(J,k) + aytms(j,k) pdudt(J,k) = pdudt(J,k) + axtms(j,k) enddo !2018-diag tau_tofd(J) = sum( utofd1(1:km)* del(j,1:km)) enddo - ENDIF ! do_tofd + ENDIF ! do_tofd !--------------------------- ! combine oro-drag effects -!--------------------------- +!--------------------------- ! + diag-3d - dudt_tms = axtms + dudt_tms = axtms tau_ogw = 0. tau_mtb = 0. - + DO K = 1,KM DO I = 1,npt J = ipt(i) @@ -1111,29 +1111,29 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, if ( K < IDXZB(I) .AND. IDXZB(I) /= 0 ) then ! ! if blocking layers -- no OGWs -! +! DBIM = DB(I,K) / (1.+DB(I,K)*DTP) Pdvdt(j,k) = - DBIM * V1(J,K) +Pdvdt(j,k) Pdudt(j,k) = - DBIM * U1(J,K) +Pdudt(j,k) ENG1 = ENG0*(1.0-DBIM*DTP)*(1.-DBIM*DTP) - + DUSFC(J) = DUSFC(J) - DBIM * U1(J,K) * DEL(J,K) DVSFC(J) = DVSFC(J) - DBIM * V1(J,K) * DEL(J,K) -!2018-diag +!2018-diag dudt_mtb(j,k) = -DBIM * U1(J,K) tau_mtb(j) = tau_mtb(j) + dudt_mtb(j,k)* DEL(J,K) else ! ! OGW-s above blocking height -! +! TAUD(I,K) = TAUD(I,K) * DTFAC(I) DTAUX = TAUD(I,K) * XN(I) * pgwd DTAUY = TAUD(I,K) * YN(I) * pgwd - + Pdvdt(j,k) = DTAUY +Pdvdt(j,k) Pdudt(j,k) = DTAUX +Pdudt(j,k) - + unew = U1(J,K) + DTAUX*dtp ! Pdudt(J,K)*DTP vnew = V1(J,K) + DTAUY*dtp ! Pdvdt(J,K)*DTP ENG1 = 0.5*(unew*unew + vnew*vnew) @@ -1144,10 +1144,10 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, dudt_ogw(j,k) = DTAUX tau_ogw(j) = tau_ogw(j) +DTAUX*DEL(j,k) endif -! +! ! local energy deposition SSO-heat -! - Pdtdt(j,k) = max(ENG0-ENG1,0.)*rcpdt +! + Pdtdt(j,k) = max(ENG0-ENG1,0.)*rcpdt ENDDO ENDDO ! dusfc w/o tofd sign as in the ERA-I, MERRA and CFSR @@ -1211,13 +1211,13 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! TEM = MAX(VELCO(I,K)*VELCO(I,K), 0.1) ! TEMV = 1.0 / max(VELCO(I,K), 0.01) ! & * max(VELCO(I,K),0.01) -!.................................................................... +!.................................................................... enddo print * stop endif endif - + ! RETURN !--------------------------------------------------------------- @@ -1229,11 +1229,11 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! d) solver of Palmer et al. (1987) => Linsat of McFarlane ! -!--------------------------------------------------------------- - end subroutine gwdps_v0 - - - +!--------------------------------------------------------------- + end subroutine gwdps_v0 + + + !=============================================================================== ! use fv3gfs-v0 ! first beta version of ugwp for fv3gfs-128 @@ -1243,8 +1243,8 @@ end subroutine gwdps_v0 ! next will be lsatdis for both fv3wam & fv3gfs-128l implementations ! with (a) stochastic-deterministic propagation solvers for wave packets/spectra ! (b) gw-sources: oro/convection/dyn-instability (fronts/jets/pv-anomalies) -! (c) guidance from high-res runs for GW sources and res-aware tune-ups -!23456 +! (c) guidance from high-res runs for GW sources and res-aware tune-ups +!23456 ! ! call gwdrag_wam(1, im, ix, km, ksrc, dtp, ! & xlat, gw_dudt, gw_dvdt, taux, tauy) @@ -1271,8 +1271,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! nov 2015 alternative gw-solver for nggps-wam ! nov 2017 nh/rotational gw-modes for nh-fv3gfs ! --------------------------------------------------------------------------------- -! - +! + use ugwp_common , only : rgrav, grav, cpd, rd, rv &, omega2, rcpd2, pi, pi2, fv &, rad_to_deg, deg_to_rad @@ -1286,15 +1286,15 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, &, zci, zdci, zci4, zci3, zci2 &, zaz_fct, zcosang, zsinang &, nwav, nazd, zcimin, zcimax -! +! implicit none -!23456 - +!23456 + integer, intent(in) :: klev ! vertical level integer, intent(in) :: klon ! horiz tiles - real, intent(in) :: dtime ! model time step - real, intent(in) :: vm1(klon,klev) ! meridional wind + real, intent(in) :: dtime ! model time step + real, intent(in) :: vm1(klon,klev) ! meridional wind real, intent(in) :: um1(klon,klev) ! zonal wind real, intent(in) :: qm1(klon,klev) ! spec. humidity real, intent(in) :: tm1(klon,klev) ! kin temperature @@ -1308,36 +1308,36 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real, intent(in) :: tau_ngw(klon) integer, intent(in) :: mpi_id, master, kdt -! +! ! ! out-gw effects ! real, intent(out) :: pdudt(klon,klev) ! zonal momentum tendency real, intent(out) :: pdvdt(klon,klev) ! meridional momentum tendency real, intent(out) :: pdtdt(klon,klev) ! gw-heating (u*ax+v*ay)/cp - real, intent(out) :: dked(klon,klev) ! gw-eddy diffusion - real, parameter :: minvel = 0.5 ! - real, parameter :: epsln = 1.0d-12 ! - + real, intent(out) :: dked(klon,klev) ! gw-eddy diffusion + real, parameter :: minvel = 0.5 ! + real, parameter :: epsln = 1.0d-12 ! + !vay-2018 - + real :: taux(klon,klev+1) ! EW component of vertical momentum flux (pa) real :: tauy(klon,klev+1) ! NS component of vertical momentum flux (pa) - real :: phil(klon,klev) ! gphil/grav + real :: phil(klon,klev) ! gphil/grav ! ! local =============================================================================================== ! - -! real :: zthm1(klon,klev) ! temperature interface levels - real :: zthm1 ! 1.0 / temperature interface levels + +! real :: zthm1(klon,klev) ! temperature interface levels + real :: zthm1 ! 1.0 / temperature interface levels real :: zbvfhm1(klon,ilaunch:klev) ! interface BV-frequency - real :: zbn2(klon,ilaunch:klev) ! interface BV-frequency + real :: zbn2(klon,ilaunch:klev) ! interface BV-frequency real :: zrhohm1(klon,ilaunch:klev) ! interface density real :: zuhm1(klon,ilaunch:klev) ! interface zonal wind real :: zvhm1(klon,ilaunch:klev) ! meridional wind real :: v_zmet(klon,ilaunch:klev) real :: vueff(klon,ilaunch:klev) - real :: zbvfl(klon) ! BV at launch level + real :: zbvfl(klon) ! BV at launch level real :: c2f2(klon) !23456 @@ -1368,7 +1368,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real :: zcin2, zbvfl2, zcin3, zbvfl3, zcinc real :: zatmp, zfluxs, zdep, zfluxsq, zulm, zdft, ze1, ze2 -! +! real :: zdelp,zrgpts real :: zthstd,zrhostd,zbvfstd real :: tvc1, tvm1, tem1, tem2, tem3 @@ -1380,13 +1380,13 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real, parameter :: rcpdl = cpd/grav ! 1/[g/cp] == cp/g &, grav2cpd = grav/rcpdl ! g*(g/cp)= g^2/cp &, cpdi = 1.0d0/cpd - + real :: expdis, fdis ! real :: fmode, expdis, fdis real :: v_kzi, v_kzw, v_cdp, v_wdp, sc, tx1 integer :: j, k, inc, jk, jl, iazi -! +! !-------------------------------------------------------------------------- ! do k=1,klev @@ -1398,14 +1398,14 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, phil(j,k) = philg(j,k) * rgrav enddo enddo -!----------------------------------------------------------- +!----------------------------------------------------------- ! also other options to alter tropical values ! tamp = 100.e-3*1.e3 = 100 mpa -! vay-2017 zfluxglob=> lat-dep here from geos-5/merra-2 +! vay-2017 zfluxglob=> lat-dep here from geos-5/merra-2 !----------------------------------------------------------- -! call slat_geos5_tamp(klon, tamp_mpa, xlatd, tau_ngw) +! call slat_geos5_tamp(klon, tamp_mpa, xlatd, tau_ngw) + - ! phil = philg*rgrav ! rcpd = 1.0/(grav/cpd) ! 1/[g/cp] @@ -1429,7 +1429,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo enddo -! +! ! set initial min Cxi for critical level absorption do iazi=1,nazd do jl=1,klon @@ -1458,7 +1458,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, zbn2(jl,jk) = grav2cpd*zthm1 & * (1.0+rcpdl*(tm1(jl,jk)-tm1(jl,jk-1))/zdelp) zbn2(jl,jk) = max(min(zbn2(jl,jk), gssec), bv2min) - zbvfhm1(jl,jk) = sqrt(zbn2(jl,jk)) ! bn = sqrt(bn2) + zbvfhm1(jl,jk) = sqrt(zbn2(jl,jk)) ! bn = sqrt(bn2) enddo enddo @@ -1479,9 +1479,9 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, C2F2(JL) = tx1 * tx1 zbvfl(jl) = zbvfhm1(jl,ilaunch) enddo -! +! ! define intrinsic velocity (relative to launch level velocity) u(z)-u(zo), and coefficinets -! ------------------------------------------------------------------------------------------ +! ------------------------------------------------------------------------------------------ do iazi=1, nazd do jl=1,klon zul(jl,iazi) = zcosang(iazi) * zuhm1(jl,ilaunch) @@ -1572,7 +1572,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, zpu(jl,ilaunch,1) = zpu(jl,ilaunch,1) + zflux(jl,inc,1)*zcinc enddo enddo -! +! ! normalize and include lat-dep (precip or merra-2) ! ----------------------------------------------------------- ! also other options to alter tropical values @@ -1615,7 +1615,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo enddo -! ------------------------------------------------------------- +! ------------------------------------------------------------- ! azimuth do-loop ! -------------------- do iazi=1, nazd @@ -1683,7 +1683,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! saturated limit wfit = kzw*kzw*kt; wfdt = wfit/(kxw*cx)*betat ! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) ! define kxw = -!======================================================================= +!======================================================================= v_cdp = abs(zcin-zui(jL,jk,iazi)) v_wdp = v_kxw*v_cdp wdop2 = v_wdp* v_wdp @@ -1698,7 +1698,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! !linsatdis: kzw2, kzw3, kdsat, c2f2, cdf2, cdf1 ! -!kzw2 = (zBn2(k)-wdop2)/Cdf2 - rhp4 - v_kx2w ! full lin DS-NiGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) +!kzw2 = (zBn2(k)-wdop2)/Cdf2 - rhp4 - v_kx2w ! full lin DS-NiGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) ! Kds = kxw*Cdf1*rhp2/kzw3 ! v_cdp = sqrt( cdf2 ) @@ -1711,7 +1711,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, v_kzw = 0. v_cdp = 0. ! no effects of reflected waves endif - + ! fmode = zflux(jl,inc,iazi) ! fdis = fmode*expdis fdis = expdis * zflux(jl,inc,iazi) @@ -1765,25 +1765,25 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! ! endif - enddo !jl=1,klon + enddo !jl=1,klon enddo !waves inc=1,nwav ! -------------- enddo ! end jk do-loop vertical loop ! --------------- enddo ! end nazd do-loop -! ---------------------------------------------------------------------------- +! ---------------------------------------------------------------------------- ! sum contribution for total zonal and meridional flux + ! energy dissipation ! --------------------------------------------------- -! +! do jk=1,klev+1 do jl=1,klon - taux(jl,jk) = 0.0 - tauy(jl,jk) = 0.0 + taux(jl,jk) = 0.0 + tauy(jl,jk) = 0.0 enddo - enddo - + enddo + tem3 = zaz_fct*cpdi do iazi=1,nazd tem1 = zaz_fct*zcosang(iazi) @@ -1799,7 +1799,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo ! ! update du/dt and dv/dt tendencies ..... no contribution to heating => keddy/tracer-mom-heat -! ---------------------------- +! ---------------------------- ! do jk=ilaunch,klev @@ -1825,7 +1825,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! if (dked(jl,jk) < 0) dked(jl,jk) = dked_min enddo enddo -! +! ! add limiters/efficiency for "unbalanced ics" if it is needed ! do jk=ilaunch,klev @@ -1836,7 +1836,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, dked(jl,jk) = gw_eff * dked(jl,jk) enddo enddo -! +! !--------------------------------------------------------------------------- ! if (kdt == 1 .and. mpi_id == master) then @@ -1890,7 +1890,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ! locals ! integer :: i, j, k -!------------------------------------------------------------------------ +!------------------------------------------------------------------------ ! solving 1D-vertical eddy diffusion to "smooth" ! GW-related tendencies: du/dt, dv/dt, d(PT)/dt ! we need to use sum of molecular + eddy terms including turb-part @@ -1901,7 +1901,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ! this "diffusive-way" is tested with UGWP-tendencies ! forced by various wave sources. X' =dx/dt *dt ! d(X + X')/dt = K*diff(X + X') => -! +! ! wave1 dX'/dt = Kw * diff(X')... eddy part "Kwave" on wave-part ! turb2 dX/dt = Kturb * diff(X) ... resolved scale mixing "Kturb" like PBL ! we may assume "zero-GW"-tendency at the top lid and "zero" flux @@ -1921,7 +1921,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, real(kind=kind_phys),dimension(levs) :: bn2, shr2, ksum real(kind=kind_phys) :: eps_shr, eps_bn2, eps_dis real(kind=kind_phys) :: rdz , uz, vz, ptz -! ------------------------------------------------------------------------- +! ------------------------------------------------------------------------- ! Prw*Lsat2 =1, for GW-eddy diffusion Pr_wave = Kv/Kt ! Pr_wave ~1/Lsat2 = 1/Frcit2 = 2. => Lsat2 = 1./2 (Frc ~0.7) ! m*u'/N = u'/{c-U) = h'N/(c-U) = Lsat = Fcrit @@ -1936,11 +1936,11 @@ subroutine edmix_ugwp_v0(im, levs, dtp, real(kind=kind_phys), parameter :: prmax = 4.0 real(kind=kind_phys), parameter :: hps = 7000., h4 = 0.25/hps real(kind=kind_phys), parameter :: kedmin = 0.01, kedmax = 250. - - + + real(kind=kind_phys) :: rdtp, rineg, kamp, zmet, zgrow real(kind=kind_phys) :: stab, stab_dt, dtstab, ritur - integer :: nstab + integer :: nstab real(kind=kind_phys) :: w1, w2, w3 rdtp = 1./dtp nstab = 1 @@ -1963,17 +1963,17 @@ subroutine edmix_ugwp_v0(im, levs, dtp, uz = up(k+1)-up(k) vz = vp(k+1)-vp(k) ptz =2.*(pt(k+1)-pt(k))/(pt(k+1)+pt(k)) - shr2(k) = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) + shr2(k) = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) bn2(k) = grav*rdz*ptz zmet = phil(j,k)*rgrav zgrow = exp(zmet*h4) if ( bn2(k) < 0. ) then -! +! ! adjust PT-profile to bn2(k) = bnv2min -- neutral atmosphere ! adapt "pdtdt = (Ptadj-Ptdyn)/Ptmap" ! print *,' UGWP-V0 unstab PT(z) via gwdTdt ', bn2(k), k - + rineg = bn2(k)/shr2(k) bn2(k) = max(bn2(k), bnv2min) kamp = sqrt(shr2(k))*sc2u *zgrow @@ -2000,7 +2000,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, Fw(1:levs) = pdudt(i, 1:levs) Fw1(1:levs) = pdvdt(i, 1:levs) Km(1:levs) = ksum(1:levs) * rho(1:levs)* rho(1:levs) - + do j=1, nstab call diff_1d_wtend(levs, dtstab, Fw, Fw1, Km, & rdp, rdpm, Sw, Sw1) @@ -2010,7 +2010,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ed_dudt(i,:) = Sw ed_dvdt(i,:) = Sw1 - + Pt(1:levs) = t1(i,1:levs)*Ptmap(1:levs) Kpt = Km*iPr_pt Fw(1:levs) = pdTdt(i, 1:levs)*Ptmap(1:levs) @@ -2021,7 +2021,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ed_dtdt(i,1:levs) = Sw(1:levs)/Ptmap(1:levs) enddo - + end subroutine edmix_ugwp_v0 subroutine diff_1d_wtend(levs, dt, F, F1, Km, rdp, rdpm, S, S1) @@ -2032,8 +2032,8 @@ subroutine diff_1d_wtend(levs, dt, F, F1, Km, rdp, rdpm, S, S1) real(kind=kind_phys) :: S(levs), S1(levs), F(levs), F1(levs) real(kind=kind_phys) :: Km(levs), rdp(levs), rdpm(levs-1) integer :: i, k - real(kind=kind_phys) :: Kp1, ad, cd, bd -! real(kind=kind_phys) :: km1, Kp1, ad, cd, bd + real(kind=kind_phys) :: Kp1, ad, cd, bd +! real(kind=kind_phys) :: km1, Kp1, ad, cd, bd ! S(:) = 0.0 ; S1(:) = 0.0 ! ! explicit diffusion solver From 21190a8d03d977b0569d39a34cb38d4cabee580e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 26 Feb 2020 19:00:54 +0000 Subject: [PATCH 22/24] fixing a bug in gcycle update --- physics/gcycle.F90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 0395c39a7..0ac688ffb 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -198,18 +198,16 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%slmsk (ix) = SLIFCS (len) if ( Model%nstf_name(1) > 0 ) then Sfcprop(nb)%tref(ix) = TSFFCS (len) - dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & - / Sfcprop(nb)%xz(ix) - Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & - + dt_warm - Sfcprop(nb)%dt_cool(ix) + if ( Model%nstf_name(2) = 0 ) then + dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & + / Sfcprop(nb)%xz(ix) + Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & + + dt_warm - Sfcprop(nb)%dt_cool(ix) + endif else Sfcprop(nb)%tsfc(ix) = TSFFCS (len) Sfcprop(nb)%tsfco(ix) = TSFFCS (len) endif -! if (abs(slifcs(len) - 1.0) > 0.1) then -! if (sicfcs(len) < 1.0) then -! Sfcprop(nb)%tsfco(ix) = TSFFCS (len) -! endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) Sfcprop(nb)%zorl (ix) = ZORFCS (len) Sfcprop(nb)%tg3 (ix) = TG3FCS (len) From 02a0e7ff846b8dc7a1bc3734ea03b2b2c7e504e0 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 26 Feb 2020 20:08:51 +0000 Subject: [PATCH 23/24] fixing a typo in gcycle.F90 --- physics/gcycle.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 0ac688ffb..0334f2479 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -198,7 +198,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%slmsk (ix) = SLIFCS (len) if ( Model%nstf_name(1) > 0 ) then Sfcprop(nb)%tref(ix) = TSFFCS (len) - if ( Model%nstf_name(2) = 0 ) then + if ( Model%nstf_name(2) == 0 ) then dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & / Sfcprop(nb)%xz(ix) Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & From 5936661510b5f8b28a52f0ecbc14599e3c46964c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 27 Feb 2020 11:48:41 +0000 Subject: [PATCH 24/24] removing updating tsfco in gcycle when nsstr is on --- physics/gcycle.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 0334f2479..bb1730fc2 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -198,12 +198,12 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%slmsk (ix) = SLIFCS (len) if ( Model%nstf_name(1) > 0 ) then Sfcprop(nb)%tref(ix) = TSFFCS (len) - if ( Model%nstf_name(2) == 0 ) then - dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & - / Sfcprop(nb)%xz(ix) - Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & - + dt_warm - Sfcprop(nb)%dt_cool(ix) - endif +! if ( Model%nstf_name(2) == 0 ) then +! dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & +! / Sfcprop(nb)%xz(ix) +! Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & +! + dt_warm - Sfcprop(nb)%dt_cool(ix) +! endif else Sfcprop(nb)%tsfc(ix) = TSFFCS (len) Sfcprop(nb)%tsfco(ix) = TSFFCS (len)