From ab96404961a9357dea4c7a2bfce19af80545297c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 18 Sep 2019 15:53:56 +0000 Subject: [PATCH 01/84] 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 9c059f066ebde552c901ae5b6c439decbbaef316 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 18 Sep 2019 15:53:56 +0000 Subject: [PATCH 02/84] 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 8f480db3378d7ca03c788c4b7865277651779c70 Mon Sep 17 00:00:00 2001 From: climbfuji Date: Mon, 23 Sep 2019 08:12:37 -0600 Subject: [PATCH 03/84] physics/GFS_debug.F90, physics/rrtmg_lw_pre.F90, physics/rrtmg_sw_pre.F90: follow-up commit to ab96404961a9357dea4c7a2bfce19af80545297c to update changes to new metadata format --- physics/GFS_debug.F90 | 155 ++++++++++++++++++++++++++++----------- physics/rrtmg_lw_pre.F90 | 12 +-- physics/rrtmg_sw_pre.F90 | 19 +---- 3 files changed, 113 insertions(+), 73 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 30a25f93e..17d971c7a 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -3,7 +3,7 @@ module GFS_diagtoscreen private - + public GFS_diagtoscreen_init, GFS_diagtoscreen_run, GFS_diagtoscreen_finalize public print_my_stuff, chksum_int, chksum_real @@ -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, & @@ -633,7 +617,7 @@ subroutine print_real_2d(mpirank,omprank,blkno,name,var) integer, intent(in) :: mpirank, omprank, blkno character(len=*), intent(in) :: name real(kind_phys), intent(in) :: var(:,:) - + integer :: k, i #ifdef PRINT_SUM @@ -760,7 +744,7 @@ end module GFS_diagtoscreen module GFS_interstitialtoscreen private - + public GFS_interstitialtoscreen_init, GFS_interstitialtoscreen_run, GFS_interstitialtoscreen_finalize contains @@ -772,23 +756,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, & @@ -888,7 +856,7 @@ end module GFS_interstitialtoscreen module GFS_abort private - + public GFS_abort_init, GFS_abort_run, GFS_abort_finalize contains @@ -900,12 +868,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) @@ -933,3 +896,107 @@ 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 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 11e1d3d37898d1855a1cf1b1dadfcfecb9d0c783 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Mon, 7 Oct 2019 18:10:30 +0000 Subject: [PATCH 04/84] Fix the unit conversion for soil moisture content. --- physics/sfc_drv_ruc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 64e4d4597..61246b67d 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -897,7 +897,7 @@ subroutine lsm_ruc_run & ! inputs sfcdew(i) = dew(i,j) qsurf(i) = qsfc(i,j) sncovr1(i) = sncovr(i,j) - stm(i) = soilm(i,j) * 1000.0 ! unit conversion (from m to kg m-2) + stm(i) = soilm(i,j) tsurf(i) = soilt(i,j) tice(i) = tsurf(i) From cb60e202f45f716acef551cef8096e64373c7527 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Tue, 8 Oct 2019 21:14:10 +0000 Subject: [PATCH 05/84] Added semi-implicit time differencing for turbulent form drag and small-scale gravity wave drag schemes -- allows for longer time step --- physics/drag_suite.F90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 56902c631..eb371adb1 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -485,7 +485,7 @@ subroutine drag_suite_run( & varmax_fd = 150., & beta_ss = 0.1, & beta_fd = 0.2 - real(kind=kind_phys) :: var_temp + real(kind=kind_phys) :: var_temp, var_temp2 ! added Beljaars orographic form drag real(kind=kind_phys), dimension(im,km) :: utendform,vtendform @@ -1060,7 +1060,9 @@ subroutine drag_suite_run( & !tauwavex0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*u1(i,3) var_temp = MIN(varss(i),varmax_ss) + & MAX(0.,beta_ss*(varss(i)-varmax_ss)) - tauwavex0=0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar)*u1(i,kvar) + ! Note: This is a semi-implicit treatment of the time differencing + var_temp2 = 0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar) ! this is greater than zero + tauwavex0=-var_temp2*u1(i,kvar)/(1.+var_temp2*deltim) tauwavex0=tauwavex0*ss_taper else tauwavex0=0. @@ -1073,7 +1075,8 @@ subroutine drag_suite_run( & !tauwavey0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*v1(i,3) var_temp = MIN(varss(i),varmax_ss) + & MAX(0.,beta_ss*(varss(i)-varmax_ss)) - tauwavey0=0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar)*v1(i,kvar) + ! Note: This is a semi-implicit treatment of the time differencing + tauwavey0=-var_temp2*v1(i,kvar)/(1.+var_temp2*deltim) tauwavey0=tauwavey0*ss_taper else tauwavey0=0. @@ -1154,10 +1157,12 @@ subroutine drag_suite_run( & DO k=kts,km wsp=SQRT(u1(i,k)**2 + v1(i,k)**2) ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 - utendform(i,k)=-0.0759*wsp*u1(i,k)* & - EXP(-(zl(i,k)/H_efold)**1.5)*a2*zl(i,k)**(-1.2)*ss_taper - vtendform(i,k)=-0.0759*wsp*v1(i,k)* & - EXP(-(zl(i,k)/H_efold)**1.5)*a2*zl(i,k)**(-1.2)*ss_taper + var_temp = 0.0759*EXP(-(zl(i,k)/H_efold)**1.5)*a2* & + zl(i,k)**(-1.2)*ss_taper ! this is greater than zero + ! Note: This is a semi-implicit treatment of the time differencing + ! per Beljaars et al. (2004, QJRMS) + utendform(i,k) = - var_temp*wsp*u1(i,k)/(1. + var_temp*deltim*wsp) + vtendform(i,k) = - var_temp*wsp*v1(i,k)/(1. + var_temp*deltim*wsp) !IF(zl(i,k) > 4000.) exit ENDDO ENDIF From b1d5f4cb820dc41ae7add8c659f65bba3688cd90 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 8 Oct 2019 22:13:43 +0000 Subject: [PATCH 06/84] Added sea_land_ice mask to the parameter list in sfc_drv_ruc. It will be used in the check for consistency of land information. --- physics/sfc_drv_ruc.F90 | 5 +++-- physics/sfc_drv_ruc.meta | 8 ++++++++ 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 61246b67d..a16cfc334 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -143,7 +143,7 @@ subroutine lsm_ruc_run & ! inputs & sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & & prsl1, zf, ddvel, shdmin, shdmax, alvwf, alnwf, & & snoalb, sfalb, flag_iter, flag_guess, isot, ivegsrc, fice, & - & smc, stc, slc, lsm_ruc, lsm, land, & + & smc, stc, slc, lsm_ruc, lsm, land, islimsk, & & imp_physics, imp_physics_gfdl, imp_physics_thompson, & & smcwlt2, smcref2, wspd, do_mynnsfclay, & & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, con_fvirt,& ! constants @@ -184,6 +184,7 @@ subroutine lsm_ruc_run & ! inputs con_hvap, con_fvirt logical, dimension(im), intent(in) :: flag_iter, flag_guess, land + integer, dimension(im), intent(in) :: islimsk ! sea/land/ice mask (=0/1/2) logical, intent(in) :: do_mynnsfclay ! --- in/out: @@ -384,7 +385,7 @@ subroutine lsm_ruc_run & ! inputs !> - Set flag for land and ice points. !- 10may19 - ice points are turned off. flag(i) = land(i) - if (land(i) .and. (vegtype(i)==iswater .or. vegtype(i)==isice)) then + if (land(i) .and. (vegtype(i)==iswater .or. (vegtype(i)==isice.and.islimsk(i)==2))) then !write(errmsg,'(a,i0,a,i0)') 'Logic error in sfc_drv_ruc_run: for i=', i, & ! ', land(i) is true but vegtype(i) is water or ice: ', vegtype(i) !errflg = 1 diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 8d06e4785..8128a03dd 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -278,6 +278,14 @@ type = logical intent = in optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F [rainnc] standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep long_name = explicit rainfall from previous timestep From 325f9b1f721ab712d3687d304edd804e7cca1489 Mon Sep 17 00:00:00 2001 From: climbfuji Date: Wed, 28 Aug 2019 18:39:39 -0600 Subject: [PATCH 07/84] Modifications of CMakeLists.txt to support out-of-source builds, required for parallel cmake builds in NEMSfv3gfs --- CMakeLists.txt | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index bfcceebc6..5000bd62a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -97,9 +97,23 @@ list(APPEND LIBS "ccpp") #------------------------------------------------------------------------------ # Set the sources: physics schemes -include(./CCPP_SCHEMES.cmake) +set(SCHEMES $ENV{CCPP_SCHEMES}) +if(SCHEMES) + message(INFO "Got CCPP_SCHEMES from environment variable: ${SCHEMES}") +else(SCHEMES) + include(./CCPP_SCHEMES.cmake) + message(INFO "Got SCHEMES from cmakefile include file: ${SCHEMES}") +endif(SCHEMES) + # Set the sources: physics scheme caps -include(./CCPP_CAPS.cmake) +set(CAPS $ENV{CCPP_CAPS}) +if(CAPS) + message(INFO "Got CAPS from environment variable: ${CAPS}") +else(CAPS) + include(./CCPP_CAPS.cmake) + message(INFO "Got CAPS from cmakefile include file: ${CAPS}") +endif(CAPS) + # Create empty lists for schemes with special compiler optimization flags set(SCHEMES_SFX_OPT "") # Create empty lists for schemes with special floating point precision flags @@ -334,7 +348,7 @@ if(STATIC) foreach(source_f90 ${CAPS}) string(REGEX REPLACE ".F90" ".mod" tmp_module_f90 ${source_f90}) string(TOLOWER ${tmp_module_f90} module_f90) - list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/../${module_f90}) + list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${module_f90}) endforeach() else(STATIC) add_library(ccppphys SHARED ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) From 7fbe839a6b515ec14b16bd84dbfbf3a3fdbbff3f Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 10 Oct 2019 19:26:03 +0000 Subject: [PATCH 08/84] Bug fix in the unit conversion from [mm] to [m] for liquid rain. --- physics/mp_thompson.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 3b2da9c3e..812229f98 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -395,7 +395,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & graupel = max(0.0, delta_graupel_mp/1000.0_kind_phys) ice = max(0.0, delta_ice_mp/1000.0_kind_phys) snow = max(0.0, delta_snow_mp/1000.0_kind_phys) - rain = max(0.0, delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp)/1000.0_kind_phys) + rain = max(0.0, (delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp))/1000.0_kind_phys) end subroutine mp_thompson_run !>@} From 15de364a567b1604348e876daf474e5a148682f7 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 10 Oct 2019 20:08:11 +0000 Subject: [PATCH 09/84] Use fraction of frozen precipitation SR, computed in GFDL or Thompson microphysics, directly without recomputing it with taking into account temperature-based treatment of convective precipitation. This change will affect only use of RUC LSM with GFDL or Thompson microphysics. --- physics/GFS_MP_generic.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index b83f592f2..91d29c0f3 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -270,7 +270,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt enddo enddo - ! Conversion factor mm per physics timestep to m per day + ! Conversion factor from mm per day to m per physics timestep tem = dtp * con_p001 / con_day !> - For GFDL and Thompson MP scheme, determine convective snow by surface temperature; @@ -280,6 +280,8 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson) then ! 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 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) @@ -300,6 +302,14 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt srflag(i) = (snow0(i)+ice0(i)+graupel0(i)+csnow)/total_precip endif enddo + else + ! only for RUC LSM + do i=1,im + srflag(i) = sr(i) + !if(sr(i) > 0.) print *,'RUC LSM uses SR from MP - srflag(i)',i,srflag(i) + enddo + endif ! lsm==lsm_ruc + elseif( .not. cal_pre) then if (imp_physics == imp_physics_mg) then ! MG microphysics do i=1,im From 57e5c6960295f187ccc573b9fa4a8edaab8e2968 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sun, 13 Oct 2019 14:57:54 +0900 Subject: [PATCH 10/84] physics/cires_ugwp_post.F90: use assumed-size arrays for arrays that may not be allocated --- physics/cires_ugwp_post.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/physics/cires_ugwp_post.F90 b/physics/cires_ugwp_post.F90 index 72f59a6c5..70a7d602d 100755 --- a/physics/cires_ugwp_post.F90 +++ b/physics/cires_ugwp_post.F90 @@ -37,19 +37,19 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & real(kind=kind_phys), intent(in) :: dtf logical, intent(in) :: ldiag_ugwp !< flag for CIRES UGWP Diagnostics - real(kind=kind_phys), intent(in), dimension(im) :: zmtb, zlwb, zogw - real(kind=kind_phys), intent(in), dimension(im) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw - real(kind=kind_phys), intent(inout), dimension(im) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw - real(kind=kind_phys), intent(inout), dimension(im) :: tot_zmtb, tot_zlwb, tot_zogw - real(kind=kind_phys), intent(in), dimension(im, levs) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_ogw, dudt_tms - real(kind=kind_phys), intent(inout), dimension(im, levs) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw - real(kind=kind_phys), intent(inout), dimension(im, levs) :: dtdt, dudt, dvdt + real(kind=kind_phys), intent(in), dimension(:) :: zmtb, zlwb, zogw + real(kind=kind_phys), intent(in), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw + real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw + real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw + real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_ogw, dudt_tms + real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt ! For if (lssav) block, originally in gwdps_post_run logical, intent(in) :: lssav, ldiag3d - real(kind=kind_phys), intent(in), dimension(im) :: dusfcg, dvsfcg - real(kind=kind_phys), intent(inout), dimension(im) :: dugwd, dvgwd - real(kind=kind_phys), intent(inout), dimension(im, levs) :: du3dt, dv3dt, dt3dt + real(kind=kind_phys), intent(in), dimension(:) :: dusfcg, dvsfcg + real(kind=kind_phys), intent(inout), dimension(:) :: dugwd, dvgwd + real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt, dv3dt, dt3dt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg From 81e02a74d87fd1d9674fc08d112b6334d3557d34 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 14 Oct 2019 07:13:27 +0900 Subject: [PATCH 11/84] physics/gwdps.f: remove note that adding intent(in) for certain variables changes the results, this is only true in (CCPP) PROD mode, not in REPRO mode --- physics/gwdps.f | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/physics/gwdps.f b/physics/gwdps.f index d5e34a04a..0ea2c8754 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -299,12 +299,8 @@ subroutine gwdps_run( & ! Interface variables integer, intent(in) :: im, ix, km, imx, kdt, ipr, me integer, intent(in) :: KPBL(IM) ! Index for the PBL top layer! - ! DH* adding intent(in) information for the following variables - ! changes the results on Theia/Intel - skip for bit-for-bit results *DH -! real(kind=kind_phys), intent(in) :: & -! & deltim, G, CP, RD, RV, cdmbgwd(2) - real(kind=kind_phys) deltim, G, CP, RD, RV, cdmbgwd(4) - ! *DH + real(kind=kind_phys), intent(in) :: & + & deltim, G, CP, RD, RV, cdmbgwd(4) real(kind=kind_phys), intent(inout) :: & & A(IX,KM), B(IX,KM), C(IX,KM) real(kind=kind_phys), intent(in) :: & From d139dbbbc12e8e439e8f42e5323378a662efc964 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 18 Oct 2019 09:54:35 +0900 Subject: [PATCH 12/84] physics/sfc_drv_ruc.*: update for GFSv16 --- physics/sfc_drv_ruc.F90 | 24 ++++++++---------------- physics/sfc_drv_ruc.meta | 37 +++++-------------------------------- 2 files changed, 13 insertions(+), 48 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index a16cfc334..fe12b5e17 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -69,7 +69,6 @@ end subroutine lsm_ruc_finalize ! im - integer, horiz dimention and num of used pts 1 ! ! km - integer, vertical soil layer dimension 9 ! ! ps - real, surface pressure (pa) im ! -! u1, v1 - real, u/v component of surface layer wind im ! ! t1 - real, surface layer mean temperature (k) im ! ! q1 - real, surface layer mean specific humidity im ! ! soiltyp - integer, soil type (integer index) im ! @@ -86,6 +85,7 @@ end subroutine lsm_ruc_finalize ! prsl1 - real, sfc layer 1 mean pressure (pa) im ! ! prslki - real, dimensionless exner function at layer 1 im ! ! zf - real, height of bottom layer (m) im ! +! wind real, surface layer wind speed (m/s) im ! ! slopetyp - integer, class of sfc slope (integer index) im ! ! shdmin - real, min fractional coverage of green veg im ! ! shdmax - real, max fractnl cover of green veg (not used) im ! @@ -139,13 +139,13 @@ end subroutine lsm_ruc_finalize ! DH* TODO - make order of arguments the same as in the metadata table subroutine lsm_ruc_run & ! inputs & ( iter, me, master, kdt, im, nlev, lsoil_ruc, lsoil, zs, & - & u1, v1, t1, q1, qc, soiltyp, vegtype, sigmaf, & + & t1, q1, qc, soiltyp, vegtype, sigmaf, & & sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & - & prsl1, zf, ddvel, shdmin, shdmax, alvwf, alnwf, & + & prsl1, zf, wind, shdmin, shdmax, alvwf, alnwf, & & snoalb, sfalb, flag_iter, flag_guess, isot, ivegsrc, fice, & & smc, stc, slc, lsm_ruc, lsm, land, islimsk, & & imp_physics, imp_physics_gfdl, imp_physics_thompson, & - & smcwlt2, smcref2, wspd, do_mynnsfclay, & + & smcwlt2, smcref2, do_mynnsfclay, & & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, con_fvirt,& ! constants & weasd, snwdph, tskin, tskin_ocn, & ! in/outs & rainnc, rainc, ice, snow, graupel, & ! in @@ -173,10 +173,10 @@ subroutine lsm_ruc_run & ! inputs real (kind=kind_phys), dimension(im,lsoil), intent(inout) :: smc,stc,slc - real (kind=kind_phys), dimension(im), intent(in) :: u1, v1,& + real (kind=kind_phys), dimension(im), intent(in) :: & & t1, sigmaf, sfcemis, dlwflx, dswsfc, snet, tg3, cm, & - & ch, prsl1, ddvel, shdmin, shdmax, & - & snoalb, alvwf, alnwf, zf, qc, q1, wspd + & ch, prsl1, wind, shdmin, shdmax, & + & snoalb, alvwf, alnwf, zf, qc, q1 real (kind=kind_phys), intent(in) :: delt real (kind=kind_phys), intent(in) :: con_cp, con_rv, con_g, & @@ -216,7 +216,7 @@ subroutine lsm_ruc_run & ! inputs ! --- locals: real (kind=kind_phys), dimension(im) :: rch, rho, & - & q0, qs1, wind, weasd_old, snwdph_old, & + & q0, qs1, weasd_old, snwdph_old, & & tprcp_old, srflag_old, tskin_old, canopy_old, & & tsnow_old, snowfallac_old, acsnow_old, sfalb_old, & & sfcqv_old, sfcqc_old, wetness_old, zorl_old, sncovr1_old @@ -472,15 +472,7 @@ subroutine lsm_ruc_run & ! inputs do i = 1, im if (flag_iter(i) .and. flag(i)) then - !if (do_mynnsfclay) then - ! WARNING - used of wspd computed in MYNN sfc leads to massive cooling. - ! wind(i) = wspd(i) - !else - wind(i) = max(sqrt( u1(i)*u1(i) + v1(i)*v1(i) ) & - + max(0.0, min(ddvel(i), 30.0)), 1.0) - !endif q0(i) = max(q1(i)/(1.-q1(i)), 1.e-8) !* q1=specific humidity at level 1 (kg/kg) - rho(i) = prsl1(i) / (con_rd*t1(i)*(1.0+con_fvirt*q0(i))) qs1(i) = rslf(prsl1(i),t1(i)) !* qs1=sat. mixing ratio at level 1 (kg/kg) q0 (i) = min(qs1(i), q0(i)) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 8128a03dd..dac459405 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -385,24 +385,6 @@ kind = kind_phys intent = in optional = F -[u1] - standard_name = x_wind_at_lowest_model_layer - long_name = zonal wind at lowest model layer - units = m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[v1] - standard_name = y_wind_at_lowest_model_layer - long_name = meridional wind at lowest model layer - units = m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [prsl1] standard_name = air_pressure_at_lowest_model_layer long_name = mean pressure at lowest model layer @@ -412,9 +394,9 @@ kind = kind_phys intent = in optional = F -[ddvel] - standard_name = surface_wind_enhancement_due_to_convection - long_name = surface wind enhancement due to convection +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level units = m s-1 dimensions = (horizontal_dimension) type = real @@ -476,23 +458,14 @@ intent = in optional = F [sfcemis] - standard_name = surface_longwave_emissivity - long_name = surface lw emissivity in fraction + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[wspd] - standard_name = wind_speed_at_lowest_model_layer - long_name = wind speed at lowest model level - units = m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [cm] standard_name = surface_drag_coefficient_for_momentum_in_air_over_land long_name = surface exchange coeff for momentum over land From 596c435586cd58ea8a058538098127b2ccc10e83 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 21 Oct 2019 10:47:53 +0000 Subject: [PATCH 13/84] 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 14/84] 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 3bb41d618ac5fca641a6b93150626e4a4c2c7372 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 22 Oct 2019 06:29:34 +0900 Subject: [PATCH 15/84] Add / prefix to all source files --- CMakeLists.txt | 132 +++++++++++++++++++++++++++++++------------------ 1 file changed, 85 insertions(+), 47 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5000bd62a..531230328 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -123,12 +123,25 @@ set(SCHEMES2 ${SCHEMES}) #------------------------------------------------------------------------------ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -fdefault-real-8) - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -ffree-form") - SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fno-range-check") - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-ffree-line-length-none -fdefault-real-8 -ffree-form") - SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F ./physics/surface_perturbation.F90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_mp_thompson_make_number_concentrations.F90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + PROPERTIES COMPILE_FLAGS -fdefault-real-8) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -ffree-form") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fno-range-check") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + PROPERTIES COMPILE_FLAGS "-ffree-line-length-none -fdefault-real-8 -ffree-form") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") if (PROJECT STREQUAL "CCPP-FV3") # Set 32-bit floating point precision flags for certain files @@ -140,10 +153,10 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") string(REPLACE "-fdefault-double-8" "" CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") - SET_PROPERTY(SOURCE ./physics/gfdl_fv_sat_adj.F90 + SET_PROPERTY(SOURCE ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") # Add all of the above files to the list of schemes with special floating point precision flags - list(APPEND SCHEMES_SFX_PREC ./physics/gfdl_fv_sat_adj.F90) + list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) endif (DYN32) # Remove files with special floating point precision flags from list @@ -159,28 +172,28 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") # Adjust settings for bit-for-bit reproducibility of NEMSfv3gfs if (PROJECT STREQUAL "CCPP-FV3") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f - ./physics/sflx.f - ./physics/sfc_diff.f - ./physics/sfc_diag.f - ./physics/module_nst_model.f90 - ./physics/calpreciptype.f90 - ./physics/mersenne_twister.f - ./physics/module_nst_water_prop.f90 - ./physics/aer_cloud.F - ./physics/wv_saturation.F - ./physics/cldwat2m_micro.F - ./physics/surface_perturbation.F90 - ./physics/radiation_aerosols.f - ./physics/cu_gf_deep.F90 - ./physics/cu_gf_sh.F90 - ./physics/module_bl_mynn.F90 - ./physics/module_MYNNPBL_wrapper.F90 - ./physics/module_sf_mynn.F90 - ./physics/module_MYNNSFC_wrapper.F90 - ./physics/module_MYNNrad_pre.F90 - ./physics/module_MYNNrad_post.F90 - ./physics/module_mp_thompson_make_number_concentrations.F90 + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cu_gf_deep.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cu_gf_sh.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bl_mynn.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNPBL_wrapper.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNSFC_wrapper.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNrad_pre.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNrad_post.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 PROPERTIES COMPILE_FLAGS "-r8 -ftz") # Replace -xHost or -xCORE-AVX2 with -xCORE-AVX-I for certain files @@ -194,10 +207,10 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") string(REPLACE "-axSSE4.2,AVX,CORE-AVX2,CORE-AVX512" "-axSSE4.2,AVX,CORE-AVX-I" CMAKE_Fortran_FLAGS_LOPT1 "${CMAKE_Fortran_FLAGS_LOPT1}") - SET_SOURCE_FILES_PROPERTIES(./physics/radiation_aerosols.f + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_LOPT1}") # Add all of the above files to the list of schemes with special compiler flags - list(APPEND SCHEMES_SFX_OPT ./physics/radiation_aerosols.f) + list(APPEND SCHEMES_SFX_OPT ${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f) # Force consistent results of math calculations for MG microphysics; # in Debug/Bitforbit mode; without this flag, the results of the @@ -258,10 +271,10 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") set(CMAKE_Fortran_FLAGS_PREC32 ${CMAKE_Fortran_FLAGS_DEFAULT_PREC}) string(REPLACE "-real-size 64" "-real-size 32" CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") - SET_PROPERTY(SOURCE ./physics/gfdl_fv_sat_adj.F90 + SET_PROPERTY(SOURCE ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") # Add all of the above files to the list of schemes with special floating point precision flags - list(APPEND SCHEMES_SFX_PREC ./physics/gfdl_fv_sat_adj.F90) + list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) endif (DYN32) # Remove files with special floating point precision flags from list @@ -274,19 +287,44 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_DEFAULT_PREC} ") else (PROJECT STREQUAL "CCPP-FV3") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -r8) - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-r8 -free") - SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-r8 -ftz") - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-extend-source 132 -r8 -free") - SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F ./physics/surface_perturbation.F90 PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + PROPERTIES COMPILE_FLAGS -r8) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + PROPERTIES COMPILE_FLAGS "-r8 -free") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + PROPERTIES COMPILE_FLAGS "-r8 -ftz") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + PROPERTIES COMPILE_FLAGS "-extend-source 132 -r8 -free") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + PROPERTIES COMPILE_FLAGS "-r8") endif (PROJECT STREQUAL "CCPP-FV3") elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -r8) - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-r8 -Mfree") - SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-r8 -Mnofptrap") - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-r8 -Mfree") - SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F ./physics/surface_perturbation.F90 PROPERTIES COMPILE_FLAGS "-r8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_mp_thompson_make_number_concentrations.F90 PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + PROPERTIES COMPILE_FLAGS -r8) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + PROPERTIES COMPILE_FLAGS "-r8 -Mfree") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + PROPERTIES COMPILE_FLAGS "-r8 -Mnofptrap") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + PROPERTIES COMPILE_FLAGS "-r8 -Mfree") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + PROPERTIES COMPILE_FLAGS "-r8") if (PROJECT STREQUAL "CCPP-FV3") # Set 32-bit floating point precision flags for certain files # that are executed in the dynamics (fast physics part) @@ -295,10 +333,10 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") set(CMAKE_Fortran_FLAGS_PREC32 ${CMAKE_Fortran_FLAGS_DEFAULT_PREC}) string(REPLACE "-r8" "-r4" CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") - SET_PROPERTY(SOURCE ./physics/gfdl_fv_sat_adj.F90 + SET_PROPERTY(SOURCE ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") # Add all of the above files to the list of schemes with special floating point precision flags - list(APPEND SCHEMES_SFX_PREC ./physics/gfdl_fv_sat_adj.F90) + list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) endif (DYN32) # Remove files with special floating point precision flags from list From 2b42c9eaaa71206ce68d088066a507c085c10052 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 22 Oct 2019 00:45:16 +0000 Subject: [PATCH 16/84] 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 e1a33ba926460d35e0a68230bffe9c13c42cbbe5 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 22 Oct 2019 18:54:54 +0900 Subject: [PATCH 17/84] CMakeLists.txt: extract filename from full path for auto-generated caps for creatig list of Fortran module files to install (static build only) --- CMakeLists.txt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index ff8a7012d..b8d3c3e18 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -350,7 +350,8 @@ if(STATIC) add_library(ccppphys STATIC ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) # Generate list of Fortran modules from defined sources foreach(source_f90 ${CAPS}) - string(REGEX REPLACE ".F90" ".mod" tmp_module_f90 ${source_f90}) + get_filename_component(tmp_source_f90 ${source_f90} NAME) + string(REGEX REPLACE ".F90" ".mod" tmp_module_f90 ${tmp_source_f90}) string(TOLOWER ${tmp_module_f90} module_f90) list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${module_f90}) endforeach() From 26b2c577195cf6f9f678013695ad93e507c89b80 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 22 Oct 2019 09:45:11 -0600 Subject: [PATCH 18/84] reorganize GWD interstitial schemes; create GFS_GWD_generic_post that gets used for all GWD schemes; remove drag_suite_pre,post; move some functionality from cires_ugwp_post to GFS_GWD_generic_post --- physics/GFS_GWD_generic.F90 | 64 +++++++- physics/GFS_GWD_generic.meta | 137 +++++++++++++++++ physics/cires_ugwp_post.F90 | 22 +-- physics/cires_ugwp_post.meta | 79 ---------- physics/drag_suite.F90 | 156 -------------------- physics/drag_suite.meta | 276 ----------------------------------- physics/gwdps.f | 56 ------- physics/gwdps.meta | 147 ------------------- 8 files changed, 196 insertions(+), 741 deletions(-) diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 60ae1deec..0915dd170 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -6,8 +6,6 @@ module GFS_GWD_generic_pre contains -!> \section arg_table_GFS_GWD_generic_pre_init Argument Table -!! subroutine GFS_GWD_generic_pre_init() end subroutine GFS_GWD_generic_pre_init @@ -105,12 +103,64 @@ subroutine GFS_GWD_generic_pre_run( & end subroutine GFS_GWD_generic_pre_run !> @} -! \ingroup GFS_ogwd -! \brief Brief description of the subroutine -! -!> \section arg_table_GFS_GWD_generic_pre_finalize Argument Table -!! subroutine GFS_GWD_generic_pre_finalize() end subroutine GFS_GWD_generic_pre_finalize end module GFS_GWD_generic_pre + +!> This module contains the CCPP-compliant orographic gravity wave drag post +!! interstitial codes. +module GFS_GWD_generic_post + +contains + + + subroutine GFS_GWD_generic_post_init() + end subroutine GFS_GWD_generic_post_init + +!! \section arg_table_GFS_GWD_generic_post_run Argument Table +!! \htmlinclude GFS_GWD_generic_post_run.html +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, dvdt, dtdt, & + & dugwd, dvgwd, du3dt, dv3dt, dt3dt, errmsg, errflg) + + use machine, only : kind_phys + implicit none + + logical, intent(in) :: lssav, ldiag3d + + real(kind=kind_phys), intent(in) :: dusfcg(:), dvsfcg(:) + real(kind=kind_phys), intent(in) :: dudt(:,:), dvdt(:,:), dtdt(:,:) + real(kind=kind_phys), intent(in) :: dtf + + real(kind=kind_phys), intent(inout) :: dugwd(:), dvgwd(:) + real(kind=kind_phys), intent(inout) :: du3dt(:,:), dv3dt(:,:), dt3dt(:,:) + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lssav) then + dugwd(:) = dugwd(:) + dusfcg(:)*dtf + dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf + + if (ldiag3d) then + du3dt(:,:) = du3dt(:,:) + dudt(:,:) * dtf + dv3dt(:,:) = dv3dt(:,:) + dvdt(:,:) * dtf + dt3dt(:,:) = dt3dt(:,:) + dtdt(:,:) * dtf + endif + endif + + end subroutine GFS_GWD_generic_post_run +!> @} + + subroutine GFS_GWD_generic_post_finalize() + end subroutine GFS_GWD_generic_post_finalize + +end module GFS_GWD_generic_post diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index e3d14c268..94a4abab1 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -167,3 +167,140 @@ [ccpp-arg-table] name = GFS_GWD_generic_pre_finalize type = scheme + +######################################################################## +[ccpp-arg-table] + name = GFS_GWD_generic_post_run + type = scheme +[lssav] + standard_name = flag_diagnostics + long_name = flag for calculating diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for calculating 3-D diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dusfcg] + standard_name = instantaneous_x_stress_due_to_gravity_wave_drag + long_name = zonal surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvsfcg] + standard_name = instantaneous_y_stress_due_to_gravity_wave_drag + long_name = meridional surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dugwd] + standard_name = time_integral_of_x_stress_due_to_gravity_wave_drag + long_name = integral over time of zonal stress due to gravity wave drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvgwd] + standard_name = time_integral_of_y_stress_due_to_gravity_wave_drag + long_name = integral over time of meridional stress due to gravity wave drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt] + standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in zonal wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt] + standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in meridional wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dt3dt] + standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag + long_name = cumulative change in temperature due to orographic gravity wave drag + units = K + dimensions = (horizontal_dimension,vertical_dimension) + 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/cires_ugwp_post.F90 b/physics/cires_ugwp_post.F90 index 70a7d602d..2fe6ca04d 100755 --- a/physics/cires_ugwp_post.F90 +++ b/physics/cires_ugwp_post.F90 @@ -25,8 +25,8 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & tot_zmtb, tot_zlwb, tot_zogw, & tot_tofd, tot_mtb, tot_ogw, tot_ngw, & du3dt_mtb,du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw, & - dtdt, dudt, dvdt, lssav, ldiag3d, dusfcg, dvsfcg, dugwd, & - dvgwd, du3dt, dv3dt, dt3dt, errmsg, errflg) + dtdt, dudt, dvdt, & + errmsg, errflg) use machine, only: kind_phys @@ -45,12 +45,6 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt - ! For if (lssav) block, originally in gwdps_post_run - logical, intent(in) :: lssav, ldiag3d - real(kind=kind_phys), intent(in), dimension(:) :: dusfcg, dvsfcg - real(kind=kind_phys), intent(inout), dimension(:) :: dugwd, dvgwd - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt, dv3dt, dt3dt - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -79,18 +73,6 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & dudt = dudt + gw_dudt dvdt = dvdt + gw_dvdt - ! Originally in gwdps_post_run - if (lssav) then - dugwd(:) = dugwd(:) + dusfcg(:)*dtf - dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf - - if (ldiag3d) then - du3dt(:,:) = du3dt(:,:) + dudt(:,:) * dtf - dv3dt(:,:) = dv3dt(:,:) + dvdt(:,:) * dtf - dt3dt(:,:) = dt3dt(:,:) + dtdt(:,:) * dtf - endif - endif - end subroutine cires_ugwp_post_run !> \section arg_table_cires_ugwp_post_finalize Argument Table diff --git a/physics/cires_ugwp_post.meta b/physics/cires_ugwp_post.meta index 980e99a65..1f98aa8a4 100644 --- a/physics/cires_ugwp_post.meta +++ b/physics/cires_ugwp_post.meta @@ -291,85 +291,6 @@ kind = kind_phys intent = inout optional = F -[lssav] - standard_name = flag_diagnostics - long_name = flag for calculating diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ldiag3d] - standard_name = flag_diagnostics_3D - long_name = flag for calculating 3-D diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F -[dusfcg] - standard_name = instantaneous_x_stress_due_to_gravity_wave_drag - long_name = zonal surface stress due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dvsfcg] - standard_name = instantaneous_y_stress_due_to_gravity_wave_drag - long_name = meridional surface stress due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dugwd] - standard_name = time_integral_of_x_stress_due_to_gravity_wave_drag - long_name = integral over time of zonal stress due to gravity wave drag - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dvgwd] - standard_name = time_integral_of_y_stress_due_to_gravity_wave_drag - long_name = integral over time of meridional stress due to gravity wave drag - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[du3dt] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in zonal wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in meridional wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag - long_name = cumulative change in temperature due to orographic gravity wave drag - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index eb371adb1..c3da28334 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -2,106 +2,6 @@ !! This file is the parameterization of orographic gravity wave !! drag, mountain blocking, and form drag. -!> This module contains the CCPP-compliant orographic gravity wave -!! drag pre interstitial codes. - module drag_suite_pre - - contains - -!> \section arg_table_drag_suite_pre_init Argument Table -!! - subroutine drag_suite_pre_init() - end subroutine drag_suite_pre_init - -!> \section arg_table_drag_suite_pre_run Argument Table -!! \htmlinclude drag_suite_pre_run.html -!! -!! \section general General Algorithm -!! \section detailed Detailed Algorithm -!! @{ - subroutine drag_suite_pre_run( & - & im, nmtvr, mntvar, & - & hprime, oc, oa4, clx, theta, & - & sigma, gamma, elvmax, errmsg, errflg) - - use machine, only : kind_phys - implicit none - - integer, intent(in) :: im, nmtvr - real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr) - - real(kind=kind_phys), intent(out) :: & - & hprime(im), oc(im), oa4(im,4), clx(im,4), & - & theta(im), sigma(im), gamma(im), elvmax(im) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (nmtvr == 14) then ! current operational - as of 2014 - hprime(:) = mntvar(:,1) - oc(:) = mntvar(:,2) - oa4(:,1) = mntvar(:,3) - oa4(:,2) = mntvar(:,4) - oa4(:,3) = mntvar(:,5) - oa4(:,4) = mntvar(:,6) - clx(:,1) = mntvar(:,7) - clx(:,2) = mntvar(:,8) - clx(:,3) = mntvar(:,9) - clx(:,4) = mntvar(:,10) - theta(:) = mntvar(:,11) - gamma(:) = mntvar(:,12) - sigma(:) = mntvar(:,13) - elvmax(:) = mntvar(:,14) - elseif (nmtvr == 10) then - hprime(:) = mntvar(:,1) - oc(:) = mntvar(:,2) - oa4(:,1) = mntvar(:,3) - oa4(:,2) = mntvar(:,4) - oa4(:,3) = mntvar(:,5) - oa4(:,4) = mntvar(:,6) - clx(:,1) = mntvar(:,7) - clx(:,2) = mntvar(:,8) - clx(:,3) = mntvar(:,9) - clx(:,4) = mntvar(:,10) - elseif (nmtvr == 6) then - hprime(:) = mntvar(:,1) - oc(:) = mntvar(:,2) - oa4(:,1) = mntvar(:,3) - oa4(:,2) = mntvar(:,4) - oa4(:,3) = mntvar(:,5) - oa4(:,4) = mntvar(:,6) - clx(:,1) = 0.0 - clx(:,2) = 0.0 - clx(:,3) = 0.0 - clx(:,4) = 0.0 - else - hprime = 0 - oc = 0 - oa4 = 0 - clx = 0 - theta = 0 - gamma = 0 - sigma = 0 - elvmax = 0 - endif ! end if_nmtvr - - end subroutine drag_suite_pre_run -!> @} - -! \ingroup GFS_ogwd -! \brief Brief description of the subroutine -! -!> \section arg_table_drag_suite_pre_finalize Argument Table -!! - subroutine drag_suite_pre_finalize() - end subroutine drag_suite_pre_finalize - - end module drag_suite_pre - !> This module contains the CCPP-compliant orographic gravity wave dray scheme. module drag_suite @@ -1415,59 +1315,3 @@ subroutine drag_suite_finalize() end subroutine drag_suite_finalize end module drag_suite - -!> This module contains the CCPP-compliant orographic gravity wave drag post -!! interstitial codes. - module drag_suite_post - - contains - -!> \section arg_table_drag_suite_post_init Argument Table -!! - subroutine drag_suite_post_init() - end subroutine drag_suite_post_init - -!> \section arg_table_drag_suite_post_run Argument Table -!! \htmlinclude drag_suite_post_run.html -!! - subroutine drag_suite_post_run( & - & lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, dvdt, dtdt, & - & dugwd, dvgwd, du3dt, dv3dt, dt3dt, errmsg, errflg) - - use machine, only : kind_phys - implicit none - - logical, intent(in) :: lssav, ldiag3d - real(kind=kind_phys), intent(in) :: dtf - real(kind=kind_phys), intent(in) :: & - & dusfcg(:), dvsfcg(:), dudt(:,:), dvdt(:,:), dtdt(:,:) - - real(kind=kind_phys), intent(inout) :: & - & dugwd(:), dvgwd(:), du3dt(:,:), dv3dt(:,:), dt3dt(:,:) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (lssav) then - dugwd(:) = dugwd(:) + dusfcg(:)*dtf - dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf - - if (ldiag3d) then - du3dt(:,:) = du3dt(:,:) + dudt(:,:) * dtf - dv3dt(:,:) = dv3dt(:,:) + dvdt(:,:) * dtf - dt3dt(:,:) = dt3dt(:,:) + dtdt(:,:) * dtf - endif - endif - - end subroutine drag_suite_post_run - -!> \section arg_table_drag_suite_post_finalize Argument Table -!! - subroutine drag_suite_post_finalize() - end subroutine drag_suite_post_finalize - - end module drag_suite_post diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index ab84e937f..dfb6f64b8 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -1,132 +1,3 @@ -[ccpp-arg-table] - name = drag_suite_pre_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = drag_suite_pre_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[nmtvr] - standard_name = number_of_statistical_measures_of_subgrid_orography - long_name = number of statistical measures of subgrid orography - units = count - dimensions = () - type = integer - intent = in - optional = F -[mntvar] - standard_name = statistical_measures_of_subgrid_orography - long_name = array of statistical measures of subgrid orography - units = various - dimensions = (horizontal_dimension,number_of_statistical_measures_of_subgrid_orography) - type = real - kind = kind_phys - intent = in - optional = F -[hprime] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[oc] - standard_name = convexity_of_subgrid_orography - long_name = convexity of subgrid orography - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[oa4] - standard_name = asymmetry_of_subgrid_orography - long_name = asymmetry of subgrid orography - units = none - dimensions = (horizontal_dimension,4) - type = real - kind = kind_phys - intent = out - optional = F -[clx] - standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height - long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height - units = frac - dimensions = (horizontal_dimension,4) - type = real - kind = kind_phys - intent = out - optional = F -[theta] - standard_name = angle_from_east_of_maximum_subgrid_orographic_variations - long_name = angle with_respect to east of maximum subgrid orographic variations - units = degrees - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[sigma] - standard_name = slope_of_subgrid_orography - long_name = slope of subgrid orography - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[gamma] - standard_name = anisotropy_of_subgrid_orography - long_name = anisotropy of subgrid orography - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[elvmax] - standard_name = maximum_subgrid_orography - long_name = maximum of subgrid orography - units = m - 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 - 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 = drag_suite_pre_finalize - type = scheme - -######################################################################## [ccpp-arg-table] name = drag_suite_init type = scheme @@ -713,150 +584,3 @@ [ccpp-arg-table] name = drag_suite_finalize type = scheme - -######################################################################## -[ccpp-arg-table] - name = drag_suite_post_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = drag_suite_post_run - type = scheme -[lssav] - standard_name = flag_diagnostics - long_name = flag for calculating diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ldiag3d] - standard_name = flag_diagnostics_3D - long_name = flag for calculating 3-D diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F -[dtf] - standard_name = time_step_for_dynamics - long_name = dynamics time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[dusfcg] - standard_name = instantaneous_x_stress_due_to_gravity_wave_drag - long_name = zonal surface stress due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dvsfcg] - standard_name = instantaneous_y_stress_due_to_gravity_wave_drag - long_name = meridional surface stress due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dudt] - standard_name = tendency_of_x_wind_due_to_model_physics - long_name = zonal wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dvdt] - standard_name = tendency_of_y_wind_due_to_model_physics - long_name = meridional wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dtdt] - standard_name = tendency_of_air_temperature_due_to_model_physics - long_name = air temperature tendency due to model physics - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dugwd] - standard_name = time_integral_of_x_stress_due_to_gravity_wave_drag - long_name = integral over time of zonal stress due to gravity wave drag - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dvgwd] - standard_name = time_integral_of_y_stress_due_to_gravity_wave_drag - long_name = integral over time of meridional stress due to gravity wave drag - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[du3dt] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in zonal wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in meridional wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag - long_name = cumulative change in temperature due to orographic gravity wave drag - units = K - dimensions = (horizontal_dimension,vertical_dimension) - 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 - -######################################################################## -[ccpp-arg-table] - name = drag_suite_post_finalize - type = scheme diff --git a/physics/gwdps.f b/physics/gwdps.f index 0ea2c8754..9454b967d 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -1316,59 +1316,3 @@ subroutine gwdps_finalize() end subroutine gwdps_finalize end module gwdps - -!> This module contains the CCPP-compliant orographic gravity wave drag post -!! interstitial codes. - module gwdps_post - - contains - -!! \section arg_table_gwdps_post_init Argument Table -!! - subroutine gwdps_post_init() - end subroutine gwdps_post_init - -!! \section arg_table_gwdps_post_run Argument Table -!! \htmlinclude gwdps_post_run.html -!! - subroutine gwdps_post_run( & - & lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, dvdt, dtdt, & - & dugwd, dvgwd, du3dt, dv3dt, dt3dt, errmsg, errflg) - - use machine, only : kind_phys - implicit none - - logical, intent(in) :: lssav, ldiag3d - real(kind=kind_phys), intent(in) :: dtf - real(kind=kind_phys), intent(in) :: & - & dusfcg(:), dvsfcg(:), dudt(:,:), dvdt(:,:), dtdt(:,:) - - real(kind=kind_phys), intent(inout) :: & - & dugwd(:), dvgwd(:), du3dt(:,:), dv3dt(:,:), dt3dt(:,:) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (lssav) then - dugwd(:) = dugwd(:) + dusfcg(:)*dtf - dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf - - if (ldiag3d) then - du3dt(:,:) = du3dt(:,:) + dudt(:,:) * dtf - dv3dt(:,:) = dv3dt(:,:) + dvdt(:,:) * dtf - dt3dt(:,:) = dt3dt(:,:) + dtdt(:,:) * dtf - endif - endif - - end subroutine gwdps_post_run - -!> \section arg_table_gwdps_post_finalize Argument Table -!! - subroutine gwdps_post_finalize() - end subroutine gwdps_post_finalize - - end module gwdps_post diff --git a/physics/gwdps.meta b/physics/gwdps.meta index 0a141b208..677dc6502 100644 --- a/physics/gwdps.meta +++ b/physics/gwdps.meta @@ -378,150 +378,3 @@ [ccpp-arg-table] name = gwdps_finalize type = scheme - -######################################################################## -[ccpp-arg-table] - name = gwdps_post_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = gwdps_post_run - type = scheme -[lssav] - standard_name = flag_diagnostics - long_name = flag for calculating diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ldiag3d] - standard_name = flag_diagnostics_3D - long_name = flag for calculating 3-D diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F -[dtf] - standard_name = time_step_for_dynamics - long_name = dynamics time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[dusfcg] - standard_name = instantaneous_x_stress_due_to_gravity_wave_drag - long_name = zonal surface stress due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dvsfcg] - standard_name = instantaneous_y_stress_due_to_gravity_wave_drag - long_name = meridional surface stress due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dudt] - standard_name = tendency_of_x_wind_due_to_model_physics - long_name = zonal wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dvdt] - standard_name = tendency_of_y_wind_due_to_model_physics - long_name = meridional wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dtdt] - standard_name = tendency_of_air_temperature_due_to_model_physics - long_name = air temperature tendency due to model physics - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dugwd] - standard_name = time_integral_of_x_stress_due_to_gravity_wave_drag - long_name = integral over time of zonal stress due to gravity wave drag - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dvgwd] - standard_name = time_integral_of_y_stress_due_to_gravity_wave_drag - long_name = integral over time of meridional stress due to gravity wave drag - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[du3dt] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in zonal wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in meridional wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag - long_name = cumulative change in temperature due to orographic gravity wave drag - units = K - dimensions = (horizontal_dimension,vertical_dimension) - 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 - -######################################################################## -[ccpp-arg-table] - name = gwdps_post_finalize - type = scheme From 0eed00356e62a1caa45153610cce9b5632412bb7 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 23 Oct 2019 12:13:15 -0600 Subject: [PATCH 19/84] use the namelist filename passed in to cires_ugwp_module.F90 rather than hard-coded input.nml --- physics/cires_ugwp_module.F90 | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/physics/cires_ugwp_module.F90 b/physics/cires_ugwp_module.F90 index 7a675c3cc..f47faf7fa 100644 --- a/physics/cires_ugwp_module.F90 +++ b/physics/cires_ugwp_module.F90 @@ -106,12 +106,10 @@ module cires_ugwp_module ! init of cires_ugwp (_init) called from GFS_driver.F90 ! ! ----------------------------------------------------------------------- - subroutine cires_ugwp_mod_init (me, master, nlunit, logunit, fn_nml2, & + subroutine cires_ugwp_mod_init (me, master, nlunit, logunit, fn_nml, & lonr, latr, levs, ak, bk, pref, dtp, cdmvgwd, cgwf, & pa_rf_in, tau_rf_in) -! -! input_nml_file ='input.nml'=fn_nml -! + use ugwp_oro_init, only : init_oro_gws use ugwp_conv_init, only : init_conv_gws use ugwp_fjet_init, only : init_fjet_gws @@ -132,10 +130,8 @@ subroutine cires_ugwp_mod_init (me, master, nlunit, logunit, fn_nml2, & real, intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes real, intent (in) :: pa_rf_in, tau_rf_in - character(len=64), intent (in) :: fn_nml2 - character(len=64), parameter :: fn_nml='input.nml' + character(len=64), intent (in) :: fn_nml -! character, intent (in) :: input_nml_file ! integer, parameter :: logunit = 6 integer :: ios logical :: exists From 42997f3a0fe1edfcc63a972701471d4bd9243f48 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 23 Oct 2019 18:22:25 +0000 Subject: [PATCH 20/84] 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 c1f1a671c42d67a52a8d1a570f60bbec38398282 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 24 Oct 2019 13:50:53 -0600 Subject: [PATCH 21/84] add option for INTERNAL_FILE_NML preprocessor directive --- physics/cires_ugwp.F90 | 9 ++++---- physics/cires_ugwp.meta | 9 ++++++++ physics/cires_ugwp_module.F90 | 42 +++++++++++++++++++++-------------- 3 files changed, 39 insertions(+), 21 deletions(-) diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 99767e9b0..c15697e68 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -37,8 +37,8 @@ module cires_ugwp !! ! ----------------------------------------------------------------------- ! - subroutine cires_ugwp_init (me, master, nlunit, logunit, fn_nml2, & - lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & + subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & + fn_nml2, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & pa_rf_in, tau_rf_in, con_p0, do_ugwp, errmsg, errflg) !---- initialization of cires_ugwp @@ -47,6 +47,7 @@ subroutine cires_ugwp_init (me, master, nlunit, logunit, fn_nml2, & integer, intent (in) :: me integer, intent (in) :: master integer, intent (in) :: nlunit + character(len=*), intent (in) :: input_nml_file(:) integer, intent (in) :: logunit integer, intent (in) :: lonr integer, intent (in) :: levs @@ -76,8 +77,8 @@ subroutine cires_ugwp_init (me, master, nlunit, logunit, fn_nml2, & if (is_initialized) return if (do_ugwp .or. cdmbgwd(3) > 0.0) then - call cires_ugwp_mod_init (me, master, nlunit, logunit, fn_nml2, & - lonr, latr, levs, ak, bk, con_p0, dtp, & + call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & + fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) else write(errmsg,'(*(a))') "Logic error: cires_ugwp_init called but do_ugwp is false and cdmbgwd(3) <= 0" diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 1544035a9..7f1118016 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -25,6 +25,15 @@ type = integer intent = in optional = F +[input_nml_file] + standard_name = namelist_filename_for_internal_file_reads + long_name = character string to store full namelist contents + units = none + dimensions = (number_of_lines_of_namelist_filename_for_internal_file_reads) + type = character + kind = len=* + intent = in + optional = F [logunit] standard_name = iounit_log long_name = fortran unit number for writing logfile diff --git a/physics/cires_ugwp_module.F90 b/physics/cires_ugwp_module.F90 index f47faf7fa..51c297237 100644 --- a/physics/cires_ugwp_module.F90 +++ b/physics/cires_ugwp_module.F90 @@ -106,8 +106,8 @@ module cires_ugwp_module ! init of cires_ugwp (_init) called from GFS_driver.F90 ! ! ----------------------------------------------------------------------- - subroutine cires_ugwp_mod_init (me, master, nlunit, logunit, fn_nml, & - lonr, latr, levs, ak, bk, pref, dtp, cdmvgwd, cgwf, & + subroutine cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & + fn_nml, lonr, latr, levs, ak, bk, pref, dtp, cdmvgwd, cgwf, & pa_rf_in, tau_rf_in) use ugwp_oro_init, only : init_oro_gws @@ -118,29 +118,33 @@ subroutine cires_ugwp_mod_init (me, master, nlunit, logunit, fn_nml, & use ugwp_lsatdis_init, only : initsolv_lsatdis implicit none - integer, intent (in) :: me - integer, intent (in) :: master - integer, intent (in) :: nlunit - integer, intent (in) :: logunit - integer, intent (in) :: lonr - integer, intent (in) :: levs - integer, intent (in) :: latr - real, intent (in) :: ak(levs+1), bk(levs+1), pref - real, intent (in) :: dtp - real, intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes - real, intent (in) :: pa_rf_in, tau_rf_in - - character(len=64), intent (in) :: fn_nml + integer, intent (in) :: me + integer, intent (in) :: master + integer, intent (in) :: nlunit + character (len = *), intent (in) :: input_nml_file(:) + integer, intent (in) :: logunit + character(len=64), intent (in) :: fn_nml + integer, intent (in) :: lonr + integer, intent (in) :: levs + integer, intent (in) :: latr + real, intent (in) :: ak(levs+1), bk(levs+1), pref + real, intent (in) :: dtp + real, intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes + real, intent (in) :: pa_rf_in, tau_rf_in ! integer, parameter :: logunit = 6 integer :: ios logical :: exists real :: dxsg integer :: k -! + +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml = cires_ugwp_nml) +#else if (me == master) print *, trim (fn_nml), ' GW-namelist file ' + inquire (file =trim (fn_nml) , exist = exists) -! + if (.not. exists) then if (me == master) & write (6, *) 'separate ugwp :: namelist file: ', trim (fn_nml), ' does not exist' @@ -150,6 +154,10 @@ subroutine cires_ugwp_mod_init (me, master, nlunit, logunit, fn_nml, & rewind (nlunit) read (nlunit, nml = cires_ugwp_nml) close (nlunit) +#endif + + + ! ilaunch = launch_level pa_rf = pa_rf_in From 8d7970cb21883fcd59e67b1d217dc0058855947e Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 25 Oct 2019 17:02:33 -0600 Subject: [PATCH 22/84] add initial NoahMP docs to CCPP scientific docs --- physics/docs/ccpp_doxyfile | 5 ++ physics/docs/library.bib | 106 +++++++++++++++++------- physics/docs/pdftxt/NoahMP.txt | 38 +++++++++ physics/docs/pdftxt/all_shemes_list.txt | 1 + physics/module_sf_noahmp_glacier.f90 | 33 +++++++- physics/module_sf_noahmplsm.f90 | 63 +++++++++++++- physics/noahmp_tables.f90 | 9 ++ physics/sfc_noahmp_drv.f | 44 ++++++++-- 8 files changed, 259 insertions(+), 40 deletions(-) create mode 100644 physics/docs/pdftxt/NoahMP.txt diff --git a/physics/docs/ccpp_doxyfile b/physics/docs/ccpp_doxyfile index 91c80c221..cfb805cec 100644 --- a/physics/docs/ccpp_doxyfile +++ b/physics/docs/ccpp_doxyfile @@ -134,6 +134,7 @@ INPUT = pdftxt/mainpage.txt \ ### pdftxt/GFSphys_namelist.txt \ ### pdftxt/GFS_STOCHY_PHYS.txt \ pdftxt/suite_input.nml.txt \ + pdftxt/NoahMP.txt \ ### in-core MP ../gfdl_fv_sat_adj.F90 \ ### time_vary @@ -172,6 +173,10 @@ INPUT = pdftxt/mainpage.txt \ ../sflx.f \ ../namelist_soilveg.f \ ../set_soilveg.f \ + ../sfc_noahmp_drv.f \ + ../module_sf_noahmplsm.f90 \ + ../module_sf_noahmp_glacier.f90 \ + ../noahmp_tables.f90 \ ### Sea Ice Surface ../sfc_sice.f \ ### PBL diff --git a/physics/docs/library.bib b/physics/docs/library.bib index 223c34395..507cd72da 100644 --- a/physics/docs/library.bib +++ b/physics/docs/library.bib @@ -1,13 +1,63 @@ %% This BibTeX bibliography file was created using BibDesk. -%% http://bibdesk.sourceforge.net/ +%% https://bibdesk.sourceforge.io/ -%% Created for Man Zhang at 2019-06-13 14:38:54 -0600 +%% Created for Grant Firl at 2019-10-25 16:36:06 -0600 %% Saved with string encoding Unicode (UTF-8) +@article{niu_and_yang_2006, + Abstract = { Abstract The presence of ice in soil dramatically alters soil hydrologic and thermal properties. Despite this important role, many recent studies show that explicitly including the hydrologic effects of soil ice in land surface models degrades the simulation of runoff in cold regions. This paper addresses this dilemma by employing the Community Land Model version 2.0 (CLM2.0) developed at the National Center for Atmospheric Research (NCAR) and a simple TOPMODEL-based runoff scheme (SIMTOP). CLM2.0/SIMTOP explicitly computes soil ice content and its modifications to soil hydrologic and thermal properties. However, the frozen soil scheme has a tendency to produce a completely frozen soil (100\% ice content) whenever the soil temperature is below 0$\,^{\circ}$C. The frozen ground prevents infiltration of snowmelt or rainfall, thereby resulting in earlier- and higher-than-observed springtime runoff. This paper presents modifications to the above-mentioned frozen soil scheme that produce more accurate magnitude and seasonality of runoff and soil water storage. These modifications include 1) allowing liquid water to coexist with ice in the soil over a wide range of temperatures below 0$\,^{\circ}$C by using the freezing-point depression equation, 2) computing the vertical water fluxes by introducing the concept of a fractional permeable area, which partitions the model grid into an impermeable part (no vertical water flow) and a permeable part, and 3) using the total soil moisture (liquid water and ice) to calculate the soil matric potential and hydraulic conductivity. The performance of CLM2.0/SIMTOP with these changes has been tested using observed data in cold-region river basins of various spatial scales. Compared to the CLM2.0/SIMTOP frozen soil scheme, the modified scheme produces monthly runoff that compares more favorably with that estimated by the University of New Hampshire--Global Runoff Data Center and a terrestrial water storage change that is in closer agreement with that measured by the Gravity Recovery and Climate Experiment (GRACE) satellites. }, + Author = {Niu, Guo-Yue and Yang, Zong-Liang}, + Date-Added = {2019-10-25 22:35:50 +0000}, + Date-Modified = {2019-10-25 22:36:03 +0000}, + Doi = {10.1175/JHM538.1}, + Eprint = {https://doi.org/10.1175/JHM538.1}, + Journal = {Journal of Hydrometeorology}, + Number = {5}, + Pages = {937-952}, + Title = {Effects of Frozen Soil on Snowmelt Runoff and Soil Water Storage at a Continental Scale}, + Url = {https://doi.org/10.1175/JHM538.1}, + Volume = {7}, + Year = {2006}, + Bdsk-Url-1 = {https://doi.org/10.1175/JHM538.1}} + +@article{niu_et_al_2007, + Abstract = {Groundwater interacts with soil moisture through the exchanges of water between the unsaturated soil and its underlying aquifer under gravity and capillary forces. Despite its importance, groundwater is not explicitly represented in climate models. This paper developed a simple groundwater model (SIMGM) by representing recharge and discharge processes of the water storage in an unconfined aquifer, which is added as a single integration element below the soil of a land surface model. We evaluated the model against the Gravity Recovery and Climate Experiment (GRACE) terrestrial water storage change (ΔS) data. The modeled total water storage (including unsaturated soil water and groundwater) change agrees fairly well with GRACE estimates. The anomaly of the modeled groundwater storage explains most of the GRACE ΔS anomaly in most river basins where the water storage is not affected by snow water or frozen soil. For this reason, the anomaly of the modeled water table depth agrees well with that converted from the GRACE ΔS in most of the river basins. We also investigated the impacts of groundwater dynamics on soil moisture and evapotranspiration through the comparison of SIMGM to an additional model run using gravitational free drainage (FD) as the model's lower boundary condition. SIMGM produced much wetter soil profiles globally and up to 16\% more annual evapotranspiration than FD, most obviously in arid-to-wet transition regions.}, + Author = {Niu, Guo-Yue and Yang, Zong-Liang and Dickinson, Robert E. and Gulden, Lindsey E. and Su, Hua}, + Date-Added = {2019-10-25 22:31:30 +0000}, + Date-Modified = {2019-10-25 22:31:41 +0000}, + Doi = {10.1029/2006JD007522}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2006JD007522}, + Journal = {Journal of Geophysical Research: Atmospheres}, + Keywords = {Groundwater recharge, groundwater discharge, climate models}, + Number = {D7}, + Title = {Development of a simple groundwater model for use in climate models and evaluation with Gravity Recovery and Climate Experiment data}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007522}, + Volume = {112}, + Year = {2007}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007522}, + Bdsk-Url-2 = {https://doi.org/10.1029/2006JD007522}} + +@article{niu_et_al_2011, + Abstract = {This first paper of the two-part series describes the objectives of the community efforts in improving the Noah land surface model (LSM), documents, through mathematical formulations, the augmented conceptual realism in biophysical and hydrological processes, and introduces a framework for multiple options to parameterize selected processes (Noah-MP). The Noah-MP's performance is evaluated at various local sites using high temporal frequency data sets, and results show the advantages of using multiple optional schemes to interpret the differences in modeling simulations. The second paper focuses on ensemble evaluations with long-term regional (basin) and global scale data sets. The enhanced conceptual realism includes (1) the vegetation canopy energy balance, (2) the layered snowpack, (3) frozen soil and infiltration, (4) soil moisture-groundwater interaction and related runoff production, and (5) vegetation phenology. Sample local-scale validations are conducted over the First International Satellite Land Surface Climatology Project (ISLSCP) Field Experiment (FIFE) site, the W3 catchment of Sleepers River, Vermont, and a French snow observation site. Noah-MP shows apparent improvements in reproducing surface fluxes, skin temperature over dry periods, snow water equivalent (SWE), snow depth, and runoff over Noah LSM version 3.0. Noah-MP improves the SWE simulations due to more accurate simulations of the diurnal variations of the snow skin temperature, which is critical for computing available energy for melting. Noah-MP also improves the simulation of runoff peaks and timing by introducing a more permeable frozen soil and more accurate simulation of snowmelt. We also demonstrate that Noah-MP is an effective research tool by which modeling results for a given process can be interpreted through multiple optional parameterization schemes in the same model framework.}, + Author = {Niu, Guo-Yue and Yang, Zong-Liang and Mitchell, Kenneth E. and Chen, Fei and Ek, Michael B. and Barlage, Michael and Kumar, Anil and Manning, Kevin and Niyogi, Dev and Rosero, Enrique and Tewari, Mukul and Xia, Youlong}, + Date-Added = {2019-10-25 21:50:31 +0000}, + Date-Modified = {2019-10-25 21:50:40 +0000}, + Doi = {10.1029/2010JD015139}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2010JD015139}, + Journal = {Journal of Geophysical Research: Atmospheres}, + Keywords = {Noah, land surface model, local scale, multiphysics, evaluation, validation}, + Number = {D12}, + Title = {The community Noah land surface model with multiparameterization options (Noah-MP): 1. Model description and evaluation with local-scale measurements}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2010JD015139}, + Volume = {116}, + Year = {2011}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2010JD015139}, + Bdsk-Url-2 = {https://doi.org/10.1029/2010JD015139}} + @article{bechtold_et_al_2014, Author = {P. Bechtold and N. Semane and P. Lopez and J-P Chaboureau and A. Beljaars and N. Bormann}, Date-Added = {2019-06-13 14:29:21 -0600}, @@ -66,10 +116,6 @@ @article{Gettelman_et_al_2019 Title = {The impact of rimed ice hydrometeors on global and regional climate}, Year = {2019}} -@article{cite-key, - Date-Added = {2019-06-05 16:32:11 +0000}, - Date-Modified = {2019-06-05 16:32:11 +0000}} - @article{nakanishi_2000, Author = {M. Nakanishi}, Date-Added = {2019-05-31 14:46:02 -0600}, @@ -1813,12 +1859,12 @@ @article{zeng_and_dickinson_1998 @conference{zheng_et_al_2009, Address = {Omaha, Nebraska}, Author = {W. Zheng and H. Wei and J. Meng and M. Ek and K. Mitchell and J. Derber and X. Zeng and Z. Wang}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBWLi4vLi4vLi4vLi4vLi4vRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGZPEQIgAAAAAAIgAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADT4djXSCsAAANl5rUfSW1wcm92ZW1lbnRfb2ZfTGFuZCMzNjVGRjBGLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2X/D9aQ780AAAAAAAAAAAAFAAMAAAkgAAAAAAAAAAAAAAAAAAAACE5PQUhfTFNNABAACAAA0+ItNwAAABEACAAA1pFSPQAAAAEAEANl5rUAD8YgAA/GDwAGL94AAgBRTWFjaW50b3NoIEhEOlVzZXJzOgBtYW4uemhhbmc6AERlc2t0b3A6AE5PQUhfTFNNOgBJbXByb3ZlbWVudF9vZl9MYW5kIzM2NUZGMEYucGRmAAAOAG4ANgBJAG0AcAByAG8AdgBlAG0AZQBuAHQAXwBvAGYAXwBMAGEAbgBkAF8AUwB1AHIAZgBhAGMAZQBfAFMAawBpAG4AXwBUAGUAbQBwAGUAcgBhAHQAdQByAGUAXwBpAG4AXwBOAEMALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAFdVc2Vycy9tYW4uemhhbmcvRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGYAABMAAS8AABUAAgAQ//8AAAAIAA0AGgAkAH0AAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACoQ==}, Date-Added = {2018-01-26 22:19:06 +0000}, Date-Modified = {2018-01-29 23:51:37 +0000}, Organization = {The 23rd Conference on Weather Analysis and Forecasting (WAF)/19th Conference on Numerical Weather Prediction(NWP)}, Title = {Improvement of land surface skin temperature in NCEP Operational NWP models and its impact on satellite Data Assimilation}, - Year = {2009}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBWLi4vLi4vLi4vLi4vLi4vRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGZPEQIgAAAAAAIgAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADT4djXSCsAAANl5rUfSW1wcm92ZW1lbnRfb2ZfTGFuZCMzNjVGRjBGLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2X/D9aQ780AAAAAAAAAAAAFAAMAAAkgAAAAAAAAAAAAAAAAAAAACE5PQUhfTFNNABAACAAA0+ItNwAAABEACAAA1pFSPQAAAAEAEANl5rUAD8YgAA/GDwAGL94AAgBRTWFjaW50b3NoIEhEOlVzZXJzOgBtYW4uemhhbmc6AERlc2t0b3A6AE5PQUhfTFNNOgBJbXByb3ZlbWVudF9vZl9MYW5kIzM2NUZGMEYucGRmAAAOAG4ANgBJAG0AcAByAG8AdgBlAG0AZQBuAHQAXwBvAGYAXwBMAGEAbgBkAF8AUwB1AHIAZgBhAGMAZQBfAFMAawBpAG4AXwBUAGUAbQBwAGUAcgBhAHQAdQByAGUAXwBpAG4AXwBOAEMALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAFdVc2Vycy9tYW4uemhhbmcvRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGYAABMAAS8AABUAAgAQ//8AAAAIAA0AGgAkAH0AAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACoQ==}} + Year = {2009}} @article{chen_et_al_1997, Author = {F. Chen and Z. Janjic and K. Mitchell}, @@ -2057,6 +2103,7 @@ @article{iacono_et_al_2008 @article{grant_2001, Abstract = {A closure for the fluxes of mass, heat, and moisture at cloud base in the cumulus-capped boundary layer is developed. The cloud-base mass flux is obtained from a simplifed turbulence kinetic energy (TKE) budget for the sub-cloud layer, in which cumulus convection is assumed to be associated with a transport of TKE from the sub-cloud layer to the cloud layer.The heat and moisture fluxes are obtained from a jump model based on the virtual-potential-temperature equation. A key part of this parametrization is the parametrization of the virtual-temperature flux at the top of the transition zone between the sub-cloud and cloud layers.It is argued that pressure fluctuations must be responsible for the transport of TKE from the cloud layer to the sub-cloud layer.}, Author = {A. L. M. Grant}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JhbnQvMjAwMS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoiV4IMjAwMS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARgJuNOHLk4AAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyYW50AAAQAAgAANHneLIAAAARAAgAANOHgq4AAAABABgAKIleAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyYW50OgAyMDAxLnBkZgAADgASAAgAMgAwADAAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmFudC8yMDAxLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-06-15 22:11:22 +0000}, Date-Modified = {2018-07-06 19:02:34 +0000}, Doi = {10.1002/qj.49712757209}, @@ -2070,13 +2117,13 @@ @article{grant_2001 Url = {http://dx.doi.org/10.1002/qj.49712757209}, Volume = {127}, Year = {2001}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JhbnQvMjAwMS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoiV4IMjAwMS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARgJuNOHLk4AAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyYW50AAAQAAgAANHneLIAAAARAAgAANOHgq4AAAABABgAKIleAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyYW50OgAyMDAxLnBkZgAADgASAAgAMgAwADAAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmFudC8yMDAxLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1002/qj.49712757209}} @article{zhang_and_wu_2003, Abstract = {Abstract This study uses a 2D cloud-resolving model to investigate the vertical transport of horizontal momentum and to understand the role of a convection-generated perturbation pressure field in the momentum transport by convective systems during part of the Tropical Ocean and Global Atmosphere Coupled Ocean?Atmosphere Response Experiment (TOGA COARE) Intensive Observation Period. It shows that convective updrafts transport a significant amount of momentum vertically. This transport is downgradient in the easterly wind regime, but upgradient during a westerly wind burst. The differences in convective momentum transport between easterly and westerly wind regimes are examined. The perturbation pressure gradient accounts for an important part of the apparent momentum source. In general it is opposite in sign to the product of cloud mass flux and the vertical wind shear, with smaller magnitude. Examination of the dynamic forcing to the pressure field demonstrates that the linear forcing representing the interaction between the convective updrafts and the large-scale wind shear is the dominant term, while the nonlinear forcing is of secondary importance. Thus, parameterization schemes taking into account the linear interaction between the convective updrafts and the large-scale wind shear can capture the essential features of the perturbation pressure field. The parameterization scheme for momentum transport by Zhang and Cho is evaluated using the model simulation data. The parameterized pressure gradient force using the scheme is in excellent agreement with the simulated one. The parameterized apparent momentum source is also in good agreement with the model simulation. Other parameterization methods for the pressure gradient are also discussed.}, Annote = {doi: 10.1175/1520-0469(2003)060<1120:CMTAPP>2.0.CO;2}, Author = {Zhang, Guang J. and Wu, Xiaoqing}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvWmhhbmcvMjAwMy5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqjuYIMjAwMy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFrUP9K0L8MAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVpoYW5nAAAQAAgAANHneLIAAAARAAgAANK0kjMAAAABABgAKo7mAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFpoYW5nOgAyMDAzLnBkZgAADgASAAgAMgAwADAAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9aaGFuZy8yMDAzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {2003/05/01}, Date-Added = {2016-06-14 23:39:50 +0000}, @@ -2095,13 +2142,13 @@ @article{zhang_and_wu_2003 Url = {http://dx.doi.org/10.1175/1520-0469(2003)060<1120:CMTAPP>2.0.CO;2}, Volume = {60}, Year = {2003}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvWmhhbmcvMjAwMy5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqjuYIMjAwMy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFrUP9K0L8MAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVpoYW5nAAAQAAgAANHneLIAAAARAAgAANK0kjMAAAABABgAKo7mAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFpoYW5nOgAyMDAzLnBkZgAADgASAAgAMgAwADAAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9aaGFuZy8yMDAzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(2003)060%3C1120:CMTAPP%3E2.0.CO;2}} @article{fritsch_and_chappell_1980, Abstract = {Abstract A parameterization formulation for incorporating the effects of midlatitude deep convection into mesoscale-numerical models is presented. The formulation is based on the hypothesis that the buoyant energy available to a parcel, in combination with a prescribed period of time for the convection to remove that energy, can be used to regulate the amount of convection in a mesoscale numerical model grid element. Individual clouds are represented as entraining moist updraft and downdraft plumes. The fraction of updraft condensate evaporated in moist downdrafts is determined from an empirical relationship between the vertical shear of the horizontal wind and precipitation efficiency. Vertical transports of horizontal momentum and warming by compensating subsidence are included in the parameterization. Since updraft and downdraft areas are sometimes a substantial fraction of mesoscale model grid-element areas, grid-point temperatures (adjusted for convection) are an area-weighted mean of updraft, downdraft and environmental temperatures.}, Annote = {doi: 10.1175/1520-0469(1980)037<1722:NPOCDM>2.0.CO;2}, Author = {Fritsch, J. M. and Chappell, C. F.}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvRnJpdHNjaC8xOTgwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAARCuMwgxOTgwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABEKs103xvpgAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHRnJpdHNjaAAAEAAIAADR53iyAAAAEQAIAADTfMQGAAAAAQAYARCuMwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBGcml0c2NoOgAxOTgwLnBkZgAADgASAAgAMQA5ADgAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Gcml0c2NoLzE5ODAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {1980/08/01}, Date = {1980/08/01}, @@ -2122,12 +2169,12 @@ @article{fritsch_and_chappell_1980 Volume = {37}, Year = {1980}, Year1 = {1980}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvRnJpdHNjaC8xOTgwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAARCuMwgxOTgwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABEKs103xvpgAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHRnJpdHNjaAAAEAAIAADR53iyAAAAEQAIAADTfMQGAAAAAQAYARCuMwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBGcml0c2NoOgAxOTgwLnBkZgAADgASAAgAMQA5ADgAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Gcml0c2NoLzE5ODAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(1980)037%3C1722:NPOCDM%3E2.0.CO;2}} @article{bechtold_et_al_2008, Abstract = {Advances in simulating atmospheric variability with the ECMWF model are presented that stem from revisions of the convection and diffusion parametrizations. The revisions concern in particular the introduction of a variable convective adjustment time-scale, a convective entrainment rate proportional to the environmental relative humidity, as well as free tropospheric diffusion coefficients for heat and momentum based on Monin--Obukhov functional dependencies.The forecasting system is evaluated against analyses and observations using high-resolution medium-range deterministic and ensemble forecasts, monthly and seasonal integrations, and decadal integrations with coupled atmosphere-ocean models. The results show a significantly higher and more realistic level of model activity in terms of the amplitude of tropical and extratropical mesoscale, synoptic and planetary perturbations. Importantly, with the higher variability and reduced bias not only the probabilistic scores are improved, but also the midlatitude deterministic scores in the short and medium ranges. Furthermore, for the first time the model is able to represent a realistic spectrum of convectively coupled equatorial Kelvin and Rossby waves, and maintains a realistic amplitude of the Madden--Julian oscillation (MJO) during monthly forecasts. However, the propagation speed of the MJO is slower than observed. The higher tropical tropospheric wave activity also results in better stratospheric temperatures and winds through the deposition of momentum.The partitioning between convective and resolved precipitation is unaffected by the model changes with roughly 62% of the total global precipitation being of the convective type. Finally, the changes in convection and diffusion parametrizations resulted in a larger spread of the ensemble forecasts, which allowed the amplitude of the initial perturbations in the ensemble prediction system to decrease by 30%. Copyright {\copyright} 2008 Royal Meteorological Society}, Author = {Bechtold, Peter and K{\"o}hler, Martin and Jung, Thomas and Doblas-Reyes, Francisco and Leutbecher, Martin and Rodwell, Mark J. and Vitart, Frederic and Balsamo, Gianpaolo}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAobfkIMjAwOC5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARZce9OEjEwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJlY2h0b2xkABAACAAA0ed4sgAAABEACAAA04TgrAAAAAEAGAAobfkAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQmVjaHRvbGQ6ADIwMDgucGRmAA4AEgAIADIAMAAwADgALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-06-14 23:11:58 +0000}, Date-Modified = {2016-06-14 23:11:58 +0000}, Doi = {10.1002/qj.289}, @@ -2141,12 +2188,12 @@ @article{bechtold_et_al_2008 Url = {http://dx.doi.org/10.1002/qj.289}, Volume = {134}, Year = {2008}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAobfkIMjAwOC5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARZce9OEjEwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJlY2h0b2xkABAACAAA0ed4sgAAABEACAAA04TgrAAAAAEAGAAobfkAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQmVjaHRvbGQ6ADIwMDgucGRmAA4AEgAIADIAMAAwADgALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://dx.doi.org/10.1002/qj.289}} @article{han_and_pan_2011, Annote = {doi: 10.1175/WAF-D-10-05038.1}, Author = {Han, Jongil and Pan, Hua-Lu}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMTEucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMTEucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADC1cfTGvlvAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0xtNzwAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDExLnBkZgAADgASAAgAMgAwADEAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAxMS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Booktitle = {Weather and Forecasting}, Da = {2011/08/01}, Date = {2011/08/01}, @@ -2167,22 +2214,22 @@ @article{han_and_pan_2011 Volume = {26}, Year = {2011}, Year1 = {2011}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMTEucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMTEucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADC1cfTGvlvAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0xtNzwAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDExLnBkZgAADgASAAgAMgAwADEAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAxMS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/WAF-D-10-05038.1}} @article{pan_and_wu_1995, Author = {Pan, H. -L. and W.-S. Wu}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvUGFuLzE5OTUucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAwtTNCDE5OTUucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADCtU/TGvMJAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANQYW4AABAACAAA0ed4sgAAABEACAAA0xtHaQAAAAEAGADC1M0AKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAUGFuOgAxOTk1LnBkZgAADgASAAgAMQA5ADkANQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9QYW4vMTk5NS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Date-Added = {2016-06-14 23:06:41 +0000}, Date-Modified = {2016-06-14 23:06:41 +0000}, Journal = {NMC Office Note, No. 409}, Pages = {40pp}, Title = {Implementing a Mass Flux Convection Parameterization Package for the NMC Medium-Range Forecast Model}, - Year = {1995}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvUGFuLzE5OTUucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAwtTNCDE5OTUucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADCtU/TGvMJAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANQYW4AABAACAAA0ed4sgAAABEACAAA0xtHaQAAAAEAGADC1M0AKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAUGFuOgAxOTk1LnBkZgAADgASAAgAMQA5ADkANQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9QYW4vMTk5NS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}} + Year = {1995}} @article{grell_1993, Annote = {doi: 10.1175/1520-0493(1993)121<0764:PEOAUB>2.0.CO;2}, Author = {Grell, Georg A.}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JlbGwvMTk5My5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoie0IMTk5My5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK4dtMa9LMAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyZWxsAAAQAAgAANHneLIAAAARAAgAANMbSRMAAAABABgAKIntAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyZWxsOgAxOTkzLnBkZgAADgASAAgAMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmVsbC8xOTkzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Booktitle = {Monthly Weather Review}, Da = {1993/03/01}, Date = {1993/03/01}, @@ -2203,11 +2250,11 @@ @article{grell_1993 Volume = {121}, Year = {1993}, Year1 = {1993}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JlbGwvMTk5My5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoie0IMTk5My5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK4dtMa9LMAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyZWxsAAAQAAgAANHneLIAAAARAAgAANMbSRMAAAABABgAKIntAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyZWxsOgAxOTkzLnBkZgAADgASAAgAMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmVsbC8xOTkzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0493(1993)121%3C0764:PEOAUB%3E2.0.CO;2}} @article{arakawa_and_schubert_1974, Author = {Arakawa, A and Schubert, WH}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQXJha2F3YS8xOTc0LnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAChtVQgxOTc0LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKG1ctM8h9AAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHQXJha2F3YQAAEAAIAADR53iyAAAAEQAIAAC0z4RkAAAAAQAYAChtVQAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBBcmFrYXdhOgAxOTc0LnBkZgAADgASAAgAMQA5ADcANAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9BcmFrYXdhLzE5NzQucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Date-Added = {2016-06-14 23:04:30 +0000}, Date-Modified = {2018-07-18 19:00:17 +0000}, Isi = {A1974S778800004}, @@ -2220,7 +2267,6 @@ @article{arakawa_and_schubert_1974 Title = {Interaction of a cumulus cloud ensemble with the large-scale environment, Part I}, Volume = {31}, Year = {1974}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQXJha2F3YS8xOTc0LnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAChtVQgxOTc0LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKG1ctM8h9AAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHQXJha2F3YQAAEAAIAADR53iyAAAAEQAIAAC0z4RkAAAAAQAYAChtVQAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBBcmFrYXdhOgAxOTc0LnBkZgAADgASAAgAMQA5ADcANAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9BcmFrYXdhLzE5NzQucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1974S778800004}} @article{harshvardhan_et_al_1989, @@ -2454,6 +2500,7 @@ @article{akmaev_1991 @article{siebesma_et_al_2007, Abstract = {A better conceptual understanding and more realistic parameterizations of convective boundary layers in climate and weather prediction models have been major challenges in meteorological research. In particular, parameterizations of the dry convective boundary layer, in spite of the absence of water phase-changes and its consequent simplicity as compared to moist convection, typically suffer from problems in attempting to represent realistically the boundary layer growth and what is often referred to as countergradient fluxes. The eddy-diffusivity (ED) approach has been relatively successful in representing some characteristics of neutral boundary layers and surface layers in general. The mass-flux (MF) approach, on the other hand, has been used for the parameterization of shallow and deep moist convection. In this paper, a new approach that relies on a combination of the ED and MF parameterizations (EDMF) is proposed for the dry convective boundary layer. It is shown that the EDMF approach follows naturally from a decomposition of the turbulent fluxes into 1) a part that includes strong organized updrafts, and 2) a remaining turbulent field. At the basis of the EDMF approach is the concept that nonlocal subgrid transport due to the strong updrafts is taken into account by the MF approach, while the remaining transport is taken into account by an ED closure. Large-eddy simulation (LES) results of the dry convective boundary layer are used to support the theoretical framework of this new approach and to determine the parameters of the EDMF model. The performance of the new formulation is evaluated against LES results, and it is shown that the EDMF closure is able to reproduce the main properties of dry convective boundary layers in a realistic manner. Furthermore, it will be shown that this approach has strong advantages over the more traditional countergradient approach, especially in the entrainment layer. As a result, this EDMF approach opens the way to parameterize the clear and cumulus-topped boundary layer in a simple and unified way.}, Author = {Siebesma, A. Pier and Soares, Pedro M. M. and Teixeira, Joao}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqYEwIMjAwNy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACphyMc7+4hQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAACFNpZWJlc21hABAACAAA0ed4sgAAABEACAAAxzxd+AAAAAEAGAAqYEwAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAU2llYmVzbWE6ADIwMDcucGRmAA4AEgAIADIAMAAwADcALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {DOI 10.1175/JAS3888.1}, @@ -2467,12 +2514,12 @@ @article{siebesma_et_al_2007 Title = {A combined eddy-diffusivity mass-flux approach for the convective boundary layer}, Volume = {64}, Year = {2007}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqYEwIMjAwNy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACphyMc7+4hQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAACFNpZWJlc21hABAACAAA0ed4sgAAABEACAAAxzxd+AAAAAEAGAAqYEwAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAU2llYmVzbWE6ADIwMDcucGRmAA4AEgAIADIAMAAwADcALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/000245742600011}} @article{soares_et_al_2004, Abstract = {Recently, a new consistent way of parametrizing simultaneously local and non-local turbulent transport for the convective atmospheric boundary layer has been proposed and tested for the clear boundary layer. This approach assumes that in the convective boundary layer the subgrid-scale fluxes result from two different mixing scales: small eddies, that are parametrized by an eddy-diffusivity approach, and thermals, which are represented by a mass-flux contribution. Since the interaction between the cloud layer and the underlying sub-cloud layer predominantly takes place through strong updraughts, this approach offers an interesting avenue of establishing a unified description of the turbulent transport in the cumulus-topped boundary layer. This paper explores the possibility of such a new approach for the cumulus-topped boundary layer. In the sub-cloud and cloud layers, the mass-flux term represents the effect of strong updraughts. These are modelled by a simple entraining parcel, which determines the mean properties of the strong updraughts, the boundary-layer height, the lifting condensation level and cloud top. The residual smaller-scale turbulent transport is parametrized with an eddy-diffusivity approach that uses a turbulent kinetic energy closure. The new scheme is implemented and tested in the research model MesoNH. Copyright {\copyright} 2004 Royal Meteorological Society}, Author = {Soares, P. M. M. and Miranda, P. M. A. and Siebesma, A. P. and Teixeira, J.}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBCLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmTxEBxgAAAAABxgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWIC2CDIwMDQucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABYf6DSsqNwAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAAZTb2FyZXMAEAAIAADR53iyAAAAEQAIAADSswXgAAAAAQAYAFiAtgAobJYAKGyLAChnewAbXgcAAphcAAIAXE1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBTb2FyZXM6ADIwMDQucGRmAA4AEgAIADIAMAAwADQALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAElVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmAAATAAEvAAAVAAIADf//AAAACAANABoAJABpAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjM=}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {10.1256/qj.03.223}, @@ -2486,11 +2533,11 @@ @article{soares_et_al_2004 Url = {http://dx.doi.org/10.1256/qj.03.223}, Volume = {130}, Year = {2004}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBCLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmTxEBxgAAAAABxgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWIC2CDIwMDQucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABYf6DSsqNwAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAAZTb2FyZXMAEAAIAADR53iyAAAAEQAIAADSswXgAAAAAQAYAFiAtgAobJYAKGyLAChnewAbXgcAAphcAAIAXE1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBTb2FyZXM6ADIwMDQucGRmAA4AEgAIADIAMAAwADQALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAElVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmAAATAAEvAAAVAAIADf//AAAACAANABoAJABpAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjM=}, Bdsk-Url-1 = {http://dx.doi.org/10.1256/qj.03.223}} @article{troen_and_mahrt_1986, Author = {Troen, IB and Mahrt, L.}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvVHJvZW4vMTk4Ni5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAABNeegIMTk4Ni5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAE13kNKUWwUAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVRyb2VuAAAQAAgAANHneLIAAAARAAgAANKUvXUAAAABABgATXnoAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFRyb2VuOgAxOTg2LnBkZgAADgASAAgAMQA5ADgANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Ucm9lbi8xOTg2LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {10.1007/BF00122760}, @@ -2504,13 +2551,13 @@ @article{troen_and_mahrt_1986 Url = {http://dx.doi.org/10.1007/BF00122760}, Volume = {37}, Year = {1986}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvVHJvZW4vMTk4Ni5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAABNeegIMTk4Ni5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAE13kNKUWwUAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVRyb2VuAAAQAAgAANHneLIAAAARAAgAANKUvXUAAAABABgATXnoAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFRyb2VuOgAxOTg2LnBkZgAADgASAAgAMQA5ADgANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Ucm9lbi8xOTg2LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1007/BF00122760}} @article{macvean_and_mason_1990, Abstract = {Abstract In a recent paper, Kuo and Schubert demonstrated the lack of observational support for the relevance of the criterion for cloud-top entrainment instability proposed by Randall and by Deardorff. Here we derive a new criterion, based on a model of the instability as resulting from the energy released close to cloud top, by Mixing between saturated boundary-layer air and unsaturated air from above the capping inversion. The condition is derived by considering the net conversion from potential to kinetic energy in a system consisting of two layers of fluid straddling cloud-top, when a small amount of mixing occurs between these layers. This contrasts with previous analyses, which only considered the change in buoyancy of the cloud layer when unsaturated air is mixed into it. In its most general form, this new criterion depends on the ratio of the depths of the layers involved in the mixing. It is argued that, for a self-sustaining instability, there must be a net release of kinetic energy on the same depth and time scales as the entrainment process itself. There are two plausible ways in which this requirement may be satisfied. Either one takes the depths of the layers involved in the mixing to each be comparable to the vertical scale of the entrainment process, which is typically of order tens of meters or less, or alternatively, one must allow for the efficiency with which energy released by mixing through a much deeper lower layer becomes available to initiate further entrainment. In both cases the same criterion for instability results. This criterion is much more restrictive than that proposed by Randall and by Deardorff; furthermore, the observational data is then consistent with the predictions of the current theory. Further analysis provides estimates of the turbulent fluxes associated with cloud-top entrainment instability. This analysis effectively constitutes an energetically consistent turbulence closure for models of boundary layers with cloud. The implications for such numerical models are discussed. Comparisons are also made with other possible criteria for cloud-top entrainment instability which have recently been suggested.}, Annote = {doi: 10.1175/1520-0469(1990)047<1012:CTEITS>2.0.CO;2}, Author = {MacVean, M. K. and Mason, P. J.}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTWFjVmVhbi8xOTkwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAFx8zwgxOTkwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXHyn0rkkRQAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHTWFjVmVhbgAAEAAIAADR53iyAAAAEQAIAADSuYa1AAAAAQAYAFx8zwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBNYWNWZWFuOgAxOTkwLnBkZgAADgASAAgAMQA5ADkAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9NYWNWZWFuLzE5OTAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {1990/04/01}, Date-Added = {2016-05-20 17:16:05 +0000}, @@ -2529,11 +2576,11 @@ @article{macvean_and_mason_1990 Url = {http://dx.doi.org/10.1175/1520-0469(1990)047<1012:CTEITS>2.0.CO;2}, Volume = {47}, Year = {1990}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTWFjVmVhbi8xOTkwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAFx8zwgxOTkwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXHyn0rkkRQAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHTWFjVmVhbgAAEAAIAADR53iyAAAAEQAIAADSuYa1AAAAAQAYAFx8zwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBNYWNWZWFuOgAxOTkwLnBkZgAADgASAAgAMQA5ADkAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9NYWNWZWFuLzE5OTAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(1990)047%3C1012:CTEITS%3E2.0.CO;2}} @article{louis_1979, Author = {Louis, JF}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG91aXMvMTk3OS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAonogIMTk3OS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACiej8FuU4pQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUxvdWlzAAAQAAgAANHneLIAAAARAAgAAMFutfoAAAABABgAKJ6IAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvdWlzOgAxOTc5LnBkZgAADgASAAgAMQA5ADcAOQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Mb3Vpcy8xOTc5LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-05-20 17:15:52 +0000}, Date-Modified = {2016-05-20 17:15:52 +0000}, Isi = {A1979HT69700004}, @@ -2546,12 +2593,12 @@ @article{louis_1979 Title = {A PARAMETRIC MODEL OF VERTICAL EDDY FLUXES IN THE ATMOSPHERE}, Volume = {17}, Year = {1979}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG91aXMvMTk3OS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAonogIMTk3OS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACiej8FuU4pQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUxvdWlzAAAQAAgAANHneLIAAAARAAgAAMFutfoAAAABABgAKJ6IAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvdWlzOgAxOTc5LnBkZgAADgASAAgAMQA5ADcAOQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Mb3Vpcy8xOTc5LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1979HT69700004}} @article{lock_et_al_2000, Abstract = {A new boundary layer turbulent mixing scheme has been developed for use in the UKMO weather forecasting and climate prediction models. This includes a representation of nonlocal mixing (driven by both surface fluxes and cloud-top processes) in unstable layers, either coupled to or decoupled from the surface, and an explicit entrainment parameterization. The scheme is formulated in moist conserved variables so that it can treat both dry and cloudy layers. Details of the scheme and examples of its performance in single-column model tests are presented.}, Author = {Lock, AP and Brown, AR and Bush, MR and Martin, GM and Smith, RNB}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAACibewgyMDAwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKJuLywPrPAAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAETG9jawAQAAgAANHneLIAAAARAAgAAMsETawAAAABABgAKJt7AChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvY2s6ADIwMDAucGRmAA4AEgAIADIAMAAwADAALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Date-Added = {2016-05-20 17:15:36 +0000}, Date-Modified = {2016-05-20 17:15:36 +0000}, Isi = {000089461100008}, @@ -2564,13 +2611,13 @@ @article{lock_et_al_2000 Title = {A new boundary layer mixing scheme. {P}art {I}: Scheme description and single-column model tests}, Volume = {128}, Year = {2000}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAACibewgyMDAwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKJuLywPrPAAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAETG9jawAQAAgAANHneLIAAAARAAgAAMsETawAAAABABgAKJt7AChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvY2s6ADIwMDAucGRmAA4AEgAIADIAMAAwADAALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/000089461100008}} @article{hong_and_pan_1996, Abstract = {Abstract In this paper, the incorporation of a simple atmospheric boundary layer diffusion scheme into the NCEP Medium-Range Forecast Model is described. A boundary layer diffusion package based on the Troen and Mahrt nonlocal diffusion concept has been tested for possible operational implementation. The results from this approach are compared with those from the local diffusion approach, which is the current operational scheme, and verified against FIFE observations during 9?10 August 1987. The comparisons between local and nonlocal approaches are extended to the forecast for a heavy rain case of 15?17 May 1995. The sensitivity of both the boundary layer development and the precipitation forecast to the tuning parameters in the nonlocal diffusion scheme is also investigated. Special attention is given to the interaction of boundary layer processes with precipitation physics. Some results of parallel runs during August 1995 are also presented.}, Annote = {doi: 10.1175/1520-0493(1996)124<2322:NBLVDI>2.0.CO;2}, Author = {Hong, Song-You and Pan, Hua-Lu}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAE18FggxOTk2LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAATXvY0pRb8QAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAESG9uZwAQAAgAANHneLIAAAARAAgAANKUvmEAAAABABgATXwWAChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEhvbmc6ADE5OTYucGRmAA4AEgAIADEAOQA5ADYALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Booktitle = {Monthly Weather Review}, Da = {1996/10/01}, Date = {1996/10/01}, @@ -2591,13 +2638,13 @@ @article{hong_and_pan_1996 Volume = {124}, Year = {1996}, Year1 = {1996}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAE18FggxOTk2LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAATXvY0pRb8QAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAESG9uZwAQAAgAANHneLIAAAARAAgAANKUvmEAAAABABgATXwWAChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEhvbmc6ADE5OTYucGRmAA4AEgAIADEAOQA5ADYALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0493(1996)124%3C2322:NBLVDI%3E2.0.CO;2}} @article{han_and_pan_2006, Abstract = {Abstract A parameterization of the convection-induced pressure gradient force (PGF) in convective momentum transport (CMT) is tested for hurricane intensity forecasting using NCEP's operational Global Forecast System (GFS) and its nested Regional Spectral Model (RSM). In the parameterization the PGF is assumed to be proportional to the product of the cloud mass flux and vertical wind shear. Compared to control forecasts using the present operational GFS and RSM where the PGF effect in CMT is taken into account empirically, the new PGF parameterization helps increase hurricane intensity by reducing the vertical momentum exchange, giving rise to a closer comparison to the observations. In addition, the new PGF parameterization forecasts not only show more realistically organized precipitation patterns with enhanced hurricane intensity but also reduce the forecast track error. Nevertheless, the model forecasts with the new PGF parameterization still largely underpredict the observed intensity. One of the many possible reasons for the large underprediction may be the absence of hurricane initialization in the models.}, Annote = {doi: 10.1175/MWR3090.1}, Author = {Han, Jongil and Pan, Hua-Lu}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMDYucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMDYucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABazFjStCvVAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0rSORQAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDA2LnBkZgAADgASAAgAMgAwADAANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAwNi5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Booktitle = {Monthly Weather Review}, Da = {2006/02/01}, Date-Added = {2016-05-20 17:11:17 +0000}, @@ -2616,11 +2663,11 @@ @article{han_and_pan_2006 Url = {http://dx.doi.org/10.1175/MWR3090.1}, Volume = {134}, Year = {2006}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMDYucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMDYucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABazFjStCvVAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0rSORQAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDA2LnBkZgAADgASAAgAMgAwADAANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAwNi5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/MWR3090.1}} @article{businger_et_al_1971, Author = {Businger, JA and Wyngaard, JC and Izumi, Y and Bradley, EF}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAodUUIMTk3MS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACh1cbTPIxwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJ1c2luZ2VyABAACAAA0ed4sgAAABEACAAAtM+FjAAAAAEAGAAodUUAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQnVzaW5nZXI6ADE5NzEucGRmAA4AEgAIADEAOQA3ADEALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-05-20 17:10:50 +0000}, Date-Modified = {2018-07-18 18:58:08 +0000}, Isi = {A1971I822800004}, @@ -2633,7 +2680,6 @@ @article{businger_et_al_1971 Title = {Flux-profile relationships in the atmospheric surface layer}, Volume = {28}, Year = {1971}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAodUUIMTk3MS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACh1cbTPIxwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJ1c2luZ2VyABAACAAA0ed4sgAAABEACAAAtM+FjAAAAAEAGAAodUUAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQnVzaW5nZXI6ADE5NzEucGRmAA4AEgAIADEAOQA3ADEALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1971I822800004}} @article{xu_and_randall_1996, @@ -2824,17 +2870,18 @@ @article{kim_and_arakawa_1995 @techreport{hou_et_al_2002, Author = {Y. Hou and S. Moorthi and K. Campana}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAiLi4vLi4vemhhbmctbGliL2hvdV9ldF9hbF8yMDAyLnBkZk8RAdwAAAAAAdwAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAAM/T1mZIKwAAAFKkjRJob3VfZXRfYWxfMjAwMi5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUqai02OGCgAAAAAAAAAAAAIAAgAACSAAAAAAAAAAAAAAAAAAAAAJemhhbmctbGliAAAQAAgAAM/UKsYAAAARAAgAANNj2moAAAABABgAUqSNAE1lSgAj19QACTbFAAk2xAACZvkAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBtYW56aGFuZzoARG9jdW1lbnRzOgBNYW4uWmhhbmc6AGdtdGItZG9jOgB6aGFuZy1saWI6AGhvdV9ldF9hbF8yMDAyLnBkZgAADgAmABIAaABvAHUAXwBlAHQAXwBhAGwAXwAyADAAMAAyAC4AcABkAGYADwAaAAwATQBhAGMAaQBuAHQAbwBzAGgAIABIAEQAEgBIVXNlcnMvbWFuemhhbmcvRG9jdW1lbnRzL01hbi5aaGFuZy9nbXRiLWRvYy96aGFuZy1saWIvaG91X2V0X2FsXzIwMDIucGRmABMAAS8AABUAAgAP//8AAAAIAA0AGgAkAEkAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACKQ==}, Date-Added = {2016-05-19 19:52:22 +0000}, Date-Modified = {2016-05-20 15:14:59 +0000}, Institution = {NCEP}, Number = {441}, Title = {Parameterization of Solar Radiation Transfer}, Type = {office note}, - Year = {2002}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAiLi4vLi4vemhhbmctbGliL2hvdV9ldF9hbF8yMDAyLnBkZk8RAdwAAAAAAdwAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAAM/T1mZIKwAAAFKkjRJob3VfZXRfYWxfMjAwMi5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUqai02OGCgAAAAAAAAAAAAIAAgAACSAAAAAAAAAAAAAAAAAAAAAJemhhbmctbGliAAAQAAgAAM/UKsYAAAARAAgAANNj2moAAAABABgAUqSNAE1lSgAj19QACTbFAAk2xAACZvkAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBtYW56aGFuZzoARG9jdW1lbnRzOgBNYW4uWmhhbmc6AGdtdGItZG9jOgB6aGFuZy1saWI6AGhvdV9ldF9hbF8yMDAyLnBkZgAADgAmABIAaABvAHUAXwBlAHQAXwBhAGwAXwAyADAAMAAyAC4AcABkAGYADwAaAAwATQBhAGMAaQBuAHQAbwBzAGgAIABIAEQAEgBIVXNlcnMvbWFuemhhbmcvRG9jdW1lbnRzL01hbi5aaGFuZy9nbXRiLWRvYy96aGFuZy1saWIvaG91X2V0X2FsXzIwMDIucGRmABMAAS8AABUAAgAP//8AAAAIAA0AGgAkAEkAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACKQ==}} + Year = {2002}} @article{hu_and_stamnes_1993, Author = {Y.X. Hu and K. Stamnes}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAnLi4vLi4vemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmTxEB8AAAAAAB8AACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAAz9PWZkgrAAAAUqSNF2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABSpJHTY3R+AAAAAAAAAAAAAgACAAAJIAAAAAAAAAAAAAAAAAAAAAl6aGFuZy1saWIAABAACAAAz9QqxgAAABEACAAA02PI3gAAAAEAGABSpI0ATWVKACPX1AAJNsUACTbEAAJm+QACAGBNYWNpbnRvc2ggSEQ6VXNlcnM6AG1hbnpoYW5nOgBEb2N1bWVudHM6AE1hbi5aaGFuZzoAZ210Yi1kb2M6AHpoYW5nLWxpYjoAaHVfYW5kX3N0YW1uZXNfMTk5My5wZGYADgAwABcAaAB1AF8AYQBuAGQAXwBzAHQAYQBtAG4AZQBzAF8AMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIATVVzZXJzL21hbnpoYW5nL0RvY3VtZW50cy9NYW4uWmhhbmcvZ210Yi1kb2MvemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAATAAEvAAAVAAIAD///AAAACAANABoAJABOAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAkI=}, Date-Added = {2016-05-19 19:31:56 +0000}, Date-Modified = {2016-05-20 15:13:12 +0000}, Journal = {J. Climate}, @@ -2842,5 +2889,4 @@ @article{hu_and_stamnes_1993 Pages = {728-742}, Title = {An accurate parameterization of the radiative properties of water clouds suitable for use in climate models}, Volume = {6}, - Year = {1993}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAnLi4vLi4vemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmTxEB8AAAAAAB8AACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAAz9PWZkgrAAAAUqSNF2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABSpJHTY3R+AAAAAAAAAAAAAgACAAAJIAAAAAAAAAAAAAAAAAAAAAl6aGFuZy1saWIAABAACAAAz9QqxgAAABEACAAA02PI3gAAAAEAGABSpI0ATWVKACPX1AAJNsUACTbEAAJm+QACAGBNYWNpbnRvc2ggSEQ6VXNlcnM6AG1hbnpoYW5nOgBEb2N1bWVudHM6AE1hbi5aaGFuZzoAZ210Yi1kb2M6AHpoYW5nLWxpYjoAaHVfYW5kX3N0YW1uZXNfMTk5My5wZGYADgAwABcAaAB1AF8AYQBuAGQAXwBzAHQAYQBtAG4AZQBzAF8AMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIATVVzZXJzL21hbnpoYW5nL0RvY3VtZW50cy9NYW4uWmhhbmcvZ210Yi1kb2MvemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAATAAEvAAAVAAIAD///AAAACAANABoAJABOAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAkI=}} + Year = {1993}} diff --git a/physics/docs/pdftxt/NoahMP.txt b/physics/docs/pdftxt/NoahMP.txt new file mode 100644 index 000000000..3f6bf52bd --- /dev/null +++ b/physics/docs/pdftxt/NoahMP.txt @@ -0,0 +1,38 @@ +/** +\page NoahMP GFS NoahMP Land Surface Model +\section des_noahmp Description + +This implementation of the NoahMP Land Surface Model (LSM) is a Fortran 90 port of version 1.6 with additions by NOAA EMC staff to work with the UFS Atmosphere model. Authoritative documentation of the NoahMP scheme can be accessed at the following link: +[NCAR Research Application Laboratory NoahMP Documentation](https://ral.ucar.edu/solutions/products/noah-multiparameterization-land-surface-model-noah-mp-lsm "NCAR RAL NoahMP Documentation") + +A primary reference for the NoahMP LSM is Niu et al. (2011) \cite niu_et_al_2011. + +The CCPP interface to the NoahMP LSM is a driving software layer on top of the actual NoahMP LSM. During the run sequence, code organization is as follows: ++ \ref noahmpdrv_run() calls + + \ref transfer_mp_parameters() + + \ref noahmp_options() + + \ref noahmp_options_glacier() and noahmp_glacier() if over the ice vegetation type (glacier) + + \ref noahmp_sflx() if over other vegetation types + + \ref penman() + +Note that noahmp_glacer() and noahmp_sflx() are the actual NoahMP codes. + +\section Default NoahMP LSM Options used in UFS atmosphere ++ Dynamic Vegetation (opt_dveg): 2 [On] ++ Canopy Stomatal Resistance (opt_crs): 1 [Ball-Berry] ++ Soil Moisture Factor for Stomatal Resistance (opt_btr): 1 [Noah soil moisture] ++ Runoff and Groundwater (opt_run): 1 [topmodel with groundwater (Niu et al. 2007 \cite niu_et_al_2007)] ++ Surface Layer Drag Coeff (opt_sfc): 1 [Monin-Obukhov] ++ Supercooled Liquid Water or Ice Fraction (opt_frz): 1 [no iteration (Niu and Yang, 2006 \cite niu_and_yang_2006)] ++ Frozen Soil Permeability (opt_inf): 1 [linear effects, more permeable (Niu and Yang, 2006, \cite niu_and_yang_2006)] ++ Radiation Transfer (opt_rad): 1 [modified two-stream (gap = f(solar angle, 3d structure ...)<1-fveg)] ++ Ground Snow Surface Albedo (opt_alb): 2 [class] ++ Partitioning Precipitation into Rainfall & Snowfall (opt_snf): 4 [use microphysics output] ++ Lower Boundary Condition of Soil Temperature (opt_tbot): 2 [tbot at zbot (8m) read from a file (original Noah)] ++ Snow/Soil Temperature Time Scheme (only layer 1) (opt_stc): 1 [semi-implicit; flux top boundary condition] + +\section intra_noahmp Intraphysics Communication + + GFS NoahMP LSM Driver (\ref arg_table_noahmpdrv_run) +\section gen_al_noahmp General Algorithm of Driver ++ \ref general_noahmpdrv +*/ diff --git a/physics/docs/pdftxt/all_shemes_list.txt b/physics/docs/pdftxt/all_shemes_list.txt index 702c22256..2778a8877 100644 --- a/physics/docs/pdftxt/all_shemes_list.txt +++ b/physics/docs/pdftxt/all_shemes_list.txt @@ -19,6 +19,7 @@ parameterizations in suites. - \b Land \b Surface \b Model - \subpage GFS_NOAH - \subpage GSD_RUCLSM + - \subpage NoahMP - \b Cumulus \b Parameterizations - \subpage GFS_SAMF diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 index ced43ae5c..1b9b3cf3f 100755 --- a/physics/module_sf_noahmp_glacier.f90 +++ b/physics/module_sf_noahmp_glacier.f90 @@ -1,3 +1,7 @@ +!> \file module_sf_noahmp_glacier.f90 +!! This file contains the NoahMP Glacier scheme. + +!>\ingroup NoahMP_LSM module noahmp_glacier_globals implicit none @@ -109,6 +113,7 @@ module noahmp_glacier_globals end module noahmp_glacier_globals !------------------------------------------------------------------------------------------! +!>\ingroup NoahMP_LSM module noahmp_glacier_routines use noahmp_glacier_globals #ifndef CCPP @@ -150,6 +155,7 @@ module noahmp_glacier_routines ! ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine noahmp_glacier (& iloc ,jloc ,cosz ,nsnow ,nsoil ,dt , & ! in : time/space/model-related sfctmp ,sfcprs ,uu ,vv ,q2 ,soldn , & ! in : forcing @@ -356,6 +362,7 @@ subroutine noahmp_glacier (& end subroutine noahmp_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine atm_glacier (sfcprs ,sfctmp ,q2 ,soldn ,cosz ,thair , & qair ,eair ,rhoair ,solad ,solai , & swdown ) @@ -409,6 +416,7 @@ subroutine atm_glacier (sfcprs ,sfctmp ,q2 ,soldn ,cosz ,thair , & end subroutine atm_glacier ! ================================================================================================== ! -------------------------------------------------------------------------------------------------- +!>\ingroup NoahMP_LSM subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !in eair ,sfcprs ,qair ,sfctmp ,lwdn ,uu , & !in vv ,solad ,solai ,cosz ,zref , & !in @@ -612,6 +620,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i end subroutine energy_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine thermoprop_glacier (nsoil ,nsnow ,isnow ,dzsnso , & !in dt ,snowh ,snice ,snliq , & !in df ,hcpct ,snicev ,snliqv ,epore , & !out @@ -685,6 +694,7 @@ subroutine thermoprop_glacier (nsoil ,nsnow ,isnow ,dzsnso , & !in end subroutine thermoprop_glacier ! ================================================================================================== ! -------------------------------------------------------------------------------------------------- +!>\ingroup NoahMP_LSM subroutine csnow_glacier (isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , & !in tksno ,cvsno ,snicev ,snliqv ,epore ) !out ! -------------------------------------------------------------------------------------------------- @@ -741,6 +751,7 @@ subroutine csnow_glacier (isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , end subroutine csnow_glacier !=================================================================================================== +!>\ingroup NoahMP_LSM subroutine radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !in qsnow ,solad ,solai , & !in albold ,tauss , & !inout @@ -831,6 +842,7 @@ subroutine radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !i end subroutine radiation_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine snow_age_glacier (dt,tg,sneqvo,sneqv,tauss,fage) ! -------------------------------------------------------------------------------------------------- implicit none @@ -885,6 +897,7 @@ subroutine snow_age_glacier (dt,tg,sneqvo,sneqv,tauss,fage) end subroutine snow_age_glacier ! ================================================================================================== ! -------------------------------------------------------------------------------------------------- +!>\ingroup NoahMP_LSM subroutine snowalb_bats_glacier (nband,cosz,fage,albsnd,albsni) ! -------------------------------------------------------------------------------------------------- implicit none @@ -934,6 +947,7 @@ subroutine snowalb_bats_glacier (nband,cosz,fage,albsnd,albsni) end subroutine snowalb_bats_glacier ! ================================================================================================== ! -------------------------------------------------------------------------------------------------- +!>\ingroup NoahMP_LSM subroutine snowalb_class_glacier (nband,qsnow,dt,alb,albold,albsnd,albsni) ! -------------------------------------------------------------------------------------------------- implicit none @@ -979,6 +993,7 @@ subroutine snowalb_class_glacier (nband,qsnow,dt,alb,albold,albsnd,albsni) end subroutine snowalb_class_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z0m , & !in zlvl ,zpd ,qair ,sfctmp ,rhoair ,sfcprs , & !in ur ,gamma ,rsurf ,lwdn ,rhsur ,smc , & !in @@ -1203,6 +1218,7 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z end subroutine glacier_flux ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine esat(t, esw, esi, desw, desi) !--------------------------------------------------------------------------------------------------- ! use polynomials to calculate saturation vapor pressure and derivative with @@ -1254,7 +1270,7 @@ subroutine esat(t, esw, esi, desw, desi) end subroutine esat ! ================================================================================================== - +!>\ingroup NoahMP_LSM subroutine sfcdif1_glacier(iter ,zlvl ,zpd ,z0h ,z0m , & !in qair ,sfctmp ,h ,rhoair ,mpe ,ur , & !in #ifdef CCPP @@ -1428,6 +1444,7 @@ subroutine sfcdif1_glacier(iter ,zlvl ,zpd ,z0h ,z0m , & !in end subroutine sfcdif1_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine tsnosoi_glacier (nsoil ,nsnow ,isnow ,dt ,tbot , & !in ssoil ,snowh ,zbot ,zsnso ,df , & !in hcpct , & !in @@ -1491,6 +1508,7 @@ subroutine tsnosoi_glacier (nsoil ,nsnow ,isnow ,dt ,tbot , & !in end subroutine tsnosoi_glacier ! ================================================================================================== ! ---------------------------------------------------------------------- +!>\ingroup NoahMP_LSM subroutine hrt_glacier (nsnow ,nsoil ,isnow ,zsnso , & !in stc ,tbot ,zbot ,df , & !in hcpct ,ssoil ,phi , & !in @@ -1589,6 +1607,7 @@ subroutine hrt_glacier (nsnow ,nsoil ,isnow ,zsnso , & !in end subroutine hrt_glacier ! ================================================================================================== ! ---------------------------------------------------------------------- +!>\ingroup NoahMP_LSM subroutine hstep_glacier (nsnow ,nsoil ,isnow ,dt , & !in ai ,bi ,ci ,rhsts , & !inout stc ) !inout @@ -1643,6 +1662,7 @@ subroutine hstep_glacier (nsnow ,nsoil ,isnow ,dt , & !in end subroutine hstep_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine rosr12_glacier (p,a,b,c,d,delta,ntop,nsoil,nsnow) ! ---------------------------------------------------------------------- ! subroutine rosr12 @@ -1703,6 +1723,7 @@ subroutine rosr12_glacier (p,a,b,c,d,delta,ntop,nsoil,nsnow) end subroutine rosr12_glacier ! ---------------------------------------------------------------------- ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & !in dzsnso , & !in stc ,snice ,snliq ,sneqv ,snowh , & !inout @@ -1992,6 +2013,7 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & end subroutine phasechange_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in qvap ,qdew ,ficeold,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout @@ -2173,6 +2195,7 @@ subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in end subroutine water_glacier ! ================================================================================================== ! ---------------------------------------------------------------------- +!>\ingroup NoahMP_LSM subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in snowhin,qsnow ,qsnfro ,qsnsub ,qrain , & !in ficeold,zsoil , & !in @@ -2299,6 +2322,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in end subroutine snowwater_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine snowfall_glacier (nsoil ,nsnow ,dt ,qsnow ,snowhin , & !in sfctmp , & !in isnow ,snowh ,dzsnso ,stc ,snice , & !inout @@ -2364,6 +2388,7 @@ subroutine snowfall_glacier (nsoil ,nsnow ,dt ,qsnow ,snowhin , & !in end subroutine snowfall_glacier ! ================================================================================================== ! ---------------------------------------------------------------------- +!>\ingroup NoahMP_LSM subroutine compact_glacier (nsnow ,nsoil ,dt ,stc ,snice , & !in snliq ,imelt ,ficeold, & !in isnow ,dzsnso ) !inout @@ -2463,6 +2488,7 @@ subroutine compact_glacier (nsnow ,nsoil ,dt ,stc ,snice , & !in end subroutine compact_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine combine_glacier (nsnow ,nsoil , & !in isnow ,sh2o ,stc ,snice ,snliq , & !inout dzsnso ,sice ,snowh ,sneqv , & !inout @@ -2635,6 +2661,7 @@ end subroutine combine_glacier ! ================================================================================================== ! ---------------------------------------------------------------------- +!>\ingroup NoahMP_LSM subroutine combo_glacier(dz, wliq, wice, t, dz2, wliq2, wice2, t2) ! ---------------------------------------------------------------------- implicit none @@ -2686,6 +2713,7 @@ subroutine combo_glacier(dz, wliq, wice, t, dz2, wliq2, wice2, t2) end subroutine combo_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine divide_glacier (nsnow ,nsoil , & !in isnow ,stc ,snice ,snliq ,dzsnso ) !inout ! ---------------------------------------------------------------------- @@ -2811,6 +2839,7 @@ subroutine divide_glacier (nsnow ,nsoil , & !in end subroutine divide_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in qrain , & !in isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout @@ -2958,6 +2987,7 @@ subroutine snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in end subroutine snowh2o_glacier ! ********************* end of water subroutines ****************************************** ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine error_glacier (iloc ,jloc ,swdown ,fsa ,fsr ,fira , & fsh ,fgev ,ssoil ,sag ,prcp ,edir , & #ifdef CCPP @@ -3043,6 +3073,7 @@ subroutine error_glacier (iloc ,jloc ,swdown ,fsa ,fsr ,fira , & end subroutine error_glacier ! ================================================================================================== +!>\ingroup NoahMP_LSM subroutine noahmp_options_glacier(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 index af7a8362e..a0612d417 100755 --- a/physics/module_sf_noahmplsm.f90 +++ b/physics/module_sf_noahmplsm.f90 @@ -1,3 +1,7 @@ +!> \file module_sf_noahmplsm.f90 +!! This file contains the NoahMP land surface model. + +!>\ingroup NoahMP_LSM module module_sf_noahmplsm #ifndef CCPP use module_wrf_utl @@ -277,6 +281,7 @@ module module_sf_noahmplsm ! !== begin noahmp_sflx ============================================================================== +!>\ingroup NoahMP_LSM subroutine noahmp_sflx (parameters, & iloc , jloc , lat , yearlen , julian , cosz , & ! in : time/space-related dt , dx , dz8w , nsoil , zsoil , nsnow , & ! in : model configuration @@ -753,6 +758,7 @@ end subroutine noahmp_sflx !== begin atm ====================================================================================== +!>\ingroup NoahMP_LSM subroutine atm (parameters,sfcprs ,sfctmp ,q2 , & prcpconv,prcpnonc ,prcpshcv,prcpsnow,prcpgrpl,prcphail , & soldn ,cosz ,thair ,qair , & @@ -899,6 +905,7 @@ end subroutine atm !== begin phenology ================================================================================ +!>\ingroup NoahMP_LSM subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , julian , & !in lai , sai , troot , elai , esai , igs) @@ -993,6 +1000,7 @@ end subroutine phenology !== begin precip_heat ============================================================================== +!>\ingroup NoahMP_LSM subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv , & !in elai ,esai ,fveg ,ist , & !in bdfall ,rain ,snow ,fp , & !in @@ -1222,6 +1230,7 @@ end subroutine precip_heat !== begin error ==================================================================================== +!>\ingroup NoahMP_LSM subroutine error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & fgev ,fctr ,ssoil ,beg_wb ,canliq ,canice , & sneqv ,wa ,smc ,dzsnso ,prcp ,ecan , & @@ -1415,6 +1424,7 @@ end subroutine error !== begin energy =================================================================================== +!>\ingroup NoahMP_LSM subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in isnow ,dt ,rhoair ,sfcprs ,qair , & !in sfctmp ,thair ,lwdn ,uu ,vv ,zref , & !in @@ -2092,6 +2102,7 @@ end subroutine energy !== begin thermoprop =============================================================================== +!>\ingroup NoahMP_LSM subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , & !in dt ,snowh ,snice ,snliq , & !in smc ,sh2o ,tg ,stc ,ur , & !in @@ -2203,6 +2214,7 @@ end subroutine thermoprop !== begin csnow ==================================================================================== +!>\ingroup NoahMP_LSM subroutine csnow (parameters,isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , & !in tksno ,cvsno ,snicev ,snliqv ,epore ) !out ! -------------------------------------------------------------------------------------------------- @@ -2262,6 +2274,7 @@ end subroutine csnow !== begin tdfcnd =================================================================================== +!>\ingroup NoahMP_LSM subroutine tdfcnd (parameters, df, smc, sh2o) ! -------------------------------------------------------------------------------------------------- ! calculate thermal diffusivity and conductivity of the soil. @@ -2371,6 +2384,7 @@ end subroutine tdfcnd !== begin radiation ================================================================================ +!>\ingroup NoahMP_LSM subroutine radiation (parameters,vegtyp ,ist ,ice ,nsoil , & !in sneqvo ,sneqv ,dt ,cosz ,snowh , & !in tg ,tv ,fsno ,qsnow ,fwet , & !in @@ -2495,6 +2509,7 @@ end subroutine radiation !== begin albedo =================================================================================== +!>\ingroup NoahMP_LSM subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in dt ,cosz ,fage ,elai ,esai , & !in tg ,tv ,snowh ,fsno ,fwet , & !in @@ -2677,6 +2692,7 @@ end subroutine albedo !== begin surrad =================================================================================== +!>\ingroup NoahMP_LSM subroutine surrad (parameters,mpe ,fsun ,fsha ,elai ,vai , & !in laisun ,laisha ,solad ,solai ,fabd , & !in fabi ,ftdd ,ftid ,ftii ,albgrd , & !in @@ -2802,6 +2818,7 @@ end subroutine surrad !== begin snow_age ================================================================================= +!>\ingroup NoahMP_LSM subroutine snow_age (parameters,dt,tg,sneqvo,sneqv,tauss,fage) ! ---------------------------------------------------------------------- implicit none @@ -2856,6 +2873,7 @@ end subroutine snow_age !== begin snowalb_bats ============================================================================= +!>\ingroup NoahMP_LSM subroutine snowalb_bats (parameters,nband,fsno,cosz,fage,albsnd,albsni) ! -------------------------------------------------------------------------------------------------- implicit none @@ -2911,6 +2929,7 @@ end subroutine snowalb_bats !== begin snowalb_class ============================================================================ +!>\ingroup NoahMP_LSM subroutine snowalb_class (parameters,nband,qsnow,dt,alb,albold,albsnd,albsni,iloc,jloc) ! ---------------------------------------------------------------------- implicit none @@ -2964,6 +2983,7 @@ end subroutine snowalb_class !== begin groundalb ================================================================================ +!>\ingroup NoahMP_LSM subroutine groundalb (parameters,nsoil ,nband ,ice ,ist , & !in fsno ,smc ,albsnd ,albsni ,cosz , & !in tg ,iloc ,jloc , & !in @@ -3028,6 +3048,7 @@ end subroutine groundalb !== begin twostream ================================================================================ +!>\ingroup NoahMP_LSM subroutine twostream (parameters,ib ,ic ,vegtyp ,cosz ,vai , & !in fwet ,t ,albgrd ,albgri ,rho , & !in tau ,fveg ,ist ,iloc ,jloc , & !in @@ -3278,6 +3299,7 @@ end subroutine twostream !== begin vege_flux ================================================================================ +!>\ingroup NoahMP_LSM subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & !in dt ,sav ,sag ,lwdn ,ur , & !in uu ,vv ,sfctmp ,thair ,qair , & !in @@ -3851,6 +3873,7 @@ end subroutine vege_flux !== begin bare_flux ================================================================================ +!>\ingroup NoahMP_LSM subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & !in lwdn ,ur ,uu ,vv ,sfctmp , & !in thair ,qair ,eair ,rhoair ,snowh , & !in @@ -4174,6 +4197,7 @@ end subroutine bare_flux !== begin ragrb ==================================================================================== +!>\ingroup NoahMP_LSM subroutine ragrb(parameters,iter ,vai ,rhoair ,hg ,tah , & !in zpd ,z0mg ,z0hg ,hcan ,uc , & !in z0h ,fv ,cwp ,vegtyp ,mpe , & !in @@ -4274,6 +4298,7 @@ end subroutine ragrb !== begin sfcdif1 ================================================================================== +!>\ingroup NoahMP_LSM subroutine sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in & zlvl ,zpd ,z0m ,z0h ,ur , & !in & mpe ,iloc ,jloc , & !in @@ -4452,6 +4477,7 @@ end subroutine sfcdif1 !== begin sfcdif2 ================================================================================== +!>\ingroup NoahMP_LSM subroutine sfcdif2(parameters,iter ,z0 ,thz0 ,thlm ,sfcspd , & !in zlm ,iloc ,jloc , & !in akms ,akhs ,rlmo ,wstar2 , & !in @@ -4654,6 +4680,7 @@ end subroutine sfcdif2 !== begin esat ===================================================================================== +!>\ingroup NoahMP_LSM subroutine esat(t, esw, esi, desw, desi) !--------------------------------------------------------------------------------------------------- ! use polynomials to calculate saturation vapor pressure and derivative with @@ -4707,6 +4734,7 @@ end subroutine esat !== begin stomata ================================================================================== +!>\ingroup NoahMP_LSM subroutine stomata (parameters,vegtyp ,mpe ,apar ,foln ,iloc , jloc, & !in tv ,ei ,ea ,sfctmp ,sfcprs , & !in o2 ,co2 ,igs ,btran ,rb , & !in @@ -4840,6 +4868,7 @@ end subroutine stomata !== begin canres =================================================================================== +!>\ingroup NoahMP_LSM subroutine canres (parameters,par ,sfctmp,rcsoil ,eah ,sfcprs , & !in rc ,psn ,iloc ,jloc ) !out @@ -4924,6 +4953,7 @@ end subroutine canres !== begin calhum =================================================================================== +!>\ingroup NoahMP_LSM subroutine calhum(parameters,sfctmp, sfcprs, q2sat, dqsdt2) implicit none @@ -4955,6 +4985,7 @@ end subroutine calhum !== begin tsnosoi ================================================================================== +!>\ingroup NoahMP_LSM subroutine tsnosoi (parameters,ice ,nsoil ,nsnow ,isnow ,ist , & !in tbot ,zsnso ,ssoil ,df ,hcpct , & !in sag ,dt ,snowh ,dzsnso , & !in @@ -5090,6 +5121,7 @@ end subroutine tsnosoi !== begin hrt ====================================================================================== +!>\ingroup NoahMP_LSM subroutine hrt (parameters,nsnow ,nsoil ,isnow ,zsnso , & stc ,tbot ,zbot ,dt , & df ,hcpct ,ssoil ,phi , & @@ -5192,6 +5224,7 @@ end subroutine hrt !== begin hstep ==================================================================================== +!>\ingroup NoahMP_LSM subroutine hstep (parameters,nsnow ,nsoil ,isnow ,dt , & ai ,bi ,ci ,rhsts , & stc ) @@ -5251,6 +5284,7 @@ end subroutine hstep !== begin rosr12 =================================================================================== +!>\ingroup NoahMP_LSM subroutine rosr12 (p,a,b,c,d,delta,ntop,nsoil,nsnow) ! ---------------------------------------------------------------------- ! subroutine rosr12 @@ -5312,6 +5346,7 @@ end subroutine rosr12 !== begin phasechange ============================================================================== +!>\ingroup NoahMP_LSM subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , & !in dzsnso ,hcpct ,ist ,iloc ,jloc , & !in stc ,snice ,snliq ,sneqv ,snowh , & !inout @@ -5535,10 +5570,13 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , end subroutine phasechange !== begin frh2o ==================================================================================== + +!>\ingroup NoahMP_LSM + subroutine frh2o (parameters,free,tkelv,smc,sh2o,& #ifdef CCPP - subroutine frh2o (parameters,free,tkelv,smc,sh2o,errmsg,errflg) + errmsg,errflg) #else - subroutine frh2o (parameters,free,tkelv,smc,sh2o) + ) #endif ! ---------------------------------------------------------------------- @@ -5686,6 +5724,7 @@ end subroutine frh2o !== begin water ==================================================================================== +!>\ingroup NoahMP_LSM subroutine water (parameters,vegtyp ,nsnow ,nsoil ,imelt ,dt ,uu , & !in vv ,fcev ,fctr ,qprecc ,qprecl ,elai , & !in esai ,sfctmp ,qvap ,qdew ,zsoil ,btrani , & !in @@ -5917,6 +5956,7 @@ end subroutine water !== begin canwater ================================================================================= +!>\ingroup NoahMP_LSM subroutine canwater (parameters,vegtyp ,dt , & !in fcev ,fctr ,elai , & !in esai ,tg ,fveg ,iloc , jloc , & !in @@ -6049,6 +6089,7 @@ end subroutine canwater !== begin snowwater ================================================================================ +!>\ingroup NoahMP_LSM subroutine snowwater (parameters,nsnow ,nsoil ,imelt ,dt ,zsoil , & !in sfctmp ,snowhin,qsnow ,qsnfro ,qsnsub , & !in qrain ,ficeold,iloc ,jloc , & !in @@ -6182,6 +6223,7 @@ end subroutine snowwater !== begin snowfall ================================================================================= +!>\ingroup NoahMP_LSM subroutine snowfall (parameters,nsoil ,nsnow ,dt ,qsnow ,snowhin , & !in sfctmp ,iloc ,jloc , & !in isnow ,snowh ,dzsnso ,stc ,snice , & !inout @@ -6252,6 +6294,7 @@ end subroutine snowfall !== begin combine ================================================================================== +!>\ingroup NoahMP_LSM subroutine combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in isnow ,sh2o ,stc ,snice ,snliq , & !inout dzsnso ,sice ,snowh ,sneqv , & !inout @@ -6438,6 +6481,7 @@ end subroutine combine !== begin divide =================================================================================== +!>\ingroup NoahMP_LSM subroutine divide (parameters,nsnow ,nsoil , & !in isnow ,stc ,snice ,snliq ,dzsnso ) !inout ! ---------------------------------------------------------------------- @@ -6566,6 +6610,7 @@ end subroutine divide !== begin combo ==================================================================================== +!>\ingroup NoahMP_LSM subroutine combo(parameters,dz, wliq, wice, t, dz2, wliq2, wice2, t2) ! ---------------------------------------------------------------------- implicit none @@ -6620,6 +6665,7 @@ end subroutine combo !== begin compact ================================================================================== +!>\ingroup NoahMP_LSM subroutine compact (parameters,nsnow ,nsoil ,dt ,stc ,snice , & !in snliq ,zsoil ,imelt ,ficeold,iloc , jloc , & !in isnow ,dzsnso ,zsnso ) !inout @@ -6725,6 +6771,7 @@ end subroutine compact !== begin snowh2o ================================================================================== +!>\ingroup NoahMP_LSM subroutine snowh2o (parameters,nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in qrain ,iloc ,jloc , & !in isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout @@ -6878,6 +6925,7 @@ end subroutine snowh2o !== begin soilwater ================================================================================ +!>\ingroup NoahMP_LSM subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in qinsur ,qseva ,etrani ,sice ,iloc , jloc, & !in sh2o ,smc ,zwt ,vegtyp ,& !inout @@ -7138,6 +7186,7 @@ end subroutine soilwater !== begin zwteq ==================================================================================== +!>\ingroup NoahMP_LSM subroutine zwteq (parameters,nsoil ,nsnow ,zsoil ,dzsnso ,sh2o ,zwt) ! ---------------------------------------------------------------------- ! calculate equilibrium water table depth (niu et al., 2005) @@ -7194,6 +7243,7 @@ end subroutine zwteq !== begin infil ==================================================================================== +!>\ingroup NoahMP_LSM subroutine infil (parameters,nsoil ,dt ,zsoil ,sh2o ,sice , & !in sicemax,qinsur , & !in pddum ,runsrf ) !out @@ -7294,6 +7344,7 @@ end subroutine infil !== begin srt ====================================================================================== +!>\ingroup NoahMP_LSM subroutine srt (parameters,nsoil ,zsoil ,dt ,pddum ,etrani , & !in qseva ,sh2o ,smc ,zwt ,fcr , & !in sicemax,fcrmax ,iloc ,jloc ,smcwtd , & !in @@ -7427,6 +7478,7 @@ end subroutine srt !== begin sstep ==================================================================================== +!>\ingroup NoahMP_LSM subroutine sstep (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in sice ,iloc ,jloc ,zwt , & !in sh2o ,smc ,ai ,bi ,ci , & !inout @@ -7538,6 +7590,7 @@ end subroutine sstep !== begin wdfcnd1 ================================================================================== +!>\ingroup NoahMP_LSM subroutine wdfcnd1 (parameters,wdf,wcnd,smc,fcr) ! ---------------------------------------------------------------------- ! calculate soil water diffusivity and soil hydraulic conductivity. @@ -7576,6 +7629,7 @@ end subroutine wdfcnd1 !== begin wdfcnd2 ================================================================================== +!>\ingroup NoahMP_LSM subroutine wdfcnd2 (parameters,wdf,wcnd,smc,sice) ! ---------------------------------------------------------------------- ! calculate soil water diffusivity and soil hydraulic conductivity. @@ -7617,6 +7671,7 @@ end subroutine wdfcnd2 !== begin groundwater ============================================================================== +!>\ingroup NoahMP_LSM subroutine groundwater(parameters,nsnow ,nsoil ,dt ,sice ,zsoil , & !in stc ,wcnd ,fcrmax ,iloc ,jloc , & !in sh2o ,zwt ,wa ,wt , & !inout @@ -7804,6 +7859,7 @@ end subroutine groundwater !== begin shallowwatertable ======================================================================== +!>\ingroup NoahMP_LSM subroutine shallowwatertable (parameters,nsnow ,nsoil ,zsoil, dt , & !in dzsnso ,smceq ,iloc ,jloc , & !in smc ,wtd ,smcwtd ,rech, qdrain ) !inout @@ -7943,6 +7999,7 @@ end subroutine shallowwatertable !== begin carbon =================================================================================== +!>\ingroup NoahMP_LSM subroutine carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in dzsnso ,stc ,smc ,tv ,tg ,psn , & !in foln ,btran ,apar ,fveg ,igs , & !in @@ -8056,6 +8113,7 @@ end subroutine carbon !== begin co2flux ================================================================================== +!>\ingroup NoahMP_LSM subroutine co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in dzsnso ,stc ,psn ,troot ,tv , & !in wroot ,wstres ,foln ,lapm , & !in @@ -8424,6 +8482,7 @@ end subroutine co2flux !== begin noahmp_options =========================================================================== +!>\ingroup NoahMP_LSM subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) diff --git a/physics/noahmp_tables.f90 b/physics/noahmp_tables.f90 index cbad19b4b..7bab292fb 100755 --- a/physics/noahmp_tables.f90 +++ b/physics/noahmp_tables.f90 @@ -1,3 +1,12 @@ +!> \file noahmp_tables.f90 +!! This file contains Fortran versions of the data tables included with NoahMP in mptable.tbl, soilparm.tbl, and genparm.tbl. + +!> \ingroup NoahMP_LSM +!! \brief Data from MPTABLE.TBL, SOILPARM.TBL, GENPARM.TBL for NoahMP +!! +!! Note that a subset of the data in the *.TBL files is represented in this file. For example, +!! only the data in the noah_mp_modis_parameters section of MPTABLE.TBL and the STAS section of +!! SOILPARM.TBL are included in this module. module noahmp_tables implicit none diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f index ab9f2af0d..5ddd5aefc 100755 --- a/physics/sfc_noahmp_drv.f +++ b/physics/sfc_noahmp_drv.f @@ -1,7 +1,13 @@ !> \file sfc_noahmp_drv.f !! This file contains the NoahMP land surface scheme driver. -!> This module contains the CCPP-compliant NoahMP land surface scheme driver. +!>\defgroup NoahMP_LSM NoahMP LSM Model +!! \brief This is the NoahMP LSM driver module, with the functionality of +!! preparing variables to run the NoahMP LSM subroutine noahmp_sflx(), calling NoahMP LSM and post-processing +!! variables for return to the parent model suite including unit conversion, as well +!! as diagnotics calculation. + +!> This module contains the CCPP-compliant NoahMP land surface model driver. module noahmpdrv implicit none @@ -12,6 +18,9 @@ module noahmpdrv contains +!> \ingroup NoahMP_LSM +!! \brief This subroutine is called during the CCPP initialization phase and calls set_soilveg() to +!! initialize soil and vegetation parameters for the chosen soil and vegetation data sources. !! \section arg_table_noahmpdrv_init Argument Table !! \htmlinclude noahmpdrv_init.html !! @@ -38,9 +47,27 @@ end subroutine noahmpdrv_init subroutine noahmpdrv_finalize end subroutine noahmpdrv_finalize -!> \section arg_table_noahmpdrv_run Argument Table +!> \ingroup NoahMP_LSM +!! \brief This subroutine is the main CCPP entry point for the NoahMP LSM. +!! \section arg_table_noahmpdrv_run Argument Table !! \htmlinclude noahmpdrv_run.html !! +!! \section general_noahmpdrv NoahMP Driver General Algorithm +!! @{ +!! - Initialize CCPP error handling variables. +!! - Set a flag to only continue with each grid cell if the fraction of land is non-zero. +!! - This driver may be called as part of an iterative loop. If called as the first "guess" run, +!! save land-related prognostic fields to restore. +!! - Initialize output variables to zero and prepare variables for input into the NoahMP LSM. +!! - Call transfer_mp_parameters() to fill a derived datatype for input into the NoahMP LSM. +!! - Call noahmp_options() to set module-level scheme options for the NoahMP LSM. +!! - If the vegetation type is ice for the grid cell, call noahmp_options_glacier() to set +!! module-level scheme options for NoahMP Glacier and call noahmp_glacier(). +!! - For other vegetation types, call noahmp_sflx(), the entry point of the NoahMP LSM. +!! - Set output variables from the output of noahmp_glacier() and/or noahmp_sflx(). +!! - Call penman() to calculate potential evaporation. +!! - Calculate the surface specific humidity and convert surface sensible and latent heat fluxes in W m-2 from their kinematic values. +!! - If a "guess" run, restore the land-related prognostic fields. ! ! ! lheatstrg- logical, flag for canopy heat storage 1 ! ! parameterization ! @@ -968,8 +995,12 @@ subroutine noahmpdrv_run & return !................................... end subroutine noahmpdrv_run +!> @} !----------------------------------- +!> \ingroup NoahMP_LSM +!! \brief This subroutine fills in a derived data type of type noahmp_parameters with data +!! from the module \ref noahmp_tables. subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, & & soilcolor,parameters) @@ -1134,7 +1165,10 @@ end subroutine transfer_mp_parameters !-----------------------------------------------------------------------& - +!> \ingroup NoahMP_LSM +!! brief Calculate potential evaporation for the current point. Various +!! partial sums/products are also calculated and passed back to the +!! calling routine for later use. subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & & cpfac,q2,q2sat,etp,snowng,frzgra,ffrozp, & & dqsdt2,emissi_in,sncovr) @@ -1143,10 +1177,6 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & ! ---------------------------------------------------------------------- ! subroutine penman -! ---------------------------------------------------------------------- -! calculate potential evaporation for the current point. various -! partial sums/products are also calculated and passed back to the -! calling routine for later use. ! ---------------------------------------------------------------------- implicit none logical, intent(in) :: snowng, frzgra From de0058a2d40edb98b47be3eaf7cd42db6f535af9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 28 Oct 2019 17:25:36 +0000 Subject: [PATCH 23/84] 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 d8e56531c6b103c40bf847734d1a44922e3911a5 Mon Sep 17 00:00:00 2001 From: "Linlin.Pan" Date: Fri, 1 Nov 2019 06:27:31 +0000 Subject: [PATCH 24/84] modified for coupling, removing: if(cplflx)then write(*,*)'Fatal error: CCPP not been tested with cplflx=true!' stop endif --- physics/GFS_PBL_generic.F90 | 4 ---- physics/GFS_surface_generic.F90 | 4 ---- physics/sfc_sice.f | 4 ---- 3 files changed, 12 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 49401d6ae..ec6134ed5 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -463,10 +463,6 @@ 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 ! --- ... coupling insertion diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 0b1e43e5c..d8520c333 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -184,10 +184,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, ! + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0)), one) end do - if(cplflx)then - write(*,*)'Fatal error: CCPP is not ready for cplflx=true!!' - stop - endif if (cplflx) then do i=1,im diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 9471792fa..750a6d795 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -205,10 +205,6 @@ subroutine sfc_sice_run & errmsg = '' errflg = 0 - if(cplflx)then - write(*,*)'Fatal error: CCPP not been tested with cplflx=true!' - stop - endif if (cplflx) then where (flag_cice) From 9e906cc1ffa93fc22eda95715ba73b3d63546a30 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 1 Nov 2019 11:05:51 +0000 Subject: [PATCH 25/84] 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 86276c1e3708fb5ec38113c1849bcf6808f25aea Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 5 Nov 2019 16:03:06 +0900 Subject: [PATCH 26/84] physics/ozphys.*, physics/ozphys_2015.*: add guard to prevent mismatch of namelist option for old/new ozphys and entry in suite definition file --- physics/ozphys.f | 19 ++++++++++++++++++- physics/ozphys.meta | 25 +++++++++++++++++++++++++ physics/ozphys_2015.f | 19 ++++++++++++++++++- physics/ozphys_2015.meta | 25 +++++++++++++++++++++++++ 4 files changed, 86 insertions(+), 2 deletions(-) diff --git a/physics/ozphys.f b/physics/ozphys.f index 73f7d8b20..02296ee79 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -10,8 +10,25 @@ module ozphys ! \brief Brief description of the subroutine ! !> \section arg_table_ozphys_init Argument Table +!! \htmlinclude ozphys_init.html !! - subroutine ozphys_init() + subroutine ozphys_init(oz_phys, errmsg, errflg) + + implicit none + logical, intent(in) :: oz_phys + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.oz_phys) then + write (errmsg,'(*(a))') 'Logic error: oz_phys == .false.' + errflg = 1 + return + endif + end subroutine ozphys_init ! \brief Brief description of the subroutine diff --git a/physics/ozphys.meta b/physics/ozphys.meta index 80ab9453e..9f7a3870d 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -1,6 +1,31 @@ [ccpp-arg-table] name = ozphys_init type = scheme +[oz_phys] + standard_name = flag_for_ozone_physics + long_name = flag for old (2006) ozone physics + units = flag + dimensions = () + type = logical + 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] diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index 6983f58e2..3126313dc 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -8,8 +8,25 @@ module ozphys_2015 contains !> \section arg_table_ozphys_2015_init Argument Table +!! \htmlinclude ozphys_2015_init.html !! - subroutine ozphys_2015_init() + subroutine ozphys_2015_init(oz_phys_2015, errmsg, errflg) + + implicit none + logical, intent(in) :: oz_phys_2015 + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.oz_phys_2015) then + write (errmsg,'(*(a))') 'Logic error: oz_phys_2015 == .false.' + errflg = 1 + return + endif + end subroutine ozphys_2015_init ! \brief Brief description of the subroutine diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index e9eb7d5a5..51f8e76f4 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -1,6 +1,31 @@ [ccpp-arg-table] name = ozphys_2015_init type = scheme +[oz_phys_2015] + standard_name = flag_for_2015_ozone_physics + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + 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] From 51c13beef8b36036b5a9ac34b7951fe20b1d4eb2 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 6 Nov 2019 00:22:21 +0000 Subject: [PATCH 27/84] 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 594b5db851b98acb68c9b33a9f326b9e203fc1a1 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Thu, 7 Nov 2019 20:10:05 +0000 Subject: [PATCH 28/84] update gfdlmp to reduce cold bias in lower level --- physics/module_gfdl_cloud_microphys.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/module_gfdl_cloud_microphys.F90 index 2f6e5ec1a..01ab4655c 100644 --- a/physics/module_gfdl_cloud_microphys.F90 +++ b/physics/module_gfdl_cloud_microphys.F90 @@ -4729,7 +4729,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, real :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 real :: alphar = 0.8, alphas = 0.25, alphag = 0.5 real :: gammar = 17.837789, gammas = 8.2850630, gammag = 11.631769 - real :: qmin = 1.0e-12, beta = 1.22 + real :: qmin = 1.0e-12, beta = 1.22, qmin1 = 9.e-6 do k = ks, ke do i = is, ie @@ -4759,7 +4759,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, ! cloud ice (Heymsfield and Mcfarquhar, 1996) ! ----------------------------------------------------------------------- - if (qmi (i, k) .gt. qmin) then + if (qmi (i, k) .gt. qmin1) then qci (i, k) = dpg * qmi (i, k) * 1.0e3 rei_fac = log (1.0e3 * qmi (i, k) * den (i, k)) if (t (i, k) - tice .lt. - 50) then @@ -4785,7 +4785,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, ! cloud ice (Wyser, 1998) ! ----------------------------------------------------------------------- - if (qmi (i, k) .gt. qmin) then + if (qmi (i, k) .gt. qmin1) then qci (i, k) = dpg * qmi (i, k) * 1.0e3 bw = - 2. + 1.e-3 * log10 (den (i, k) * qmi (i, k) / rho_0) * max (0.0, tice - t (i, k)) ** 1.5 rei (i, k) = 377.4 + bw * (203.3 + bw * (37.91 + 2.3696 * bw)) @@ -4815,7 +4815,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, ! snow (Lin et al., 1983) ! ----------------------------------------------------------------------- - if (qms (i, k) .gt. qmin) then + if (qms (i, k) .gt. qmin1) then qcs (i, k) = dpg * qms (i, k) * 1.0e3 lambdas = exp (0.25 * log (pi * rhos * n0s / qms (i, k) / den (i, k))) res (i, k) = 0.5 * exp (log (gammas / 6) / alphas) / lambdas * 1.0e6 From af996a7fb3253dd5e0e78160c97e81d423653464 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 12 Nov 2019 12:59:33 +0000 Subject: [PATCH 29/84] 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 30/84] 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 12b644a588259f2a486251922dbc6fed04c65152 Mon Sep 17 00:00:00 2001 From: Weiwei Date: Wed, 13 Nov 2019 01:41:30 -0700 Subject: [PATCH 31/84] modified: cires_ugwp.F90 modified: cires_ugwp_triggers.F90 modified: docs/ccpp_doxyfile modified: docs/library.bib new file: docs/pdftxt/UGWPv0.txt modified: docs/pdftxt/all_shemes_list.txt modified: ugwp_driver_v0.F --- physics/cires_ugwp.F90 | 8 +- physics/cires_ugwp_triggers.F90 | 4 + physics/docs/ccpp_doxyfile | 5 + physics/docs/library.bib | 274 ++++++++++++++++++++++++ physics/docs/pdftxt/UGWPv0.txt | 21 ++ physics/docs/pdftxt/all_shemes_list.txt | 1 + physics/ugwp_driver_v0.F | 8 +- 7 files changed, 319 insertions(+), 2 deletions(-) create mode 100644 physics/docs/pdftxt/UGWPv0.txt diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index c15697e68..e0abc58ff 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -135,7 +135,13 @@ end subroutine cires_ugwp_finalize ! ----------------------------------------------------------------------- ! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re ! ----------------------------------------------------------------------- -!>@brief The subroutine executes the CIRES UGWP +!>@brief These subroutines and modules execute the CIRES UGWP Version 0 +!>\defgroup cires_ugwp_run Unified Gravity Wave Physics General Algorithm +!> @{ +!! The physics of NGWs in the UGWP framework (Yudin et al. 2018 \cite yudin_et_al_2018) is represented by four GW-solvers, which is introduced in Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, Alexander and Dunkerton (1999) \cite alexander_and_dunkerton_1999, and Scinocca (2003) \cite scinocca_2003. The major modification of these GW solvers is represented by the addition of the background dissipation of temperature and winds to the saturation criteria for wave breaking. This feature is important in the mesosphere and thermosphere for WAM applications and it considers appropriate scale-dependent dissipation of waves near the model top lid providing the momentum and energy conservation in the vertical column physics (Shaw and Shepherd 2009 \cite shaw_and_shepherd_2009). In the UGWP-v0, the modification of Scinocca (2003) \cite scinocca_2003 scheme for NGWs with non-hydrostatic and rotational effects for GW propagations and background dissipation is represented by the subroutine \ref fv3_ugwp_solv2_v0. In the next release of UGWP, additional GW-solvers will be implemented along with physics-based triggering of waves and stochastic approaches for selection of GW modes characterized by horizontal phase velocities, azimuthal directions and magnitude of the vertical momentum flux (VMF). +!! +!! In UGWP-v0, the specification for the VMF function is adopted from the GEOS-5 global atmosphere model of GMAO NASA/GSFC, as described in Molod et al. (2015) \cite molod_et_al_2015 and employed in the MERRRA-2 reanalysis (Gelaro et al., 2017 \cite gelaro_et_al_2017). The Fortran subroutine \ref slat_geos5_tamp describes the latitudinal shape of VMF-function as displayed in Figure 3 of Molod et al. (2015) \cite molod_et_al_2015. It shows that the enhanced values of VMF in the equatorial region gives opportunity to simulate the QBO-like oscillations in the equatorial zonal winds and lead to more realistic simulations of the equatorial dynamics in GEOS-5 operational and MERRA-2 reanalysis products. For the first vertically extended version of FV3GFS in the stratosphere and mesosphere, this simplified function of VMF allows us to tune the model climate and to evaluate multi-year simulations of FV3GFS with the MERRA-2 and ERA-5 reanalysis products, along with temperature, ozone, and water vapor observations of current satellite missions. After delivery of the UGWP-code, the EMC group developed and tested approach to modulate the zonal mean NGW forcing by 3D-distributions of the total precipitation as a proxy for the excitation of NGWs by convection and the vertically-integrated (surface - tropopause) Turbulent Kinetic Energy (TKE). The verification scores with updated NGW forcing, as reported elsewhere by EMC researchers, display noticeable improvements in the forecast scores produced by FV3GFS configuration extended into the mesosphere. +!! !> \section arg_table_cires_ugwp_run Argument Table !! \htmlinclude cires_ugwp_run.html !! diff --git a/physics/cires_ugwp_triggers.F90 b/physics/cires_ugwp_triggers.F90 index bb135b857..c345a8e85 100644 --- a/physics/cires_ugwp_triggers.F90 +++ b/physics/cires_ugwp_triggers.F90 @@ -463,6 +463,10 @@ end subroutine get_spectra_tau_okw ! ! ! +!>\ingroup cires_ugwp_run +!> @{ +!! +!! subroutine slat_geos5_tamp(im, tau_amp, xlatdeg, tau_gw) !================= ! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* diff --git a/physics/docs/ccpp_doxyfile b/physics/docs/ccpp_doxyfile index 91c80c221..fd64c81aa 100644 --- a/physics/docs/ccpp_doxyfile +++ b/physics/docs/ccpp_doxyfile @@ -120,6 +120,7 @@ INPUT = pdftxt/mainpage.txt \ pdftxt/GFS_SAMF.txt \ pdftxt/GFS_SAMFdeep.txt \ pdftxt/GFS_GWDC.txt \ + pdftxt/UGWPv0.txt \ pdftxt/GFS_SAMFshal.txt \ pdftxt/GFDL_cloud.txt \ ### pdftxt/GFS_SURFACE_PERT.txt \ @@ -199,6 +200,10 @@ INPUT = pdftxt/mainpage.txt \ ### Shallow Convection ../samfshalcnv.f \ ../cnvc90.f \ +### Unified Gravity Wave + ../cires_ugwp.F90 \ + ../ugwp_driver_v0.F \ + ../cires_ugwp_triggers.F90 \ ### Microphysics ### ../gscond.f \ ### ../precpd.f \ diff --git a/physics/docs/library.bib b/physics/docs/library.bib index 223c34395..8b159f4dd 100644 --- a/physics/docs/library.bib +++ b/physics/docs/library.bib @@ -2844,3 +2844,277 @@ @article{hu_and_stamnes_1993 Volume = {6}, Year = {1993}, Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAnLi4vLi4vemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmTxEB8AAAAAAB8AACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAAz9PWZkgrAAAAUqSNF2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABSpJHTY3R+AAAAAAAAAAAAAgACAAAJIAAAAAAAAAAAAAAAAAAAAAl6aGFuZy1saWIAABAACAAAz9QqxgAAABEACAAA02PI3gAAAAEAGABSpI0ATWVKACPX1AAJNsUACTbEAAJm+QACAGBNYWNpbnRvc2ggSEQ6VXNlcnM6AG1hbnpoYW5nOgBEb2N1bWVudHM6AE1hbi5aaGFuZzoAZ210Yi1kb2M6AHpoYW5nLWxpYjoAaHVfYW5kX3N0YW1uZXNfMTk5My5wZGYADgAwABcAaAB1AF8AYQBuAGQAXwBzAHQAYQBtAG4AZQBzAF8AMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIATVVzZXJzL21hbnpoYW5nL0RvY3VtZW50cy9NYW4uWmhhbmcvZ210Yi1kb2MvemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAATAAEvAAAVAAIAD///AAAACAANABoAJABOAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAkI=}} +@article{alexander_et_al_2010, + author = {Alexander, M. J. and Geller, M. and McLandress, C. and Polavarapu, S. and Preusse, P. and Sassi, F. and Sato, K. and Eckermann, S. and Ern, M. and Hertzog, A. and Kawatani, Y. and Pulido, M. and Shaw, T. A. and Sigmond, M. and Vincent, R. and Watanabe, S.}, + title = {Recent developments in gravity-wave effects in climate models and the global distribution of gravity-wave momentum flux from observations and models}, + journal = {Quarterly Journal of the Royal Meteorological Society}, + volume = {136}, + number = {650}, + pages = {1103-1124}, + keywords = {atmosphere, gravity wave, momentum flux, drag, force, wind tendency, climate, global model}, + doi = {10.1002/qj.637}, + url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.637}, + eprint = {https://rmets.onlinelibrary.wiley.com/doi/pdf/10.1002/qj.637}, + year = {2010} +} +@article{plougonven_and_zhang_2014, + author = {Plougonven, R. and Zhang, F.}, + title = {Internal gravity waves from atmospheric jets and fronts}, + journal = {Reviews of Geophysics}, + volume = {52}, + number = {1}, + pages = {33-76}, + keywords = {gravity waves, stratosphere, atmosphere, jets, fronts, weather}, + doi = {10.1002/2012RG000419}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2012RG000419}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2012RG000419}, + year = {2014} +} +@article{weinstock_1984, + author = {Weinstock, J.}, + title = {Simplified derivation of an algorithm for nonlinear gravity waves}, + journal = {Journal of Geophysical Research: Space Physics}, + volume = {89}, + number = {A1}, + pages = {345-350}, + doi = {10.1029/JA089iA01p00345}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/JA089iA01p00345}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/JA089iA01p00345}, + year = {1984} +} + +@article{holton_1983, + author = {Holton, James R.}, + title = {The Influence of Gravity Wave Breaking on the General Circulation of the Middle Atmosphere}, + journal = {Journal of the Atmospheric Sciences}, + volume = {40}, + number = {10}, + pages = {2497-2507}, + year = {1983}, + doi = {10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + URL = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + eprint = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2} +} +@article{geller_et_al_2013, + author = {Geller, M. A. and Alexander, M. Joan and Love, P. T. and Bacmeister, J. and Ern, M. and Hertzog, A. and Manzini, E. and Preusse, P. and Sato, K. and Scaife, A. A. and Zhou, T.}, + title = {A Comparison between Gravity Wave Momentum Fluxes in Observations and Climate Models}, + journal = {Journal of Climate}, + volume = {26}, + number = {17}, + pages = {6383-6405}, + year = {2013}, + doi = {10.1175/JCLI-D-12-00545.1}, + URL = {https://doi.org/10.1175/JCLI-D-12-00545.1}, + eprint = {https://doi.org/10.1175/JCLI-D-12-00545.1} + } +@article{garcia_et_al_2017, + author = {Garcia, R. R. and Smith, A. K. and Kinnison, D. E. and Cámara, Á. and Murphy, D. J.}, + title = {Modification of the Gravity Wave Parameterization in the Whole Atmosphere Community Climate Model: Motivation and Results}, + journal = {Journal of the Atmospheric Sciences}, + volume = {74}, + number = {1}, + pages = {275-291}, + year = {2017}, + doi = {10.1175/JAS-D-16-0104.1}, + URL = {https://doi.org/10.1175/JAS-D-16-0104.1}, + eprint = {https://doi.org/10.1175/JAS-D-16-0104.1} + } +@inproceedings{yudin_et_al_2016, + title={Gravity wave physics in the NOAA Environmental Modeling System}, + author={Yudin, V.A. and Akmaev, R.A. and Fuller-Rowell, T.J. and Alpert, J.C.}, + booktitle={International SPARC Gravity Wave Symposium}, + volume={48}, + number={1}, + pages={012024}, + year={2016}, + organization={} +} +@inproceedings{alpert_et_al_2018, + title={Integrating Unified Gravity Wave Physics Research into the Next Generation Global Prediction System for NCEP Research to Operations}, + author={Alpert, Jordan C and Yudin, Valery and Fuller-Rowell, Tim and Akmaev, Rashid A}, + booktitle={98th American Meteorological Society Annual Meeting}, + year={2018}, + organization={AMS} +} +@article{eckermann_2011, + author = {Eckermann, Stephen D.}, + title = {Explicitly Stochastic Parameterization of Nonorographic Gravity Wave Drag}, + journal = {Journal of the Atmospheric Sciences}, + volume = {68}, + number = {8}, + pages = {1749-1765}, + year = {2011}, + doi = {10.1175/2011JAS3684.1}, + URL = {https://doi.org/10.1175/2011JAS3684.1}, + eprint = {https://doi.org/10.1175/2011JAS3684.1} + } +@article{lott_et_al_2012, + author = {Lott, F. and Guez, L. and Maury, P.}, + title = {A stochastic parameterization of non-orographic gravity waves: Formalism and impact on the equatorial stratosphere}, + journal = {Geophysical Research Letters}, + volume = {39}, + number = {6}, + pages = {}, + keywords = {Quasi-Biennial Oscillation, Rossby-gravity waves, gravity waves, stochastic parameterization, stratospheric dynamics}, + doi = {10.1029/2012GL051001}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2012GL051001}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2012GL051001}, + year = {2012} +} +@conference{yudin_et_al_2018, + author = {Yudin, V. A and Akmaev, R. A. and Alpert, J. C. and Fuller-Rowell T. J., and Karol S. I.}, + Booktitle = {25th Conference on Numerical Weather Prediction}, + Date-Added = {2018-06-04 10:50:44 -0600}, + Date-Modified = {2018-06-04 10:54:39 -0600}, + Editor = {Am. Meteorol. Soc.}, + Title = {Gravity Wave Physics and Dynamics in the FV3-based Atmosphere Models Extended into the Mesosphere}, + Year = {2018} +} +@article{hines_1997, + title = "Doppler-spread parameterization of gravity-wave momentum deposition in the middle atmosphere. Part 2: Broad and quasi monochromatic spectra, and implementation", + journal = "Journal of Atmospheric and Solar-Terrestrial Physics", + volume = "59", + number = "4", + pages = "387 - 400", + year = "1997", + issn = "1364-6826", + doi = "https://doi.org/10.1016/S1364-6826(96)00080-6", + url = "http://www.sciencedirect.com/science/article/pii/S1364682696000806", + author = "Colin O. Hines" +} + +@article{alexander_and_dunkerton_1999, + author = {Alexander, M. J. and Dunkerton, T. J.}, + title = {A Spectral Parameterization of Mean-Flow Forcing due to Breaking Gravity Waves}, + journal = {Journal of the Atmospheric Sciences}, + volume = {56}, + number = {24}, + pages = {4167-4182}, + year = {1999}, + doi = {10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + URL = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + eprint = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2} +} +@article{scinocca_2003, + author = {Scinocca, John F.}, + title = {An Accurate Spectral Nonorographic Gravity Wave Drag Parameterization for General Circulation Models}, + journal = {Journal of the Atmospheric Sciences}, + volume = {60}, + number = {4}, + pages = {667-682}, + year = {2003}, + doi = {10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + URL = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + eprint = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2} +} +@article{shaw_and_shepherd_2009, + author = {Shaw, Tiffany A. and Shepherd, Theodore G.}, + title = {A Theoretical Framework for Energy and Momentum Consistency in Subgrid-Scale Parameterization for Climate Models}, + journal = {Journal of the Atmospheric Sciences}, + volume = {66}, + number = {10}, + pages = {3095-3114}, + year = {2009}, + doi = {10.1175/2009JAS3051.1}, + URL = {https://doi.org/10.1175/2009JAS3051.1}, + eprint = {https://doi.org/10.1175/2009JAS3051.1} +} +@Article{molod_et_al_2015, + AUTHOR = {Molod, A. and Takacs, L. and Suarez, M. and Bacmeister, J.}, + TITLE = {Development of the GEOS-5 atmospheric general circulation model: evolution from MERRA to MERRA2}, + JOURNAL = {Geoscientific Model Development}, + VOLUME = {8}, + YEAR = {2015}, + NUMBER = {5}, + PAGES = {1339--1356}, + URL = {https://www.geosci-model-dev.net/8/1339/2015/}, + DOI = {10.5194/gmd-8-1339-2015} +} +@article{richter_et_al_2010, + author = {Richter, Jadwiga H. and Sassi, Fabrizio and Garcia, Rolando R.}, + title = {Toward a Physically Based Gravity Wave Source Parameterization in a General Circulation Model}, + journal = {Journal of the Atmospheric Sciences}, + volume = {67}, + number = {1}, + pages = {136-156}, + year = {2010}, + doi = {10.1175/2009JAS3112.1}, + URL = {https://doi.org/10.1175/2009JAS3112.1}, + eprint = {https://doi.org/10.1175/2009JAS3112.1} +} +@article{richter_et_al_2014, + author = {Richter, Jadwiga H. and Solomon, Abraham and Bacmeister, Julio T.}, + title = {Effects of vertical resolution and nonorographic gravity wave drag on the simulated climate in the Community Atmosphere Model, version 5}, + journal = {Journal of Advances in Modeling Earth Systems}, + volume = {6}, + number = {2}, + pages = {357-383}, + keywords = {climate modeling, vertical resolution, modeling, climate, global circulation model, general circulation model}, + doi = {10.1002/2013MS000303}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2013MS000303}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2013MS000303}, + year = {2014} +} +@article{gelaro_et_al_2017, + author = {Gelaro, et al.}, + title = {The Modern-Era Retrospective Analysis for Research and Applications, Version 2 (MERRA-2)}, + journal = {Journal of Climate}, + volume = {30}, + number = {14}, + pages = {5419-5454}, + year = {2017}, + doi = {10.1175/JCLI-D-16-0758.1}, + URL = {https://doi.org/10.1175/JCLI-D-16-0758.1}, + eprint = {https://doi.org/10.1175/JCLI-D-16-0758.1} +} +@article{garcia_et_al_2007, + author = {Garcia, R. R. and Marsh, D. R. and Kinnison, D. E. and Boville, B. A. and Sassi, F.}, + title = {Simulation of secular trends in the middle atmosphere, 1950–2003}, + journal = {Journal of Geophysical Research: Atmospheres}, + volume = {112}, + number = {D9}, + pages = {}, + keywords = {global change, ozone depletion, water vapor trends, temperature trends}, + doi = {10.1029/2006JD007485}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007485}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2006JD007485}, + year = {2007} +} +@article{eckermann_et_al_2009, + title = "High-altitude data assimilation system experiments for the northern summer mesosphere season of 2007", + journal = "Journal of Atmospheric and Solar-Terrestrial Physics", + volume = "71", + number = "3", + pages = "531 - 551", + year = "2009", + note = "Global Perspectives on the Aeronomy of the Summer Mesopause Region", + issn = "1364-6826", + doi = "https://doi.org/10.1016/j.jastp.2008.09.036", + url = "http://www.sciencedirect.com/science/article/pii/S1364682608002575", + author = "Stephen D. Eckermann and Karl W. Hoppel and Lawrence Coy and John P. McCormack and David E. Siskind and Kim Nielsen and Andrew Kochenash and Michael H. Stevens and Christoph R. Englert and Werner Singer and Mark Hervig", + keywords = "Data assimilation, Polar mesospheric cloud, Tide, Planetary wave, Mesosphere", +} +@inproceedings{alpert_et_al_2019, + title={Atmospheric Gravity Wave Sources Correlated with Resolved-scale GW Activity and Sub-grid Scale Parameterization in the FV3gfs Model}, + author={Alpert, Jordan C and Yudin, Valery A and Strobach, Edward}, + booktitle={AGU Fall Meeting 2019}, + year={2019}, + organization={AGU} +} +@Article{ern_et_al_2018, + AUTHOR = {Ern, M. and Trinh, Q. T. and Preusse, P. and Gille, J. C. and Mlynczak, M. G. and Russell III, J. M. and Riese, M.}, + TITLE = {GRACILE: a comprehensive climatology of atmospheric gravity wave parameters based on satellite limb soundings}, + JOURNAL = {Earth System Science Data}, + VOLUME = {10}, + YEAR = {2018}, + NUMBER = {2}, + PAGES = {857--892}, + URL = {https://www.earth-syst-sci-data.net/10/857/2018/}, + DOI = {10.5194/essd-10-857-2018} +} +@inproceedings{yudin_et_al_2019, + title={Longitudinal Variability of Wave Dynamics in Weather Models Extended into the Mesosphere and Thermosphere}, + author={Yudin V.A. , S. I. Karol, R.A. Akmaev, T. Fuller-Rowell, D. Kleist, A. Kubaryk, and C. Thompson}, + booktitle={Space Weather Workshop}, + year={2019}, +} diff --git a/physics/docs/pdftxt/UGWPv0.txt b/physics/docs/pdftxt/UGWPv0.txt new file mode 100644 index 000000000..da7009b79 --- /dev/null +++ b/physics/docs/pdftxt/UGWPv0.txt @@ -0,0 +1,21 @@ +/** +\page UGWPv0 Unified Gravity Wave Physics Version 0 +\section des_UGWP Description + +Gravity waves (GWs) are generated by a variety of sources in the atmosphere including orographic GWs (OGWs; quasi-stationary waves) and non-orographic GWs (NGWs; non-stationary oscillations). The subgrid scale parameterization scheme for OGWs can be found in Section \ref GFS_GWDPS. This scheme represents the operational version of the subgrid scale orography effects in Version 15 of Global Forecast System (GFS). + +The NGW physics scheme parameterizes the effects of non-stationary subgrid-scale waves in the global atmosphere models extended into the stratosphere, mesosphere, and thermosphere. These non-stationary oscillations with periods bounded by Coriolis and Brunt-Väisälä frequencies and typical horizontal scales from tens to several hundreds of kilometers are forced by the imbalance of convective and frontal/jet dynamics in the troposphere and lower stratosphere (Fritts 1984 \cite fritts_1984; Alexander et al. 2010 \cite alexander_et_al_2010; Plougonven and Zhang 2014 \cite plougonven_and_zhang_2014). The NGWs propagate upwards and the amplitudes exponentially grow with altitude until instability and breaking of waves occur. Convective and dynamical instability induced by GWs with large amplitudes can trigger production of small-scale turbulence and self-destruction of waves. The latter process in the theory of atmospheric GWs is frequently referred as the wave saturation (Lindzen 1981 \cite lindzen_1981; Weinstock 1984 \cite weinstock_1984; Fritts 1984 \cite fritts_1984). Herein, “saturation” or "breaking" refers to any processes that act to reduce wave amplitudes due to instabilities and/or interactions arising from large-amplitude perturbations limiting the exponential growth of GWs with height. Background dissipation processes such as molecular diffusion and radiative cooling, in contrast, act independently of GW amplitudes. In the middle atmosphere, impacts of NGW saturation (or breaking) and dissipation on the large-scale circulation, mixing, and transport have been acknowledged in the physics of global weather and climate models after pioneering studies by Lindzen 1981 \cite lindzen_1981 and Holton 1983 \cite holton_1983. Comprehensive reviews on the physics of NGWs and OGWs in the climate research and weather forecasting highlighted the variety of parameterization schemes for NGWs （Alexander et al. 2010 \cite alexander_et_al_2010; Geller et al. 2013 \cite geller_et_al_2013; Garcia et al. 2017 \cite garcia_et_al_2017). They are formulated using different aspects of the nonlinear and linear propagation, instability, breaking and dissipation of waves along with different specifications of GW sources (Garcia et al. 2007 \cite garcia_et_al_2007; Richter et al 2010 \cite richter_et_al_2010; Eckermann et al. 2009 \cite eckermann_et_al_2009; Eckermann 2011 \cite eckermann_2011; Lott et al. 2012 \cite lott_et_al_2012). + +The current operational GFS physics parameterizes effects of stationary OGWs and convective GWs, neglecting the impacts of non-stationary subgrid scale GW physics. This leads to well-known shortcomings in the global model predictions in the stratosphere and upper atmosphere (Alexander et al. 2010 \cite alexander_et_al_2010; Geller et al. 2013). In order to describe the effects of unresolved GWs by dynamical cores in global forecast models, subgrid scales physics of stationary and non-stationary GWs needs to be implemented in the self-consistent manner under the Unified Gravity Wave Physics (UGWP) framework. + +The concept of UGWP and the related programming architecture implemented in FV3GFS was first proposed by CU-CIRES, NOAA Space Weather Prediction Center (SWPC) and Environmental Modeling Center (EMC) for the Unified Forecast System (UFS) with variable positions of the model top lids (Alpert et al. 2019 \cite alpert_et_al_2019; Yudin et al. 2016 \cite yudin_et_al_2016; Yudin et al. 2018 \cite yudin_et_al_2018). As above, the UGWP considers identical GW propagation solvers for OGWs and NGWs with different approaches for specification of subgrid wave sources. The current set of the input and control parameters for UGWP version 0 (UGWP-v0) can select different options for GW effects including momentum deposition (also called GW drag), heat deposition, and mixing by eddy viscosity, conductivity and diffusion. The input GW parameters can control the number of directional azimuths in which waves can propagate, number of waves in single direction, and the interface model layer from the surface at which NGWs can be launched. Among the input parameters, the GW efficiency factors reflect intermittency of wave excitation. They can vary with horizontal resolutions, reflecting capability of the FV3 dynamical core to resolve mesoscale wave activity with the enhancement of model resolution. The prescribed distributions for vertical momentum flux (VMF) of NGWs have been employed in the global forecast models of NWP centers and reanalysis projects to ease tuning of GW schemes to the climatology of the middle atmosphere dynamics in the absence of the global wind data above about 35 km (Eckermann et al. 2009 \cite eckermann_et_al_2009; Molod et al. 2015 \cite molod_et_al_2015). These distributions of VMF qualitatively describe the general features of the latitudinal and seasonal variations of the global GW activity in the lower stratosphere, observed from the ground and space (Ern et al. 2018 \cite ern_et_al_2018). For the long-term climate projections, global models seek to establish communication between model physics and dynamics. This provides variable in time and space excitation of subgrid GWs under year-to-year variations of solar input and anthropogenic emissions (Richter et al 2010 \cite richter_et_al_2010; 2014 \cite richter_et_al_2014). + +Note that in the first release of UGWP (UGWP-v0), the momentum and heat deposition due to GW breaking and dissipation have been tested in the multi-year simulations and medium-range forecasts using FV3GFS-L127 configuration with top lid at about 80 km. In addition, the eddy mixing effects induced by instability of GWs are not activated in this version. Along with the GW heat and momentum depositions, GW eddy mixing is an important element of the Whole Atmosphere Model (WAM) physics, as shown in WAM simulations with the spectral dynamics (Yudin et al. 2018 \cite yudin_et_al_2018). The additional impact of eddy mixing effects in the middle and upper atmosphere need to be further tested, evaluated, and orchestrated with the subgrid turbulent diffusion of the GFS physics (work in progress). In UFS, the WAM with FV3 dynamics (FV3-WAM) will represent the global atmosphere model configuration extended into the thermosphere (top lid at ~600 km). In the mesosphere and thermosphere, the background attenuation of subgrid waves due to molecular and turbulent diffusion, radiative damping and ion drag will be the additional mechanism of NGW and OGW dissipation along with convective and dynamical instability of waves described by the linear (Lindzen 1981 \cite lindzen_1981) and nonlinear (Weinstock 1984 \cite weinstock_1984; Hines 1997 \cite hines_1997) saturation theories. + +\section intra_UGWPv0 Intraphysics Communication +\ref arg_table_cires_ugwp_run + +\section gen_al_ugwpv0 General Algorithm +\ref cires_ugwp_run + +*/ diff --git a/physics/docs/pdftxt/all_shemes_list.txt b/physics/docs/pdftxt/all_shemes_list.txt index 702c22256..789480cd8 100644 --- a/physics/docs/pdftxt/all_shemes_list.txt +++ b/physics/docs/pdftxt/all_shemes_list.txt @@ -44,6 +44,7 @@ parameterizations in suites. - \b Gravity \b Wave \b Drag - \subpage GFS_GWDPS - \subpage GFS_GWDC + - \subpage UGWPv0 - \b Surface \b Layer \b and \b Simplified \b Ocean \b and \b Sea \b Ice \b Representation - \subpage GFS_SFCLYR diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 52375dd18..9c5421bdb 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -258,6 +258,10 @@ end subroutine cires_ugwp_driver_v0 !ugwp-v0 subroutines: GWDPS_V0 and fv3_ugwp_solv2_v0 ! !===================================================================== +!>\ingroup cires_ugwp_run +!> @{ +!!Note for the sub-grid scale orography scheme in UGWP-v0: Due to degraded forecast scores of simulations with revised schemes for subgrid-scale orography effects in FV3GFS, EMC reinstalled the original gwdps-code with updated efficiency factors for the mountain blocking and OGW drag. The GFS OGW is described in the separate section (\ref GFS_GWDPS) and its “call” moved into UGWP-driver subroutine. This combination of NGW and OGW schemes was tested in the FV3GFS-L127 medium-range forecasts (15-30 days) for C96, C192, C384 and C768 resolutions and work in progress to introduce the optimal choice for the scale-aware representations of the efficiency factors that will reflect the better simulations of GW activity by FV3 dynamical core at higher horizontal resolutions. With the MERRA-2 VMF function for NGWs (\ref slat_geos5_tamp) and operational OGW drag scheme (\ref GFS_GWDPS), FV3GFS simulations can successfully forecast the recent major mid-winter sudden stratospheric warming (SSW) events of 2018-02-12 and 2018-12-31 (10-14 days before the SSW onset; Yudin et al. 2019 \cite yudin_et_al_2019). The first multi-year (2015-2018) FV3GFS simulations with UGWP-v0 also produce the equatorial QBO-like oscillations in the zonal wind and temperature anomalies. +!! SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, & Pdvdt, Pdudt, Pdtdt, Pkdis, U1,V1,T1,Q1,KPBL, & PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DTP,KDT, @@ -1248,7 +1252,9 @@ end subroutine gwdps_v0 ! !23456============================================================================== - +!>\ingroup cires_ugwp_run +!> @{ +!! subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, & tm1 , um1, vm1, qm1, & prsl, prsi, philg, xlatd, sinlat, coslat, From b93c035988c8e2f6c5f0cfaf1ea46632a0710547 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 14 Nov 2019 16:07:43 -0700 Subject: [PATCH 32/84] GFS_surface_composites.F90: apply missing change for fv3atm pr8 --- physics/GFS_surface_composites.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index cd5f3db11..9636eb384 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -123,7 +123,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 From f76a23d2238c59a843a266bf4da5eab4ba9b9b8f Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 15 Nov 2019 11:08:14 -0700 Subject: [PATCH 33/84] tentatively fixed gfortran compilation error in ugwp_driver_v0.F --- physics/ugwp_driver_v0.F | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 52375dd18..7f5490d24 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -1993,8 +1993,8 @@ subroutine edmix_ugwp_v0(im, levs, dtp, Km(1:levs) = ksum(1:levs) * rho(1:levs)* rho(1:levs) do j=1, nstab - call diff_1d_wtend(levs, dtstab, Fw, Fw1, levs, - & del(i,:), Sw, Sw1) + call diff_1d_wtend(levs, dtstab, Fw, Fw1, Km, + & rdp, rdpm, Sw, Sw1) Fw = Sw Fw1 = Sw1 enddo @@ -2006,7 +2006,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, Kpt = Km*iPr_pt Fw(1:levs) = pdTdt(i, 1:levs)*Ptmap(1:levs) do j=1, nstab - call diff_1d_ptend(levs, dtstab, Fw, Kpt, del(i,:), Sw) + call diff_1d_ptend(levs, dtstab, Fw, Kpt, rdp, rdpm, Sw) Fw = Sw enddo ed_dtdt(i,1:levs) = Sw(1:levs)/Ptmap(1:levs) From 8300bfaaf869581760579908fb791c136cbc4395 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 18 Nov 2019 14:28:14 -0700 Subject: [PATCH 34/84] physics/GFS_SCNV_generic.*, physics/samfshalcnv.*: remove module samfshalcnv_post, add code to GFS_SCNV_generic_post instead --- physics/GFS_SCNV_generic.F90 | 39 +++++++- physics/GFS_SCNV_generic.meta | 128 +++++++++++++++++++++++++ physics/samfshalcnv.f | 74 --------------- physics/samfshalcnv.meta | 169 ---------------------------------- 4 files changed, 166 insertions(+), 244 deletions(-) diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 9e70fda76..0cb1ac06f 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -68,7 +68,10 @@ end subroutine GFS_SCNV_generic_post_finalize !! \htmlinclude GFS_SCNV_generic_post_run.html !! subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, cplchm, & - frain, gt0, gq0_water_vapor, save_t, save_qv, dqdti, dt3dt, dq3dt, clw, errmsg, errflg) + frain, gt0, gq0_water_vapor, save_t, save_qv, dqdti, dt3dt, dq3dt, clw, & + shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, & + rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & + imfshalcnv, imfshalcnv_sas, imfshalcnv_samf, errmsg, errflg) use machine, only: kind_phys @@ -85,6 +88,19 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, cplchm, & real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, dq3dt real(kind=kind_phys), dimension(im,levs,nn), intent(inout) :: clw + ! Post code for SAS/SAMF + integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d + logical, intent(in) :: shcnvcw + real(kind=kind_phys), dimension(im), intent(in) :: rain1 + real(kind=kind_phys), dimension(im,levs), intent(in) :: cnvw, cnvc + real(kind=kind_phys), dimension(im), intent(inout) :: rainc, cnvprcp, cnvprcpb + ! The following arrays may not be allocated, depending on certain flags and microphysics schemes. + ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, + ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays + ! as long as these do not get used when not allocated. + real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d + integer, intent(in) :: imfshalcnv, imfshalcnv_sas, imfshalcnv_samf + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -95,6 +111,27 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, cplchm, & errmsg = '' errflg = 0 + if (imfshalcnv==imfshalcnv_sas .or. imfshalcnv==imfshalcnv_samf) then + do i=1,im + rainc(i) = rainc(i) + frain * rain1(i) + enddo +! 'cnvw' and 'cnvc' are set to zero before computation starts: + if (shcnvcw .and. num_p3d == 4 .and. npdf3d == 3) then + do k=1,levs + do i=1,im + cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) + cnvc_phy_f3d(i,k) = cnvc_phy_f3d(i,k) + cnvc(i,k) + enddo + enddo + elseif (npdf3d == 0 .and. ncnvcld3d == 1) then + do k=1,levs + do i=1,im + cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) + enddo + enddo + endif + endif + if (lssav) then if (ldiag3d) then do k=1,levs diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index a2763e4bb..79f4eab11 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -212,6 +212,134 @@ kind = kind_phys intent = inout optional = F +[shcnvcw] + standard_name = flag_shallow_convective_cloud + long_name = flag for shallow convective cloud + units = + dimensions = () + type = logical + intent = in + optional = F +[rain1] + standard_name = lwe_thickness_of_shallow_convective_precipitation_amount + long_name = shallow convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_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 + units = count + dimensions = () + type = integer + intent = in + optional = F +[num_p3d] + standard_name = array_dimension_of_3d_arrays_for_microphysics + long_name = number of 3D arrays needed for microphysics + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnvcld3d] + standard_name = number_of_convective_3d_cloud_fields + long_name = number of convective 3d clouds fields + units = count + dimensions = () + type = integer + intent = in + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rainc] + standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep + long_name = convective rain at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvprcp] + standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount + long_name = cumulative convective precipitation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvprcpb] + standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket + long_name = cumulative convective precipitation in bucket + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvw_phy_f3d] + standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d + long_name = convective cloud water mixing ratio in the phy_f3d array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc_phy_f3d] + standard_name = convective_cloud_cover_in_phy_f3d + long_name = convective cloud cover in the phy_f3d array + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_sas] + standard_name = flag_for_sas_shallow_convection_scheme + long_name = flag for SAS shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_samf] + standard_name = flag_for_samf_shallow_convection_scheme + long_name = flag for SAMF shallow convection scheme + units = flag + 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/samfshalcnv.f b/physics/samfshalcnv.f index 51b64adfe..ed80a2f54 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -1811,77 +1811,3 @@ end subroutine samfshalcnv_run !! @} end module samfshalcnv -!> This module contains the CCPP-compliant scale-aware mass-flux shallow convection -!! post interstitial codes. - module samfshalcnv_post - contains - -!! \section arg_table_samfshalcnv_post_run Argument Table -!! \htmlinclude samfshalcnv_post_run.html -!! - subroutine samfshalcnv_post_run (im, levs, lssav, shcnvcw, frain, - & rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, - & rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, - & errmsg, errflg) - - use machine, only: kind_phys - - implicit none -! - integer, intent(in) :: im, levs - integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d - logical, intent(in) :: lssav, shcnvcw - real(kind=kind_phys), intent(in) :: frain - real(kind=kind_phys), dimension(im), intent(in) :: rain1 - real(kind=kind_phys), dimension(im,levs), intent(in) :: cnvw, - & cnvc - - real(kind=kind_phys), dimension(im), intent(inout) :: rainc, - & cnvprcp, cnvprcpb - ! The following arrays may not be allocated, depending on certain flags and microphysics schemes. - ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, - ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays - ! as long as these do not get used when not allocated. - real(kind=kind_phys), dimension(:,:), intent(inout) :: - & cnvw_phy_f3d, cnvc_phy_f3d - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: i, k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - do i=1,im - rainc(i) = rainc(i) + frain * rain1(i) - enddo -! in mfshalcnv, 'cnvw' and 'cnvc' are set to zero before computation starts: - if (shcnvcw .and. num_p3d == 4 .and. npdf3d == 3) then - do k=1,levs - do i=1,im - cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) - cnvc_phy_f3d(i,k) = cnvc_phy_f3d(i,k) + cnvc(i,k) - enddo - enddo - elseif (npdf3d == 0 .and. ncnvcld3d == 1) then - do k=1,levs - do i=1,im - cnvw_phy_f3d(i,k) = cnvw_phy_f3d(i,k) + cnvw(i,k) - enddo - enddo - endif - end subroutine samfshalcnv_post_run - -!! \section arg_table_sasas_shal_post_init Argument Table -!! - subroutine samfshalcnv_post_init () - end subroutine samfshalcnv_post_init - -!! \section arg_table_sasas_shal_post_finalize Argument Table -!! - subroutine samfshalcnv_post_finalize () - end subroutine samfshalcnv_post_finalize - - end module samfshalcnv_post diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index 2dd3be372..5189afd95 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -439,172 +439,3 @@ type = integer intent = out optional = F - -######################################################################## -[ccpp-arg-table] - name = samfshalcnv_post_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 -[lssav] - standard_name = flag_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - type = logical - intent = in - optional = F -[shcnvcw] - standard_name = flag_shallow_convective_cloud - long_name = flag for shallow convective cloud - units = - dimensions = () - type = logical - intent = in - optional = F -[frain] - standard_name = dynamics_to_physics_timestep_ratio - long_name = ratio of dynamics timestep to physics timestep - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[rain1] - standard_name = lwe_thickness_of_shallow_convective_precipitation_amount - long_name = shallow convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_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 - units = count - dimensions = () - type = integer - intent = in - optional = F -[num_p3d] - standard_name = array_dimension_of_3d_arrays_for_microphysics - long_name = number of 3D arrays needed for microphysics - units = count - dimensions = () - type = integer - intent = in - optional = F -[ncnvcld3d] - standard_name = number_of_convective_3d_cloud_fields - long_name = number of convective 3d clouds fields - units = count - dimensions = () - type = integer - intent = in - optional = F -[cnvc] - standard_name = convective_cloud_cover - long_name = convective cloud cover - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[cnvw] - standard_name = convective_cloud_water_mixing_ratio - long_name = moist convective cloud water mixing ratio - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[rainc] - standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep - long_name = convective rain at this time step - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cnvprcp] - standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount - long_name = cumulative convective precipitation - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cnvprcpb] - standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket - long_name = cumulative convective precipitation in bucket - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cnvw_phy_f3d] - standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d - long_name = convective cloud water mixing ratio in the phy_f3d array - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cnvc_phy_f3d] - standard_name = convective_cloud_cover_in_phy_f3d - long_name = convective cloud cover in the phy_f3d array - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - 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 - -######################################################################## -[ccpp-arg-table] - name = sasas_shal_post_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = sasas_shal_post_finalize - type = scheme From 3bec6c56ba6d9203e15a7508fec67304995e750e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 18 Nov 2019 14:29:24 -0700 Subject: [PATCH 35/84] physics/satmedmfvdif.*, physics/tridi.f: move subroutine tridit to tridi.f; add guard to satmedmfvdif_init that checks for isatmedmf=0 --- physics/satmedmfvdif.F | 86 ++++++++++----------------------------- physics/satmedmfvdif.meta | 38 +++++++++++++++++ physics/tridi.f | 70 +++++++++++++++++++++++++++++-- 3 files changed, 127 insertions(+), 67 deletions(-) diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index 4b308dd55..5900349e9 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -4,9 +4,30 @@ !! eddy-diffusion mass-flux (TKE-EDMF) parameterization (by Jongil Han). module satmedmfvdif + contains - subroutine satmedmfvdif_init () +!> \section arg_table_satmedmfvdif_init Argument Table +!! \htmlinclude satmedmfvdif_init.html +!! + subroutine satmedmfvdif_init (isatmedmf,isatmedmf_vdif, + & errmsg,errflg) + + integer, intent(in) :: isatmedmf,isatmedmf_vdif + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. isatmedmf==isatmedmf_vdif) then + write(errmsg,fmt='(*(a))') 'Logic error: satmedmfvdif is ', + & 'called, but isatmedmf/=isatmedmf_vdif.' + errflg = 1 + return + end if + end subroutine satmedmfvdif_init subroutine satmedmfvdif_finalize () @@ -1485,68 +1506,5 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & return end subroutine satmedmfvdif_run !> @} -! -!----------------------------------------------------------------------- -!----------------------------------------------------------------------- -!>\ingroup satmedmf -!! This subroutine solves tridiagonal problem for TKE. - subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) -!----------------------------------------------------------------------- -!! - use machine , only : kind_phys - implicit none - integer is,k,kk,n,nt,l,i - real(kind=kind_phys) fk(l) -!! - real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & - & rt(l,n*nt), & - & au(l,n-1), at(l,n*nt), & - & fkk(l,2:n-1) -!----------------------------------------------------------------------- - do i=1,l - fk(i) = 1./cm(i,1) - au(i,1) = fk(i)*cu(i,1) - enddo - do k = 1, nt - is = (k-1) * n - do i = 1, l - at(i,1+is) = fk(i) * rt(i,1+is) - enddo - enddo - do k=2,n-1 - do i=1,l - fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) - au(i,k) = fkk(i,k)*cu(i,k) - enddo - enddo - do kk = 1, nt - is = (kk-1) * n - do k=2,n-1 - do i=1,l - at(i,k+is) = fkk(i,k)*(rt(i,k+is)-cl(i,k)*at(i,k+is-1)) - enddo - enddo - enddo - do i=1,l - fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) - enddo - do k = 1, nt - is = (k-1) * n - do i = 1, l - at(i,n+is) = fk(i)*(rt(i,n+is)-cl(i,n)*at(i,n+is-1)) - enddo - enddo - do kk = 1, nt - is = (kk-1) * n - do k=n-1,1,-1 - do i=1,l - at(i,k+is) = at(i,k+is) - au(i,k)*at(i,k+is+1) - enddo - enddo - enddo -!----------------------------------------------------------------------- - return - end subroutine tridit -!> @} end module satmedmfvdif diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 7f21e58e1..63480e01b 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -1,3 +1,41 @@ +[ccpp-arg-table] + name = satmedmfvdif_init + type = scheme +[isatmedmf] + standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of scale-aware TKE moist EDMF PBL scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[isatmedmf_vdif] + standard_name = choice_of_original_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of original scale-aware TKE moist EDMF PBL scheme + units = none + 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 = satmedmfvdif_run type = scheme diff --git a/physics/tridi.f b/physics/tridi.f index 5ffcc4686..22a35ea9c 100644 --- a/physics/tridi.f +++ b/physics/tridi.f @@ -38,7 +38,9 @@ subroutine tridi1(l,n,cl,cm,cu,r1,au,a1) enddo ! return - end + end subroutine tridi1 + +c----------------------------------------------------------------------- !>\ingroup satmedmf !> This subroutine .. subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) @@ -78,7 +80,7 @@ subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) enddo c----------------------------------------------------------------------- return - end + end subroutine tridi2 c----------------------------------------------------------------------- !>\ingroup satmedmf @@ -148,4 +150,66 @@ subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) enddo c----------------------------------------------------------------------- return - end + end subroutine tridin + +c----------------------------------------------------------------------- +!>\ingroup satmedmf +!! This subroutine solves tridiagonal problem for TKE. + subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) +!----------------------------------------------------------------------- +!! + use machine , only : kind_phys + implicit none + integer is,k,kk,n,nt,l,i + real(kind=kind_phys) fk(l) +!! + real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & + & rt(l,n*nt), & + & au(l,n-1), at(l,n*nt), & + & fkk(l,2:n-1) +!----------------------------------------------------------------------- + do i=1,l + fk(i) = 1./cm(i,1) + au(i,1) = fk(i)*cu(i,1) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + at(i,1+is) = fk(i) * rt(i,1+is) + enddo + enddo + do k=2,n-1 + do i=1,l + fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fkk(i,k)*cu(i,k) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=2,n-1 + do i=1,l + at(i,k+is) = fkk(i,k)*(rt(i,k+is)-cl(i,k)*at(i,k+is-1)) + enddo + enddo + enddo + do i=1,l + fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + at(i,n+is) = fk(i)*(rt(i,n+is)-cl(i,n)*at(i,n+is-1)) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=n-1,1,-1 + do i=1,l + at(i,k+is) = at(i,k+is) - au(i,k)*at(i,k+is+1) + enddo + enddo + enddo +!----------------------------------------------------------------------- + return + end subroutine tridit +!> @} From e45cb37b1cc4957ab98509685bc248e0b7f5dfd1 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 18 Nov 2019 14:30:42 -0700 Subject: [PATCH 36/84] physics/satmedmfvdifq.* physics/mfpbltq.f physics/mfscuq.f: add satmedmfvdifq (updated version of satmedmfvdif) and dependencies --- physics/mfpbltq.f | 453 ++++++++++++ physics/mfscuq.f | 550 ++++++++++++++ physics/satmedmfvdifq.F | 1416 ++++++++++++++++++++++++++++++++++++ physics/satmedmfvdifq.meta | 597 +++++++++++++++ 4 files changed, 3016 insertions(+) create mode 100644 physics/mfpbltq.f create mode 100644 physics/mfscuq.f create mode 100644 physics/satmedmfvdifq.F create mode 100644 physics/satmedmfvdifq.meta diff --git a/physics/mfpbltq.f b/physics/mfpbltq.f new file mode 100644 index 000000000..1a267370a --- /dev/null +++ b/physics/mfpbltq.f @@ -0,0 +1,453 @@ +!>\file mfpbltq.f +!! This file contains the subroutine that calculates mass flux and +!! updraft parcel properties for thermals driven by surface heating +!! for use in the TKE-EDMF PBL scheme (HAFS version). + +!>\ingroup satmedmfq +!! This subroutine computes mass flux and updraft parcel properties for +!! thermals driven by surface heating. +!!\section mfpbltq_gen GFS mfpblt General Algorithm +!> @{ + subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt, + & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, + & gdx,hpbl,kpbl,vpert,buo,xmf, + & tcko,qcko,ucko,vcko,xlamue,a1) +! + use machine , only : kind_phys + use funcphys , only : fpvs + use physcons, grav => con_g, cp => con_cp + &, rv => con_rv, hvap => con_hvap + &, fv => con_fvirt + &, eps => con_eps, epsm1 => con_epsm1 +! + implicit none +! + integer im, ix, km, kmpbl, ntcw, ntrac1 +! &, me + integer kpbl(im) + logical cnvflg(im) + real(kind=kind_phys) delt + real(kind=kind_phys) q1(ix,km,ntrac1), + & t1(ix,km), u1(ix,km), v1(ix,km), + & plyr(im,km),pix(im,km),thlx(im,km), + & thvx(im,km),zl(im,km), zm(im,km), + & gdx(im), hpbl(im), vpert(im), + & buo(im,km), xmf(im,km), + & tcko(im,km),qcko(im,km,ntrac1), + & ucko(im,km),vcko(im,km), + & xlamue(im,km-1) +! +c local variables and arrays +! + integer i, j, k, n, ndc +! + real(kind=kind_phys) dt2, dz, ce0, cm, + & factor, gocp, + & g, b1, f1, + & bb1, bb2, + & a1, pgcon, + & qmin, qlmin, xmmx, rbint, + & tem, tem1, tem2, + & ptem, ptem1, ptem2 +! + real(kind=kind_phys) elocp, el2orc, qs, es, + & tlu, gamma, qlu, + & thup, thvu, dq +! + real(kind=kind_phys) rbdn(im), rbup(im), xlamuem(im,km-1) + real(kind=kind_phys) delz(im), xlamax(im) +! + real(kind=kind_phys) wu2(im,km), thlu(im,km), + & qtx(im,km), qtu(im,km) +! + real(kind=kind_phys) xlamavg(im), sigma(im), + & scaldfunc(im), sumx(im) +! + logical totflg, flg(im) +! +! physical parameters + parameter(g=grav) + parameter(gocp=g/cp) + parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) + parameter(ce0=0.4,cm=1.0) + parameter(qmin=1.e-8,qlmin=1.e-12) + parameter(pgcon=0.55) + parameter(b1=0.5,f1=0.15) +! +!************************************************************************ +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! + dt2 = delt +! + do k = 1, km + do i=1,im + if (cnvflg(i)) then + buo(i,k) = 0. + wu2(i,k) = 0. + qtx(i,k) = q1(i,k,1) + q1(i,k,ntcw) + endif + enddo + enddo +! +!> - Compute thermal excess +! + do i=1,im + if(cnvflg(i)) then + thlu(i,1)= thlx(i,1) + vpert(i) + qtu(i,1) = qtx(i,1) + buo(i,1) = g * vpert(i) / thvx(i,1) + endif + enddo +! +!> - Compute entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = kpbl(i) / 2 + k = max(k, 1) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmpbl + do i=1,im + if(cnvflg(i)) then + if(k < kpbl(i)) then + ptem = 1./(zm(i,k)+delz(i)) + tem = max((hpbl(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamue(i,k) = ce0 * (ptem+ptem1) + else + xlamue(i,k) = xlamax(i) + endif +! + xlamuem(i,k) = cm * xlamue(i,k) + endif + enddo + enddo +! +!> - Compute buoyancy for updraft air parcel +! + do k = 2, kmpbl + do i=1,im + if(cnvflg(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + thlu(i,k) = ((1.-tem)*thlu(i,k-1)+tem* + & (thlx(i,k-1)+thlx(i,k)))/factor + qtu(i,k) = ((1.-tem)*qtu(i,k-1)+tem* + & (qtx(i,k-1)+qtx(i,k)))/factor +! + tlu = thlu(i,k) / pix(i,k) + es = 0.01 * fpvs(tlu) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtu(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tlu**2) + qlu = dq / (1. + gamma) + qtu(i,k) = qs + qlu + tem1 = 1. + fv * qs - qlu + thup = thlu(i,k) + pix(i,k) * elocp * qlu + thvu = thup * tem1 + else + tem1 = 1. + fv * qtu(i,k) + thvu = thlu(i,k) * tem1 + endif + buo(i,k) = g * (thvu / thvx(i,k) - 1.) +! + endif + enddo + enddo +! +!> - Compute updraft velocity square(wu2, eqn 13 in +!! Han et al.(2019) \cite Han_2019) +! +! tem = 1.-2.*f1 +! bb1 = 2. * b1 / tem +! bb2 = 2. / tem +! from Soares et al. (2004,QJRMS) +! bb1 = 2. +! bb2 = 4. +! +! from Bretherton et al. (2004, MWR) +! bb1 = 4. +! bb2 = 2. +! +! from our tuning + bb1 = 2.0 + bb2 = 4.0 +! + do i = 1, im + if(cnvflg(i)) then + dz = zm(i,1) + tem = 0.5*bb1*xlamue(i,1)*dz + tem1 = bb2 * buo(i,1) * dz + ptem1 = 1. + tem + wu2(i,1) = tem1 / ptem1 + endif + enddo + do k = 2, kmpbl + do i = 1, im + if(cnvflg(i)) then + dz = zm(i,k) - zm(i,k-1) + tem = 0.25*bb1*(xlamue(i,k)+xlamue(i,k-1))*dz + tem1 = bb2 * buo(i,k) * dz + ptem = (1. - tem) * wu2(i,k-1) + ptem1 = 1. + tem + wu2(i,k) = (ptem + tem1) / ptem1 + endif + enddo + enddo +! +!> - Update pbl height as the height where updraft velocity vanishes +! + do i=1,im + flg(i) = .true. + if(cnvflg(i)) then + flg(i) = .false. + rbup(i) = wu2(i,1) + endif + enddo + do k = 2, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + rbup(i) = wu2(i,k) + kpbl(i)= k + flg(i) = rbup(i).le.0. + endif + enddo + enddo + do i = 1,im + if(cnvflg(i)) then + k = kpbl(i) + if(rbdn(i) <= 0.) then + rbint = 0. + elseif(rbup(i) >= 0.) then + rbint = 1. + else + rbint = rbdn(i)/(rbdn(i)-rbup(i)) + endif + hpbl(i) = zm(i,k-1) + rbint*(zm(i,k)-zm(i,k-1)) + endif + enddo +! +!> - Update entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = kpbl(i) / 2 + k = max(k, 1) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmpbl + do i=1,im + if(cnvflg(i)) then + if(k < kpbl(i)) then + ptem = 1./(zm(i,k)+delz(i)) + tem = max((hpbl(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamue(i,k) = ce0 * (ptem+ptem1) + else + xlamue(i,k) = xlamax(i) + endif +! + xlamuem(i,k) = cm * xlamue(i,k) + endif + enddo + enddo +! +!> - Compute entrainment rate averaged over the whole pbl +! + do i = 1, im + xlamavg(i) = 0. + sumx(i) = 0. + enddo + do k = 1, kmpbl + do i = 1, im + if (cnvflg(i) .and. k < kpbl(i)) then + dz = zl(i,k+1) - zl(i,k) + xlamavg(i) = xlamavg(i) + xlamue(i,k) * dz + sumx(i) = sumx(i) + dz + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + xlamavg(i) = xlamavg(i) / sumx(i) + endif + enddo +! +!> - Updraft mass flux as a function of updraft velocity profile +! + do k = 1, kmpbl + do i = 1, im + if (cnvflg(i) .and. k < kpbl(i)) then + xmf(i,k) = a1 * sqrt(wu2(i,k)) + endif + enddo + enddo +! +!> - Compute updraft fraction as a function of mean entrainment rate +!!(Grell and Freitas (2014) \cite grell_and_freitas_2014 +! + do i = 1, im + if(cnvflg(i)) then + tem = 0.2 / xlamavg(i) + tem1 = 3.14 * tem * tem + sigma(i) = tem1 / (gdx(i) * gdx(i)) + sigma(i) = max(sigma(i), 0.001) + sigma(i) = min(sigma(i), 0.999) + endif + enddo +! +!> - Compute scale-aware function based on +!! Arakawa and Wu (2013) \cite arakawa_and_wu_2013 +! + do i = 1, im + if(cnvflg(i)) then + if (sigma(i) > a1) then + scaldfunc(i) = (1.-sigma(i)) * (1.-sigma(i)) + scaldfunc(i) = max(min(scaldfunc(i), 1.0), 0.) + else + scaldfunc(i) = 1.0 + endif + endif + enddo +! +!> - Final scale-aware updraft mass flux +! + do k = 1, kmpbl + do i = 1, im + if (cnvflg(i) .and. k < kpbl(i)) then + xmf(i,k) = scaldfunc(i) * xmf(i,k) + dz = zl(i,k+1) - zl(i,k) + xmmx = dz / dt2 + xmf(i,k) = min(xmf(i,k),xmmx) + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> - Compute updraft property using updated entranment rate +! + do i=1,im + if(cnvflg(i)) then + thlu(i,1)= thlx(i,1) + endif + enddo +! +! do i=1,im +! if(cnvflg(i)) then +! ptem1 = max(qcko(i,1,ntcw), 0.) +! tlu = thlu(i,1) / pix(i,1) +! tcko(i,1) = tlu + elocp * ptem1 +! endif +! enddo +! + do k = 2, kmpbl + do i=1,im + if(cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + thlu(i,k) = ((1.-tem)*thlu(i,k-1)+tem* + & (thlx(i,k-1)+thlx(i,k)))/factor + qtu(i,k) = ((1.-tem)*qtu(i,k-1)+tem* + & (qtx(i,k-1)+qtx(i,k)))/factor +! + tlu = thlu(i,k) / pix(i,k) + es = 0.01 * fpvs(tlu) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtu(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tlu**2) + qlu = dq / (1. + gamma) + qtu(i,k) = qs + qlu + qcko(i,k,1) = qs + qcko(i,k,ntcw) = qlu + tcko(i,k) = tlu + elocp * qlu + else + qcko(i,k,1) = qtu(i,k) + qcko(i,k,ntcw) = 0. + tcko(i,k) = tlu + endif +! + endif + enddo + enddo +! + do k = 2, kmpbl + do i = 1, im + if (cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamuem(i,k-1) * dz + factor = 1. + tem + ptem = tem + pgcon + ptem1= tem - pgcon + ucko(i,k) = ((1.-tem)*ucko(i,k-1)+ptem*u1(i,k) + & +ptem1*u1(i,k-1))/factor + vcko(i,k) = ((1.-tem)*vcko(i,k-1)+ptem*v1(i,k) + & +ptem1*v1(i,k-1))/factor + endif + enddo + enddo +! + if(ntcw > 2) then +! + do n = 2, ntcw-1 + do k = 2, kmpbl + do i = 1, im + if (cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + qcko(i,k,n) = ((1.-tem)*qcko(i,k-1,n)+tem* + & (q1(i,k,n)+q1(i,k-1,n)))/factor + endif + enddo + enddo + enddo +! + endif +! + ndc = ntrac1 - ntcw +! + if(ndc > 0) then +! + do n = ntcw+1, ntrac1 + do k = 2, kmpbl + do i = 1, im + if (cnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem +! + qcko(i,k,n) = ((1.-tem)*qcko(i,k-1,n)+tem* + & (q1(i,k,n)+q1(i,k-1,n)))/factor + endif + enddo + enddo + enddo +! + endif +! + return + end +!> @} diff --git a/physics/mfscuq.f b/physics/mfscuq.f new file mode 100644 index 000000000..ba35cde9f --- /dev/null +++ b/physics/mfscuq.f @@ -0,0 +1,550 @@ +!>\file mfscuq.f +!! This file contains the mass flux and downdraft parcel preperties +!! parameterization for stratocumulus-top-driven turbulence (HAFS version). + +!>\ingroup satmedmfq +!! This subroutine computes mass flux and downdraft parcel properties +!! for stratocumulus-top-driven turbulence. +!! \section mfscuq GFS mfscu General Algorithm +!> @{ + subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt, + & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix, + & thlx,thvx,thlvx,gdx,thetae, + & krad,mrad,radmin,buo,xmfd, + & tcdo,qcdo,ucdo,vcdo,xlamde,a1) +! + use machine , only : kind_phys + use funcphys , only : fpvs + use physcons, grav => con_g, cp => con_cp + &, rv => con_rv, hvap => con_hvap + &, fv => con_fvirt + &, eps => con_eps, epsm1 => con_epsm1 +! + implicit none +! + integer im, ix, km, kmscu, ntcw, ntrac1 +! &, me + integer krad(im), mrad(im) +! + logical cnvflg(im) + real(kind=kind_phys) delt + real(kind=kind_phys) q1(ix,km,ntrac1),t1(ix,km), + & u1(ix,km), v1(ix,km), + & plyr(im,km), pix(im,km), + & thlx(im,km), + & thvx(im,km), thlvx(im,km), + & gdx(im), + & zl(im,km), zm(im,km), + & thetae(im,km), radmin(im), + & buo(im,km), xmfd(im,km), + & tcdo(im,km), qcdo(im,km,ntrac1), + & ucdo(im,km), vcdo(im,km), + & xlamde(im,km-1) +! +! local variables and arrays +! +! + integer i,j,indx, k, n, kk, ndc + integer krad1(im) +! + real(kind=kind_phys) dt2, dz, ce0, cm, + & gocp, factor, g, tau, + & b1, f1, bb1, bb2, + & a1, a2, + & cteit, pgcon, + & qmin, qlmin, + & xmmx, tem, tem1, tem2, + & ptem, ptem1, ptem2 +! + real(kind=kind_phys) elocp, el2orc, qs, es, + & tld, gamma, qld, thdn, + & thvd, dq +! + real(kind=kind_phys) wd2(im,km), thld(im,km), + & qtx(im,km), qtd(im,km), + & thlvd(im), hrad(im), + & xlamdem(im,km-1), ra1(im) + real(kind=kind_phys) delz(im), xlamax(im) +! + real(kind=kind_phys) xlamavg(im), sigma(im), + & scaldfunc(im), sumx(im) +! + logical totflg, flg(im) +! + real(kind=kind_phys) actei, cldtime +! +c physical parameters + parameter(g=grav) + parameter(gocp=g/cp) + parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) + parameter(ce0=0.4,cm=1.0,pgcon=0.55) + parameter(qmin=1.e-8,qlmin=1.e-12) + parameter(b1=0.45,f1=0.15) + parameter(a2=0.5) + parameter(cldtime=500.) + parameter(actei = 0.7) +! parameter(actei = 0.23) +! +!************************************************************************ +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! + dt2 = delt +! + do k = 1, km + do i=1,im + if(cnvflg(i)) then + buo(i,k) = 0. + wd2(i,k) = 0. + qtx(i,k) = q1(i,k,1) + q1(i,k,ntcw) + endif + enddo + enddo +! + do i = 1, im + if(cnvflg(i)) then + hrad(i) = zm(i,krad(i)) + krad1(i) = krad(i)-1 + endif + enddo +! + do i = 1, im + if(cnvflg(i)) then + k = krad(i) + tem = zm(i,k+1)-zm(i,k) + tem1 = cldtime*radmin(i)/tem + tem1 = max(tem1, -3.0) + thld(i,k)= thlx(i,k) + tem1 + qtd(i,k) = qtx(i,k) + thlvd(i) = thlvx(i,k) + tem1 + buo(i,k) = - g * tem1 / thvx(i,k) + endif + enddo +! +!> - Specify downdraft fraction +! + do i=1,im + if(cnvflg(i)) then + ra1(i) = a1 + endif + enddo +! +!> - If the condition for cloud-top instability is met, +!! increase downdraft fraction +! + do i = 1, im + if(cnvflg(i)) then + k = krad(i) + tem = thetae(i,k) - thetae(i,k+1) + tem1 = qtx(i,k) - qtx(i,k+1) + if (tem > 0. .and. tem1 > 0.) then + cteit= cp*tem/(hvap*tem1) + if(cteit > actei) then + ra1(i) = a2 + endif + endif + endif + enddo +! +!> - First-guess level of downdraft extension (mrad) +! + do i = 1, im + flg(i) = cnvflg(i) + mrad(i) = krad(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k < krad(i)) then + if(thlvd(i) <= thlvx(i,k)) then + mrad(i) = k + else + flg(i)=.false. + endif + endif + enddo + enddo + do i=1,im + if (cnvflg(i)) then + kk = krad(i)-mrad(i) + if(kk < 1) cnvflg(i)=.false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!> - Compute entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = mrad(i) + (krad(i)-mrad(i)) / 2 + k = max(k, mrad(i)) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmscu + do i=1,im + if(cnvflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + if(mrad(i) == 1) then + ptem = 1./(zm(i,k)+delz(i)) + else + ptem = 1./(zm(i,k)-zm(i,mrad(i)-1)+delz(i)) + endif + tem = max((hrad(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamde(i,k) = ce0 * (ptem+ptem1) + else + xlamde(i,k) = xlamax(i) + endif +! + xlamdem(i,k) = cm * xlamde(i,k) + endif + enddo + enddo +! +!> - Compute buoyancy for downdraft air parcel +! + do k = kmscu,1,-1 + do i=1,im + if(cnvflg(i) .and. k < krad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + thld(i,k) = ((1.-tem)*thld(i,k+1)+tem* + & (thlx(i,k)+thlx(i,k+1)))/factor + qtd(i,k) = ((1.-tem)*qtd(i,k+1)+tem* + & (qtx(i,k)+qtx(i,k+1)))/factor +! + tld = thld(i,k) / pix(i,k) + es = 0.01 * fpvs(tld) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtd(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tld**2) + qld = dq / (1. + gamma) + qtd(i,k) = qs + qld + tem1 = 1. + fv * qs - qld + thdn = thld(i,k) + pix(i,k) * elocp * qld + thvd = thdn * tem1 + else + tem1 = 1. + fv * qtd(i,k) + thvd = thld(i,k) * tem1 + endif + buo(i,k) = g * (1. - thvd / thvx(i,k)) +! + endif + enddo + enddo +! +!> - Compute downdraft velocity square(wd2) +! +! tem = 1.-2.*f1 +! bb1 = 2. * b1 / tem +! bb2 = 2. / tem +! from Soares et al. (2004,QJRMS) +! bb1 = 2. +! bb2 = 4. +! +! from Bretherton et al. (2004, MWR) +! bb1 = 4. +! bb2 = 2. +! +! from our tuning + bb1 = 2.0 + bb2 = 4.0 +! + do i = 1, im + if(cnvflg(i)) then + k = krad1(i) + dz = zm(i,k+1) - zm(i,k) +! tem = 0.25*bb1*(xlamde(i,k)+xlamde(i,k+1))*dz + tem = 0.5*bb1*xlamde(i,k)*dz + tem1 = bb2 * buo(i,k+1) * dz + ptem1 = 1. + tem + wd2(i,k) = tem1 / ptem1 + endif + enddo + do k = kmscu,1,-1 + do i = 1, im + if(cnvflg(i) .and. k < krad1(i)) then + dz = zm(i,k+1) - zm(i,k) + tem = 0.25*bb1*(xlamde(i,k)+xlamde(i,k+1))*dz + tem1 = bb2 * buo(i,k+1) * dz + ptem = (1. - tem) * wd2(i,k+1) + ptem1 = 1. + tem + wd2(i,k) = (ptem + tem1) / ptem1 + endif + enddo + enddo +c + do i = 1, im + flg(i) = cnvflg(i) + if(flg(i)) mrad(i) = krad(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k < krad(i)) then + if(wd2(i,k) > 0.) then + mrad(i) = k + else + flg(i)=.false. + endif + endif + enddo + enddo +! + do i=1,im + if (cnvflg(i)) then + kk = krad(i)-mrad(i) + if(kk < 1) cnvflg(i)=.false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!> - Update entrainment rate +! + do i=1,im + if(cnvflg(i)) then + k = mrad(i) + (krad(i)-mrad(i)) / 2 + k = max(k, mrad(i)) + delz(i) = zl(i,k+1) - zl(i,k) + xlamax(i) = ce0 / delz(i) + endif + enddo +! + do k = 1, kmscu + do i=1,im + if(cnvflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + if(mrad(i) == 1) then + ptem = 1./(zm(i,k)+delz(i)) + else + ptem = 1./(zm(i,k)-zm(i,mrad(i)-1)+delz(i)) + endif + tem = max((hrad(i)-zm(i,k)+delz(i)) ,delz(i)) + ptem1 = 1./tem + xlamde(i,k) = ce0 * (ptem+ptem1) + else + xlamde(i,k) = xlamax(i) + endif +! + xlamdem(i,k) = cm * xlamde(i,k) + endif + enddo + enddo +! +!> - Compute entrainment rate averaged over the whole downdraft layers +! + do i = 1, im + xlamavg(i) = 0. + sumx(i) = 0. + enddo + do k = kmscu, 1, -1 + do i = 1, im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + dz = zl(i,k+1) - zl(i,k) + xlamavg(i) = xlamavg(i) + xlamde(i,k) * dz + sumx(i) = sumx(i) + dz + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + xlamavg(i) = xlamavg(i) / sumx(i) + endif + enddo +! +!> - Compute downdraft mass flux +! + do k = kmscu, 1, -1 + do i = 1, im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + xmfd(i,k) = ra1(i) * sqrt(wd2(i,k)) + endif + enddo + enddo +! +!> - Compute downdraft fraction as a function of mean entrainment rate +!! (Grell and Freitas(2014) \cite grell_and_freitas_2014 +! + do i = 1, im + if(cnvflg(i)) then + tem = 0.2 / xlamavg(i) + tem1 = 3.14 * tem * tem + sigma(i) = tem1 / (gdx(i) * gdx(i)) + sigma(i) = max(sigma(i), 0.001) + sigma(i) = min(sigma(i), 0.999) + endif + enddo +! +!> - Compute scale-aware function based on +!! Arakawa and Wu (2013) \cite arakawa_and_wu_2013 +! + do i = 1, im + if(cnvflg(i)) then + if (sigma(i) > ra1(i)) then + scaldfunc(i) = (1.-sigma(i)) * (1.-sigma(i)) + scaldfunc(i) = max(min(scaldfunc(i), 1.0), 0.) + else + scaldfunc(i) = 1.0 + endif + endif + enddo +! +!> - Compute final scale-aware downdraft mass flux +! + do k = kmscu, 1, -1 + do i = 1, im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + xmfd(i,k) = scaldfunc(i) * xmfd(i,k) + dz = zl(i,k+1) - zl(i,k) + xmmx = dz / dt2 + xmfd(i,k) = min(xmfd(i,k),xmmx) + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> - Compute downdraft property using updated entranment rate +! + do i = 1, im + if(cnvflg(i)) then + k = krad(i) + thld(i,k)= thlx(i,k) + endif + enddo +! +! do i = 1, im +! if(cnvflg(i)) then +! k = krad(i) +! ptem1 = max(qcdo(i,k,ntcw), 0.) +! tld = thld(i,k) / pix(i,k) +! tcdo(i,k) = tld + elocp * ptem1 +! qcdo(i,k,1) = qcdo(i,k,1)+0.2*qcdo(i,k,1) +! qcdo(i,k,ntcw) = qcdo(i,k,ntcw)+0.2*qcdo(i,k,ntcw) +! endif +! enddo +! + do k = kmscu,1,-1 + do i=1,im + if(cnvflg(i) .and. + & (k >= mrad(i) .and. k < krad(i))) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + thld(i,k) = ((1.-tem)*thld(i,k+1)+tem* + & (thlx(i,k)+thlx(i,k+1)))/factor + qtd(i,k) = ((1.-tem)*qtd(i,k+1)+tem* + & (qtx(i,k)+qtx(i,k+1)))/factor +! + tld = thld(i,k) / pix(i,k) + es = 0.01 * fpvs(tld) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k)+epsm1*es)) + dq = qtd(i,k) - qs +! + if (dq > 0.) then + gamma = el2orc * qs / (tld**2) + qld = dq / (1. + gamma) + qtd(i,k) = qs + qld + qcdo(i,k,1) = qs + qcdo(i,k,ntcw) = qld + tcdo(i,k) = tld + elocp * qld + else + qcdo(i,k,1) = qtd(i,k) + qcdo(i,k,ntcw) = 0. + tcdo(i,k) = tld + endif +! + endif + enddo + enddo +! + do k = kmscu, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamdem(i,k) * dz + factor = 1. + tem + ptem = tem - pgcon + ptem1= tem + pgcon +! + ucdo(i,k) = ((1.-tem)*ucdo(i,k+1)+ptem*u1(i,k+1) + & +ptem1*u1(i,k))/factor + vcdo(i,k) = ((1.-tem)*vcdo(i,k+1)+ptem*v1(i,k+1) + & +ptem1*v1(i,k))/factor + endif + endif + enddo + enddo +! + if(ntcw > 2) then +! + do n = 2, ntcw-1 + do k = kmscu, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + qcdo(i,k,n) = ((1.-tem)*qcdo(i,k+1,n)+tem* + & (q1(i,k,n)+q1(i,k+1,n)))/factor + endif + endif + enddo + enddo + enddo +! + endif +! + ndc = ntrac1 - ntcw +! + if(ndc > 0) then +! + do n = ntcw+1, ntrac1 + do k = kmscu, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem +! + qcdo(i,k,n) = ((1.-tem)*qcdo(i,k+1,n)+tem* + & (q1(i,k,n)+q1(i,k+1,n)))/factor + endif + endif + enddo + enddo + enddo +! + endif +! + return + end +!> @} diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F new file mode 100644 index 000000000..0e939efd6 --- /dev/null +++ b/physics/satmedmfvdifq.F @@ -0,0 +1,1416 @@ +!> \file satmedmfvdifq.F +!! This file contains the CCPP-compliant SATMEDMF scheme (HAFS version) which computes +!! subgrid vertical turbulence mixing using scale-aware TKE-based moist +!! eddy-diffusion mass-flux (TKE-EDMF) parameterization (by Jongil Han). + + module satmedmfvdifq + + contains + +!> \section arg_table_satmedmfvdifq_init Argument Table +!! \htmlinclude satmedmfvdifq_init.html +!! + subroutine satmedmfvdifq_init (isatmedmf,isatmedmf_vdifq, + & errmsg,errflg) + + integer, intent(in) :: isatmedmf,isatmedmf_vdifq + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. isatmedmf==isatmedmf_vdifq) then + write(errmsg,fmt='(*(a))') 'Logic error: satmedmfvdif is ', + & 'called, but isatmedmf/=isatmedmf_vdifq.' + errflg = 1 + return + end if + + end subroutine satmedmfvdifq_init + + subroutine satmedmfvdifq_finalize () + end subroutine satmedmfvdifq_finalize + +!> \defgroup satmedmfq GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF, HAFS version) Scheme Module +!! @{ +!! \brief This subroutine contains all of the logic for the +!! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF, HAFS version) scheme. +!! +!> \section arg_table_satmedmfvdifq_run Argument Table +!! \htmlinclude satmedmfvdifq_run.html +!! +!!\section gen_satmedmfvdif GFS satmedmfvdif General Algorithm +!! satmedmfvdif_run() computes subgrid vertical turbulence mixing +!! using the scale-aware TKE-based moist eddy-diffusion mass-flux (EDMF) parameterization of +!! Han and Bretherton (2019) \cite Han_2019 . +!! -# The local turbulent mixing is represented by an eddy-diffusivity scheme which +!! is a function of a prognostic TKE. +!! -# For the convective boundary layer, nonlocal transport by large eddies +!! (mfpblt.f), is represented using a mass flux approach (Siebesma et al.(2007) \cite Siebesma_2007 ). +!! -# A mass-flux approach is also used to represent the stratocumulus-top-induced turbulence +!! (mfscu.f). +!! For local turbulence mixing, a TKE closure model is used. +!! Updated version of satmedmfvdif.f (May 2019) to have better low level +!! inversion, to reduce the cold bias in lower troposphere, +!! and to reduce the negative wind speed bias in upper troposphere +!! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm +!> @{ + subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & + & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & + & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & + & psk,rbsoil,zorl,u10m,v10m,fm,fh, & + & tsea,heat,evap,stress,spd1,kpbl, & + & prsi,del,prsl,prslk,phii,phil,delt, & + & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & + & kinver,xkzm_m,xkzm_h,xkzm_s,dspfac,bl_upfr,bl_dnfr, & + & errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs +! + implicit none +! +!---------------------------------------------------------------------- + integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke + integer, intent(in) :: kinver(im) + integer, intent(out) :: kpbl(im) +! + real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & + & eps,epsm1 + real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s + real(kind=kind_phys), intent(in) :: dspfac, bl_upfr, bl_dnfr + real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & + & tdt(im,km), rtg(im,km,ntrac) + real(kind=kind_phys), intent(in) :: & + & u1(ix,km), v1(ix,km), & + & t1(ix,km), q1(ix,km,ntrac), & + & swh(ix,km), hlw(ix,km), & + & xmu(im), garea(im), & + & psk(ix), rbsoil(im), & + & zorl(im), tsea(im), & + & u10m(im), v10m(im), & + & fm(im), fh(im), & + & evap(im), heat(im), & + & stress(im), spd1(im), & + & prsi(ix,km+1), del(ix,km), & + & prsl(ix,km), prslk(ix,km), & + & phii(ix,km+1), phil(ix,km) + real(kind=kind_phys), intent(out) :: & + & dusfc(im), dvsfc(im), & + & dtsfc(im), dqsfc(im), & + & hpbl(im) +! + logical, intent(in) :: dspheat + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! flag for tke dissipative heating +! +!---------------------------------------------------------------------- +!*** +!*** local variables +!*** + integer i,is,k,kk,n,ndt,km1,kmpbl,kmscu,ntrac1 + integer lcld(im),kcld(im),krad(im),mrad(im) + integer kx1(im), kpblx(im) +! + real(kind=kind_phys) tke(im,km), tkeh(im,km-1) +! + real(kind=kind_phys) theta(im,km),thvx(im,km), thlvx(im,km), + & qlx(im,km), thetae(im,km),thlx(im,km), + & slx(im,km), svx(im,km), qtx(im,km), + & tvx(im,km), pix(im,km), radx(im,km-1), + & dku(im,km-1),dkt(im,km-1), dkq(im,km-1), + & cku(im,km-1),ckt(im,km-1) +! + real(kind=kind_phys) plyr(im,km), rhly(im,km), cfly(im,km), + & qstl(im,km) +! + real(kind=kind_phys) dtdz1(im), gdx(im), + & phih(im), phim(im), prn(im,km-1), + & rbdn(im), rbup(im), thermal(im), + & ustar(im), wstar(im), hpblx(im), + & ust3(im), wst3(im), + & z0(im), crb(im), + & hgamt(im), hgamq(im), + & wscale(im),vpert(im), + & zol(im), sflux(im), + & tx1(im), tx2(im) +! + real(kind=kind_phys) radmin(im) +! + real(kind=kind_phys) zi(im,km+1), zl(im,km), zm(im,km), + & xkzo(im,km-1),xkzmo(im,km-1), + & xkzm_hx(im), xkzm_mx(im), tkmnz(im,km-1), + & rdzt(im,km-1),rlmnz(im,km), + & al(im,km-1), ad(im,km), au(im,km-1), + & f1(im,km), f2(im,km*(ntrac-1)) +! + real(kind=kind_phys) elm(im,km), ele(im,km), + & ckz(im,km), chz(im,km), frik(im), + & diss(im,km-1),prod(im,km-1), + & bf(im,km-1), shr2(im,km-1), + & xlamue(im,km-1), xlamde(im,km-1), + & gotvx(im,km), rlam(im,km-1) +! +! variables for updrafts (thermals) +! + real(kind=kind_phys) tcko(im,km), qcko(im,km,ntrac), + & ucko(im,km), vcko(im,km), + & buou(im,km), xmf(im,km) +! +! variables for stratocumulus-top induced downdrafts +! + real(kind=kind_phys) tcdo(im,km), qcdo(im,km,ntrac), + & ucdo(im,km), vcdo(im,km), + & buod(im,km), xmfd(im,km) +! + logical pblflg(im), sfcflg(im), flg(im) + logical scuflg(im), pcnvflg(im) + logical mlenflg +! +! pcnvflg: true for unstable pbl +! + real(kind=kind_phys) aphi16, aphi5, + & wfac, cfac, + & gamcrt, gamcrq, sfcfrac, + & conq, cont, conw, + & dsdz2, dsdzt, dkmax, + & dsig, dt2, dtodsd, + & dtodsu, g, factor, dz, + & gocp, gravi, zol1, zolcru, + & buop, shrp, dtn, + & prnum, prmax, prmin, prtke, + & prscu, pr0, ri, + & dw2, dw2min, zk, + & elmfac, elefac, dspmax, + & alp, clwt, cql, + & f0, robn, crbmin, crbmax, + & es, qs, value, onemrh, + & cfh, gamma, elocp, el2orc, + & epsi, beta, chx, cqx, + & rdt, rdz, qmin, qlmin, + & rimin, rbcr, rbint, tdzmin, + & rlmn, rlmn1, rlmx, elmx, + & ttend, utend, vtend, qtend, + & zfac, zfmin, vk, spdk2, + & tkmin, xkzinv, xkgdx, + & zlup, zldn, bsum, + & tem, tem1, tem2, + & ptem, ptem0, ptem1, ptem2 +! + real(kind=kind_phys) ck0, ck1, ch0, ch1, ce0, rchck +! + real(kind=kind_phys) qlcr, zstblmax +! + real(kind=kind_phys) h1 +!! + parameter(wfac=7.0,cfac=3.0) + parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) + parameter(vk=0.4,rimin=-100.) + parameter(rbcr=0.25,zolcru=-0.02,tdzmin=1.e-3) + parameter(rlmn=30.,rlmn1=5.,rlmx=300.,elmx=300.) + parameter(prmin=0.25,prmax=4.0) + parameter(pr0=1.0,prtke=1.0,prscu=0.67) + parameter(f0=1.e-4,crbmin=0.15,crbmax=0.35) + parameter(tkmin=1.e-9,dspmax=10.0) + parameter(qmin=1.e-8,qlmin=1.e-12,zfmin=1.e-8) + parameter(aphi5=5.,aphi16=16.) + parameter(elmfac=1.0,elefac=1.0,cql=100.) + parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=25000.) + parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.1) + parameter(h1=0.33333333) + parameter(ck0=0.4,ck1=0.15,ch0=0.4,ch1=0.15) + parameter(ce0=0.4) + parameter(rchck=1.5,ndt=20) + + gravi=1.0/grav + g=grav + gocp=g/cp + cont=cp/g + conq=hvap/g + conw=1.0/g ! for del in pa +! parameter(cont=1000.*cp/g,conq=1000.*hvap/g,conw=1000./g) !kpa + elocp=hvap/cp + el2orc=hvap*hvap/(rv*cp) +! +!************************************************************************ +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + dt2 = delt + rdt = 1. / dt2 +! +! the code is written assuming ntke=ntrac +! if ntrac > ntke, the code needs to be modified +! + ntrac1 = ntrac - 1 + km1 = km - 1 + kmpbl = km / 2 + kmscu = km / 2 +! + do k=1,km + do i=1,im + zi(i,k) = phii(i,k) * gravi + zl(i,k) = phil(i,k) * gravi + xmf(i,k) = 0. + xmfd(i,k) = 0. + buou(i,k) = 0. + buod(i,k) = 0. + ckz(i,k) = ck1 + chz(i,k) = ch1 + rlmnz(i,k) = rlmn + enddo + enddo + do i=1,im + frik(i) = 1.0 + enddo + do i=1,im + zi(i,km+1) = phii(i,km+1) * gravi + enddo + do k=1,km + do i=1,im + zm(i,k) = zi(i,k+1) + enddo + enddo +! horizontal grid size + do i=1,im + gdx(i) = sqrt(garea(i)) + enddo +! + do k=1,km + do i=1,im + tke(i,k) = max(q1(i,k,ntke), tkmin) + enddo + enddo + do k=1,km1 + do i=1,im + tkeh(i,k) = 0.5 * (tke(i,k) + tke(i,k+1)) + enddo + enddo +! + do k = 1,km1 + do i=1,im + rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) + prn(i,k) = pr0 + enddo + enddo +! +! set background diffusivities as a function of +! horizontal grid size with xkzm_h & xkzm_m for gdx >= 25km +! and 0.01 for gdx=5m, i.e., +! xkzm_hx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) +! xkzm_mx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) +! + do i=1,im + kx1(i) = 1 + tx1(i) = 1.0 / prsi(i,1) + tx2(i) = tx1(i) + if(gdx(i) >= xkgdx) then + xkzm_hx(i) = xkzm_h + xkzm_mx(i) = xkzm_m + else + tem = 1. / (xkgdx - 5.) + tem1 = (xkzm_h - 0.01) * tem + tem2 = (xkzm_m - 0.01) * tem + ptem = gdx(i) - 5. + xkzm_hx(i) = 0.01 + tem1 * ptem + xkzm_mx(i) = 0.01 + tem2 * ptem + endif + enddo + do k = 1,km1 + do i=1,im + xkzo(i,k) = 0.0 + xkzmo(i,k) = 0.0 + if (k < kinver(i)) then +! vertical background diffusivity + ptem = prsi(i,k+1) * tx1(i) + tem1 = 1.0 - ptem + tem2 = tem1 * tem1 * 10.0 + tem2 = min(1.0, exp(-tem2)) + xkzo(i,k) = xkzm_hx(i) * tem2 +! + ptem = prsl(i,k) * tx1(i) + tem1 = 1.0 - ptem + tem2 = tem1 * tem1 * 2.5 + tem2 = min(1.0, exp(-tem2)) + rlmnz(i,k)= rlmn * tem2 + rlmnz(i,k)= max(rlmnz(i,k), rlmn1) +! vertical background diffusivity for momentum + if (ptem >= xkzm_s) then + xkzmo(i,k) = xkzm_mx(i) + kx1(i) = k + 1 + else + if (k == kx1(i) .and. k > 1) tx2(i) = 1.0 / prsi(i,k) + tem1 = 1.0 - prsi(i,k+1) * tx2(i) + tem1 = tem1 * tem1 * 5.0 + xkzmo(i,k) = xkzm_mx(i) * min(1.0, exp(-tem1)) + endif + endif + enddo + enddo +! + do i = 1,im + z0(i) = 0.01 * zorl(i) + dusfc(i) = 0. + dvsfc(i) = 0. + dtsfc(i) = 0. + dqsfc(i) = 0. + kpbl(i) = 1 + hpbl(i) = 0. + kpblx(i) = 1 + hpblx(i) = 0. + pblflg(i)= .true. + sfcflg(i)= .true. + if(rbsoil(i) > 0.) sfcflg(i) = .false. + pcnvflg(i)= .false. + scuflg(i)= .true. + if(scuflg(i)) then + radmin(i)= 0. + mrad(i) = km1 + krad(i) = 1 + lcld(i) = km1 + kcld(i) = km1 + endif + enddo +! + do k=1,km + do i=1,im + pix(i,k) = psk(i) / prslk(i,k) + theta(i,k) = t1(i,k) * pix(i,k) + if(ntiw > 0) then + tem = max(q1(i,k,ntcw),qlmin) + tem1 = max(q1(i,k,ntiw),qlmin) + qlx(i,k) = tem + tem1 + ptem = hvap*tem + (hvap+hfus)*tem1 + slx(i,k) = cp * t1(i,k) + phil(i,k) - ptem + else + qlx(i,k) = max(q1(i,k,ntcw),qlmin) + slx(i,k) = cp * t1(i,k) + phil(i,k) - hvap*qlx(i,k) + endif + tem2 = 1.+fv*max(q1(i,k,1),qmin)-qlx(i,k) + thvx(i,k) = theta(i,k) * tem2 + tvx(i,k) = t1(i,k) * tem2 + qtx(i,k) = max(q1(i,k,1),qmin)+qlx(i,k) + thlx(i,k) = theta(i,k) - pix(i,k)*elocp*qlx(i,k) + thlvx(i,k) = thlx(i,k) * (1. + fv * qtx(i,k)) + svx(i,k) = cp * tvx(i,k) + ptem1 = elocp * pix(i,k) * max(q1(i,k,1),qmin) + thetae(i,k)= theta(i,k) + ptem1 + gotvx(i,k) = g / tvx(i,k) + enddo + enddo +! +! compute an empirical cloud fraction based on +! Xu & Randall's (1996,JAS) study +! + do k = 1, km + do i = 1, im + plyr(i,k) = 0.01 * prsl(i,k) ! pa to mb (hpa) +! --- ... compute relative humidity + es = 0.01 * fpvs(t1(i,k)) ! fpvs in pa + qs = max(qmin, eps * es / (plyr(i,k) + epsm1*es)) + rhly(i,k) = max(0.0, min(1.0, max(qmin, q1(i,k,1))/qs)) + qstl(i,k) = qs + enddo + enddo +! + do k = 1, km + do i = 1, im + cfly(i,k) = 0. + clwt = 1.0e-6 * (plyr(i,k)*0.001) + if (qlx(i,k) > clwt) then + onemrh= max(1.e-10, 1.0-rhly(i,k)) + tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) + tem1 = cql / tem1 + value = max(min( tem1*qlx(i,k), 50.0), 0.0) + tem2 = sqrt(sqrt(rhly(i,k))) + cfly(i,k) = min(max(tem2*(1.0-exp(-value)), 0.0), 1.0) + endif + enddo + enddo +! +! compute buoyancy modified by clouds +! + do k = 1, km1 + do i = 1, im + tem = 0.5 * (svx(i,k) + svx(i,k+1)) + tem1 = 0.5 * (t1(i,k) + t1(i,k+1)) + tem2 = 0.5 * (qstl(i,k) + qstl(i,k+1)) + cfh = min(cfly(i,k+1),0.5*(cfly(i,k)+cfly(i,k+1))) + alp = g / tem + gamma = el2orc * tem2 / (tem1**2) + epsi = tem1 / elocp + beta = (1. + gamma*epsi*(1.+fv)) / (1. + gamma) + chx = cfh * alp * beta + (1. - cfh) * alp + cqx = cfh * alp * hvap * (beta - epsi) + cqx = cqx + (1. - cfh) * fv * g + ptem1 = (slx(i,k+1)-slx(i,k))*rdzt(i,k) + ptem2 = (qtx(i,k+1)-qtx(i,k))*rdzt(i,k) + bf(i,k) = chx * ptem1 + cqx * ptem2 + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k=1,km1 + do i=1,im + dku(i,k) = 0. + dkt(i,k) = 0. + dkq(i,k) = 0. + cku(i,k) = 0. + ckt(i,k) = 0. + tem = zi(i,k+1)-zi(i,k) + radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) + enddo + enddo +! + 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. + enddo +! +! compute critical bulk richardson number +! + do i = 1,im + if(pblflg(i)) then +! thermal(i) = thvx(i,1) + thermal(i) = thlvx(i,1) + crb(i) = rbcr + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = max(min(crb(i), crbmax), crbmin) + endif + enddo +! + do i=1,im + dtdz1(i) = dt2 / (zi(i,2)-zi(i,1)) + enddo +! + do i=1,im + ustar(i) = sqrt(stress(i)) + enddo +! +! compute buoyancy (bf) and winshear square +! + do k = 1, km1 + do i = 1, im + rdz = rdzt(i,k) +! bf(i,k) = gotvx(i,k)*(thvx(i,k+1)-thvx(i,k))*rdz + dw2 = (u1(i,k)-u1(i,k+1))**2 + & + (v1(i,k)-v1(i,k+1))**2 + shr2(i,k) = max(dw2,dw2min)*rdz*rdz + enddo + enddo +! +! find pbl height based on bulk richardson number (mrf pbl scheme) +! and also for diagnostic purpose +! + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) + enddo +! + do k = 1, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) +! rbup(i) = (thvx(i,k)-thermal(i))* +! & (g*zl(i,k)/thvx(i,1))/spdk2 + rbup(i) = (thlvx(i,k)-thermal(i))* + & (g*zl(i,k)/thlvx(i,1))/spdk2 + kpblx(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo + do i = 1,im + if(kpblx(i) > 1) then + k = kpblx(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpblx(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpblx(i) < zi(i,kpblx(i))) kpblx(i)=kpblx(i)-1 + else + hpblx(i) = zl(i,1) + kpblx(i) = 1 + endif + hpbl(i) = hpblx(i) + kpbl(i) = kpblx(i) + if(kpbl(i) <= 1) pblflg(i)=.false. + enddo +! +! compute similarity parameters +! + do i=1,im + zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) + if(sfcflg(i)) then + zol(i) = min(zol(i),-zfmin) + else + zol(i) = max(zol(i),zfmin) + endif +! + zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) + if(sfcflg(i)) then + tem = 1.0 / (1. - aphi16*zol1) + phih(i) = sqrt(tem) + phim(i) = sqrt(phih(i)) + else + phim(i) = 1. + aphi5*zol1 + phih(i) = phim(i) + endif + enddo +! + do i=1,im + if(pblflg(i)) then + if(zol(i) < zolcru) then + pcnvflg(i) = .true. + endif + wst3(i) = gotvx(i,1)*sflux(i)*hpbl(i) + wstar(i)= wst3(i)**h1 + ust3(i) = ustar(i)**3. + wscale(i)=(ust3(i)+wfac*vk*wst3(i)*sfcfrac)**h1 + ptem = ustar(i)/aphi5 + wscale(i) = max(wscale(i),ptem) + endif + enddo +! +! compute a thermal excess +! + do i = 1,im + if(pcnvflg(i)) then + hgamt(i) = heat(i)/wscale(i) + hgamq(i) = evap(i)/wscale(i) + vpert(i) = hgamt(i) + hgamq(i)*fv*theta(i,1) + vpert(i) = max(vpert(i),0.) + vpert(i) = min(cfac*vpert(i),gamcrt) + endif + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! look for stratocumulus +! + do i=1,im + flg(i) = scuflg(i) + enddo + do k = 1, km1 + do i=1,im + if(flg(i).and.zl(i,k) >= zstblmax) then + lcld(i)=k + flg(i)=.false. + endif + enddo + enddo + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k <= lcld(i)) then + if(qlx(i,k) >= qlcr) then + kcld(i)=k + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. + enddo +! + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmscu,1,-1 + do i = 1, im + if(flg(i) .and. k <= kcld(i)) then + if(qlx(i,k) >= qlcr) then + if(radx(i,k) < radmin(i)) then + radmin(i)=radx(i,k) + krad(i)=k + endif + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. krad(i) <= 1) scuflg(i)=.false. + if(scuflg(i) .and. radmin(i)>=0.) scuflg(i)=.false. + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute components for mass flux mixing by large thermals +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + tcko(i,k) = t1(i,k) + ucko(i,k) = u1(i,k) + vcko(i,k) = v1(i,k) + endif + if(scuflg(i)) then + tcdo(i,k) = t1(i,k) + ucdo(i,k) = u1(i,k) + vcdo(i,k) = v1(i,k) + endif + enddo + enddo + do kk = 1, ntrac1 + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + qcko(i,k,kk) = q1(i,k,kk) + endif + if(scuflg(i)) then + qcdo(i,k,kk) = q1(i,k,kk) + endif + enddo + enddo + enddo +! + call mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,dt2, + & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, + & gdx,hpbl,kpbl,vpert,buou,xmf, + & tcko,qcko,ucko,vcko,xlamue,bl_upfr) +! + call mfscuq(im,ix,km,kmscu,ntcw,ntrac1,dt2, + & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, + & thlx,thvx,thlvx,gdx,thetae, + & krad,mrad,radmin,buod,xmfd, + & tcdo,qcdo,ucdo,vcdo,xlamde,bl_dnfr) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute prandtl number and exchange coefficient varying with height +! + do k = 1, kmpbl + do i = 1, im + if(k < kpbl(i)) then + tem = phih(i)/phim(i) + ptem = sfcfrac*hpbl(i) + tem1 = max(zi(i,k+1)-ptem, 0.) + tem2 = tem1 / (hpbl(i) - ptem) + if(pcnvflg(i)) then + tem = min(tem, pr0) + prn(i,k) = tem + (pr0 - tem) * tem2 + else + tem = max(tem, pr0) + prn(i,k) = tem + endif + prn(i,k) = min(prn(i,k),prmax) + prn(i,k) = max(prn(i,k),prmin) +! + ckz(i,k) = ck0 + (ck1 - ck0) * tem2 + ckz(i,k) = max(min(ckz(i,k), ck0), ck1) + chz(i,k) = ch0 + (ch1 - ch0) * tem2 + chz(i,k) = max(min(chz(i,k), ch0), ch1) +! + endif + enddo + enddo +! +! background diffusivity decreasing with increasing surface layer stability +! + do i = 1, im + if(.not.sfcflg(i)) then + tem = (1. + 5. * rbsoil(i))**2. +! tem = (1. + 5. * zol(i))**2. + frik(i) = 0.1 + 0.9 / tem + endif + enddo +! + do k = 1,km1 + do i=1,im + xkzo(i,k) = frik(i) * xkzo(i,k) + xkzmo(i,k)= frik(i) * xkzmo(i,k) + enddo + enddo +! +! The background vertical diffusivities in the inversion layers are limited +! to be less than or equal to xkzminv +! + do k = 1,km1 + do i=1,im +! tem1 = (tvx(i,k+1)-tvx(i,k)) * rdzt(i,k) +! if(tem1 > 1.e-5) then + tem1 = tvx(i,k+1)-tvx(i,k) + if(tem1 > 0.) then + xkzo(i,k) = min(xkzo(i,k),xkzinv) + xkzmo(i,k) = min(xkzmo(i,k),xkzinv) + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute an asymtotic mixing length +! + do k = 1, km1 + do i = 1, im + zlup = 0.0 + bsum = 0.0 + mlenflg = .true. + do n = k, km1 + if(mlenflg) then + dz = zl(i,n+1) - zl(i,n) + ptem = gotvx(i,n)*(thvx(i,n+1)-thvx(i,k))*dz +! ptem = gotvx(i,n)*(thlvx(i,n+1)-thlvx(i,k))*dz + bsum = bsum + ptem + zlup = zlup + dz + if(bsum >= tke(i,k)) then + if(ptem >= 0.) then + tem2 = max(ptem, zfmin) + else + tem2 = min(ptem, -zfmin) + endif + ptem1 = (bsum - tke(i,k)) / tem2 + zlup = zlup - ptem1 * dz + zlup = max(zlup, 0.) + mlenflg = .false. + endif + endif + enddo + zldn = 0.0 + bsum = 0.0 + mlenflg = .true. + do n = k, 1, -1 + if(mlenflg) then + if(n == 1) then + dz = zl(i,1) + tem1 = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + else + dz = zl(i,n) - zl(i,n-1) + tem1 = thvx(i,n-1) +! tem1 = thlvx(i,n-1) + endif + ptem = gotvx(i,n)*(thvx(i,k)-tem1)*dz +! ptem = gotvx(i,n)*(thlvx(i,k)-tem1)*dz + bsum = bsum + ptem + zldn = zldn + dz + if(bsum >= tke(i,k)) then + if(ptem >= 0.) then + tem2 = max(ptem, zfmin) + else + tem2 = min(ptem, -zfmin) + endif + ptem1 = (bsum - tke(i,k)) / tem2 + zldn = zldn - ptem1 * dz + zldn = max(zldn, 0.) + mlenflg = .false. + endif + endif + enddo +! + tem = 0.5 * (zi(i,k+1)-zi(i,k)) + tem1 = min(tem, rlmnz(i,k)) +! + ptem2 = min(zlup,zldn) + rlam(i,k) = elmfac * ptem2 + rlam(i,k) = max(rlam(i,k), tem1) + rlam(i,k) = min(rlam(i,k), rlmx) +! + ptem2 = sqrt(zlup*zldn) + ele(i,k) = elefac * ptem2 + ele(i,k) = max(ele(i,k), tem1) + ele(i,k) = min(ele(i,k), elmx) +! + enddo + enddo +! + do k = 1, km1 + do i = 1, im + tem = vk * zl(i,k) + if (zol(i) < 0.) then + ptem = 1. - 100. * zol(i) + ptem1 = ptem**0.2 + zk = tem * ptem1 + elseif (zol(i) >= 1.) then + zk = tem / 3.7 + else + ptem = 1. + 2.7 * zol(i) + zk = tem / ptem + endif + elm(i,k) = zk*rlam(i,k)/(rlam(i,k)+zk) +! + dz = zi(i,k+1) - zi(i,k) + tem = max(gdx(i),dz) + elm(i,k) = min(elm(i,k), tem) + ele(i,k) = min(ele(i,k), tem) +! + enddo + enddo + do i = 1, im + elm(i,km) = elm(i,km1) + ele(i,km) = ele(i,km1) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute eddy diffusivities +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km1 + do i = 1, im + tem = 0.5 * (elm(i,k) + elm(i,k+1)) + tem = tem * sqrt(tkeh(i,k)) + ri = max(bf(i,k)/shr2(i,k),rimin) + if(k < kpbl(i)) then + if(pcnvflg(i)) then + dku(i,k) = ckz(i,k) * tem + dkt(i,k) = dku(i,k) / prn(i,k) + else + if(ri < 0.) then ! unstable regime + dku(i,k) = ckz(i,k) * tem + dkt(i,k) = dku(i,k) / prn(i,k) + else ! stable regime + dkt(i,k) = chz(i,k) * tem + dku(i,k) = dkt(i,k) * prn(i,k) + endif + endif + else + if(ri < 0.) then ! unstable regime + dku(i,k) = ck1 * tem + dkt(i,k) = rchck * dku(i,k) + else ! stable regime + dkt(i,k) = ch1 * tem + prnum = 1.0 + 2.1 * ri + prnum = min(prnum,prmax) + dku(i,k) = dkt(i,k) * prnum + endif + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + tem1 = ckz(i,k) * tem + ptem1 = tem1 / prscu + dku(i,k) = max(dku(i,k), tem1) + dkt(i,k) = max(dkt(i,k), ptem1) + endif + endif +! + dkq(i,k) = prtke * dkt(i,k) +! + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dkq(i,k) = min(dkq(i,k),dkmax) + dkq(i,k) = max(dkq(i,k),xkzo(i,k)) + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) +! + enddo + enddo +! +! compute a minimum TKE deduced from background diffusivity for momentum. +! + do k = 1, km1 + do i = 1, im + if(k == 1) then + tem = ckz(i,1) + tem1 = xkzmo(i,1) + else + tem = 0.5 * (ckz(i,k-1) + ckz(i,k)) + tem1 = 0.5 * (xkzmo(i,k-1) + xkzmo(i,k)) + endif + ptem = tem1 / (tem * elm(i,k)) + tkmnz(i,k) = ptem * ptem + tkmnz(i,k) = max(tkmnz(i,k), tkmin) + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute buoyancy and shear productions of tke +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km1 + do i = 1, im + if (k == 1) then + tem = -dkt(i,1) * bf(i,1) +! if(pcnvflg(i)) then +! ptem1 = xmf(i,1) * buou(i,1) +! else + ptem1 = 0. +! endif + if(scuflg(i) .and. mrad(i) == 1) then + ptem2 = xmfd(i,1) * buod(i,1) + else + ptem2 = 0. + endif + tem = tem + ptem1 + ptem2 + buop = 0.5 * (gotvx(i,1) * sflux(i) + tem) +! + tem1 = dku(i,1) * shr2(i,1) +! + tem = (u1(i,2)-u1(i,1))*rdzt(i,1) +! if(pcnvflg(i)) then +! ptem = xmf(i,1) * tem +! ptem1 = 0.5 * ptem * (u1(i,2)-ucko(i,2)) +! else + ptem1 = 0. +! endif + if(scuflg(i) .and. mrad(i) == 1) then + ptem = ucdo(i,1)+ucdo(i,2)-u1(i,1)-u1(i,2) + ptem = 0.5 * tem * xmfd(i,1) * ptem + else + ptem = 0. + endif + ptem1 = ptem1 + ptem +! + tem = (v1(i,2)-v1(i,1))*rdzt(i,1) +! if(pcnvflg(i)) then +! ptem = xmf(i,1) * tem +! ptem2 = 0.5 * ptem * (v1(i,2)-vcko(i,2)) +! else + ptem2 = 0. +! endif + if(scuflg(i) .and. mrad(i) == 1) then + ptem = vcdo(i,1)+vcdo(i,2)-v1(i,1)-v1(i,2) + ptem = 0.5 * tem * xmfd(i,1) * ptem + else + ptem = 0. + endif + ptem2 = ptem2 + ptem +! +! tem2 = stress(i)*spd1(i)/zl(i,1) + tem2 = stress(i)*ustar(i)*phim(i)/(vk*zl(i,1)) + shrp = 0.5 * (tem1 + ptem1 + ptem2 + tem2) + else + tem1 = -dkt(i,k-1) * bf(i,k-1) + tem2 = -dkt(i,k) * bf(i,k) + tem = 0.5 * (tem1 + tem2) + if(pcnvflg(i) .and. k <= kpbl(i)) then + ptem = 0.5 * (xmf(i,k-1) + xmf(i,k)) + ptem1 = ptem * buou(i,k) + else + ptem1 = 0. + endif + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem0 = 0.5 * (xmfd(i,k-1) + xmfd(i,k)) + ptem2 = ptem0 * buod(i,k) + else + ptem2 = 0. + endif + else + ptem2 = 0. + endif + buop = tem + ptem1 + ptem2 +! + tem1 = dku(i,k-1) * shr2(i,k-1) + tem2 = dku(i,k) * shr2(i,k) + tem = 0.5 * (tem1 + tem2) + tem1 = (u1(i,k+1)-u1(i,k))*rdzt(i,k) + tem2 = (u1(i,k)-u1(i,k-1))*rdzt(i,k-1) + if(pcnvflg(i) .and. k <= kpbl(i)) then + ptem = xmf(i,k) * tem1 + xmf(i,k-1) * tem2 + ptem1 = 0.5 * ptem * (u1(i,k)-ucko(i,k)) + else + ptem1 = 0. + endif + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem0 = xmfd(i,k) * tem1 + xmfd(i,k-1) * tem2 + ptem2 = 0.5 * ptem0 * (ucdo(i,k)-u1(i,k)) + else + ptem2 = 0. + endif + else + ptem2 = 0. + endif + shrp = tem + ptem1 + ptem2 + tem1 = (v1(i,k+1)-v1(i,k))*rdzt(i,k) + tem2 = (v1(i,k)-v1(i,k-1))*rdzt(i,k-1) + if(pcnvflg(i) .and. k <= kpbl(i)) then + ptem = xmf(i,k) * tem1 + xmf(i,k-1) * tem2 + ptem1 = 0.5 * ptem * (v1(i,k)-vcko(i,k)) + else + ptem1 = 0. + endif + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem0 = xmfd(i,k) * tem1 + xmfd(i,k-1) * tem2 + ptem2 = 0.5 * ptem0 * (vcdo(i,k)-v1(i,k)) + else + ptem2 = 0. + endif + else + ptem2 = 0. + endif + shrp = shrp + ptem1 + ptem2 + endif + prod(i,k) = buop + shrp + enddo + enddo +! +!---------------------------------------------------------------------- +! first predict tke due to tke production & dissipation(diss) +! + dtn = dt2 / float(ndt) + do n = 1, ndt + do k = 1,km1 + do i=1,im + tem = sqrt(tke(i,k)) + ptem = ce0 / ele(i,k) + diss(i,k) = ptem * tke(i,k) * tem + tem1 = prod(i,k) + tke(i,k) / dtn + diss(i,k)=max(min(diss(i,k), tem1), 0.) + tke(i,k) = tke(i,k) + dtn * (prod(i,k)-diss(i,k)) +! tke(i,k) = max(tke(i,k), tkmin) + tke(i,k) = max(tke(i,k), tkmnz(i,k)) + enddo + enddo + enddo +! +! compute updraft & downdraft properties for tke +! + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + qcko(i,k,ntke) = tke(i,k) + endif + if(scuflg(i)) then + qcdo(i,k,ntke) = tke(i,k) + endif + enddo + enddo + do k = 2, kmpbl + do i = 1, im + if (pcnvflg(i) .and. k <= kpbl(i)) then + dz = zl(i,k) - zl(i,k-1) + tem = 0.5 * xlamue(i,k-1) * dz + factor = 1. + tem + qcko(i,k,ntke)=((1.-tem)*qcko(i,k-1,ntke)+tem* + & (tke(i,k)+tke(i,k-1)))/factor + endif + enddo + enddo + do k = kmscu, 1, -1 + do i = 1, im + if (scuflg(i) .and. k < krad(i)) then + if(k >= mrad(i)) then + dz = zl(i,k+1) - zl(i,k) + tem = 0.5 * xlamde(i,k) * dz + factor = 1. + tem + qcdo(i,k,ntke)=((1.-tem)*qcdo(i,k+1,ntke)+tem* + & (tke(i,k)+tke(i,k+1)))/factor + endif + endif + enddo + enddo +! +!---------------------------------------------------------------------- +! compute tridiagonal matrix elements for turbulent kinetic energy +! + do i=1,im + ad(i,1) = 1.0 + f1(i,1) = tke(i,1) + enddo +! + do k = 1,km1 + do i=1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dkq(i,k) * rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1)= 1.-al(i,k) + tem2 = dsig * rdz +! + if(pcnvflg(i) .and. k < kpbl(i)) then + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = tke(i,k) + tke(i,k+1) + ptem = qcko(i,k,ntke) + qcko(i,k+1,ntke) + f1(i,k) = f1(i,k)-(ptem-tem)*ptem1 + f1(i,k+1) = tke(i,k+1)+(ptem-tem)*ptem2 + else + f1(i,k+1) = tke(i,k+1) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem = 0.5 * tem2 * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = tke(i,k) + tke(i,k+1) + ptem = qcdo(i,k,ntke) + qcdo(i,k+1,ntke) + f1(i,k) = f1(i,k) + (ptem - tem) * ptem1 + f1(i,k+1) = f1(i,k+1) - (ptem - tem) * ptem2 + endif + endif +! + enddo + enddo +c +c solve tridiagonal problem for tke +c + call tridit(im,km,1,al,ad,au,f1,au,f1) +c +c recover tendency of tke +c + do k = 1,km + do i = 1,im +! f1(i,k) = max(f1(i,k), tkmin) + qtend = (f1(i,k)-q1(i,k,ntke))*rdt + rtg(i,k,ntke) = rtg(i,k,ntke)+qtend + enddo + enddo +c +c compute tridiagonal matrix elements for heat and moisture +c + do i=1,im + ad(i,1) = 1. + f1(i,1) = t1(i,1) + dtdz1(i) * heat(i) + f2(i,1) = q1(i,1,1) + dtdz1(i) * evap(i) + enddo + if(ntrac1 >= 2) then + do kk = 2, ntrac1 + is = (kk-1) * km + do i = 1, im + f2(i,1+is) = q1(i,1,kk) + enddo + enddo + endif +c + do k = 1,km1 + do i = 1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dkt(i,k) * rdz + dsdzt = tem1 * gocp + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1)= 1.-al(i,k) + tem2 = dsig * rdz +! + if(pcnvflg(i) .and. k < kpbl(i)) then + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = t1(i,k) + t1(i,k+1) + ptem = tcko(i,k) + tcko(i,k+1) + f1(i,k) = f1(i,k)+dtodsd*dsdzt-(ptem-tem)*ptem1 + f1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt+(ptem-tem)*ptem2 + tem = q1(i,k,1) + q1(i,k+1,1) + ptem = qcko(i,k,1) + qcko(i,k+1,1) + f2(i,k) = f2(i,k) - (ptem - tem) * ptem1 + f2(i,k+1) = q1(i,k+1,1) + (ptem - tem) * ptem2 + else + f1(i,k) = f1(i,k)+dtodsd*dsdzt + f1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + f2(i,k+1) = q1(i,k+1,1) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem = 0.5 * tem2 * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ptem = tcdo(i,k) + tcdo(i,k+1) + tem = t1(i,k) + t1(i,k+1) + f1(i,k) = f1(i,k) + (ptem - tem) * ptem1 + f1(i,k+1) = f1(i,k+1) - (ptem - tem) * ptem2 + tem = q1(i,k,1) + q1(i,k+1,1) + ptem = qcdo(i,k,1) + qcdo(i,k+1,1) + f2(i,k) = f2(i,k) + (ptem - tem) * ptem1 + f2(i,k+1) = f2(i,k+1) - (ptem - tem) * ptem2 + endif + endif + enddo + enddo +! + if(ntrac1 >= 2) then + do kk = 2, ntrac1 + is = (kk-1) * km + do k = 1, km1 + do i = 1, im + if(pcnvflg(i) .and. k < kpbl(i)) then + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + tem = dsig * rdzt(i,k) + ptem = 0.5 * tem * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem1 = qcko(i,k,kk) + qcko(i,k+1,kk) + tem2 = q1(i,k,kk) + q1(i,k+1,kk) + f2(i,k+is) = f2(i,k+is) - (tem1 - tem2) * ptem1 + f2(i,k+1+is)= q1(i,k+1,kk) + (tem1 - tem2) * ptem2 + else + f2(i,k+1+is) = q1(i,k+1,kk) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + tem = dsig * rdzt(i,k) + ptem = 0.5 * tem * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem1 = qcdo(i,k,kk) + qcdo(i,k+1,kk) + tem2 = q1(i,k,kk) + q1(i,k+1,kk) + f2(i,k+is) = f2(i,k+is) + (tem1 - tem2) * ptem1 + f2(i,k+1+is)= f2(i,k+1+is) - (tem1 - tem2) * ptem2 + endif + endif +! + enddo + enddo + enddo + endif +c +c solve tridiagonal problem for heat and moisture +c + call tridin(im,km,ntrac1,al,ad,au,f1,f2,au,f1,f2) +c +c recover tendencies of heat and moisture +c + do k = 1,km + do i = 1,im + ttend = (f1(i,k)-t1(i,k))*rdt + qtend = (f2(i,k)-q1(i,k,1))*rdt + tdt(i,k) = tdt(i,k)+ttend + rtg(i,k,1) = rtg(i,k,1)+qtend + dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend + dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend + enddo + enddo +! + if(ntrac1 >= 2) then + do kk = 2, ntrac1 + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (f2(i,k+is)-q1(i,k,kk))*rdt + rtg(i,k,kk) = rtg(i,k,kk)+qtend + enddo + enddo + enddo + endif +! +! add tke dissipative heating to temperature tendency +! + if(dspheat) then + do k = 1,km1 + do i = 1,im +! tem = min(diss(i,k), dspmax) +! ttend = tem / cp + ttend = diss(i,k) / cp + tdt(i,k) = tdt(i,k) + dspfac * ttend + enddo + enddo + endif +c +c compute tridiagonal matrix elements for momentum +c + do i=1,im + ad(i,1) = 1.0 + dtdz1(i) * stress(i) / spd1(i) + f1(i,1) = u1(i,1) + f2(i,1) = v1(i,1) + enddo +c + do k = 1,km1 + do i=1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dku(i,k) * rdz + dsdz2 = tem1*rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1)= 1.-al(i,k) + tem2 = dsig * rdz +! + if(pcnvflg(i) .and. k < kpbl(i)) then + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = u1(i,k) + u1(i,k+1) + ptem = ucko(i,k) + ucko(i,k+1) + f1(i,k) = f1(i,k) - (ptem - tem) * ptem1 + f1(i,k+1) = u1(i,k+1) + (ptem - tem) * ptem2 + tem = v1(i,k) + v1(i,k+1) + ptem = vcko(i,k) + vcko(i,k+1) + f2(i,k) = f2(i,k) - (ptem - tem) * ptem1 + f2(i,k+1) = v1(i,k+1) + (ptem - tem) * ptem2 + else + f1(i,k+1) = u1(i,k+1) + f2(i,k+1) = v1(i,k+1) + endif +! + if(scuflg(i)) then + if(k >= mrad(i) .and. k < krad(i)) then + ptem = 0.5 * tem2 * xmfd(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem = u1(i,k) + u1(i,k+1) + ptem = ucdo(i,k) + ucdo(i,k+1) + f1(i,k) = f1(i,k) + (ptem - tem) *ptem1 + f1(i,k+1) = f1(i,k+1) - (ptem - tem) *ptem2 + tem = v1(i,k) + v1(i,k+1) + ptem = vcdo(i,k) + vcdo(i,k+1) + f2(i,k) = f2(i,k) + (ptem - tem) * ptem1 + f2(i,k+1) = f2(i,k+1) - (ptem - tem) * ptem2 + endif + endif +! + enddo + enddo +c +c solve tridiagonal problem for momentum +c + call tridi2(im,km,al,ad,au,f1,f2,au,f1,f2) +c +c recover tendencies of momentum +c + do k = 1,km + do i = 1,im + utend = (f1(i,k)-u1(i,k))*rdt + vtend = (f2(i,k)-v1(i,k))*rdt + du(i,k) = du(i,k)+utend + dv(i,k) = dv(i,k)+vtend + dusfc(i) = dusfc(i)+conw*del(i,k)*utend + dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! pbl height for diagnostic purpose +! + do i = 1, im + hpbl(i) = hpblx(i) + kpbl(i) = kpblx(i) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + return + end subroutine satmedmfvdifq_run +!> @} + + end module satmedmfvdifq diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta new file mode 100644 index 000000000..ec679faec --- /dev/null +++ b/physics/satmedmfvdifq.meta @@ -0,0 +1,597 @@ +[ccpp-arg-table] + name = satmedmfvdifq_init + type = scheme +[isatmedmf] + standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of scale-aware TKE moist EDMF PBL scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[isatmedmf_vdifq] + standard_name = choice_of_updated_scale_aware_TKE_moist_EDMF_PBL + long_name = choice of updated scale-aware TKE moist EDMF PBL scheme + units = none + 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 = satmedmfvdifq_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + 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_vertical_diffusion_tracer + long_name = tracer index for ice water in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer + long_name = index for turbulent kinetic energy in the vertically diffused tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[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 +[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 +[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 +[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 +[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 +[fv] + 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 +[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 +[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 +[dv] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtg] + 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 +[u1] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + long_name = total sky shortwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + long_name = total sky longwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[garea] + 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 +[psk] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the surface interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rbsoil] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsea] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spd1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + 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 +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + 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 + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspheat] + standard_name = flag_TKE_dissipation_heating + long_name = flag for using TKE dissipation heating + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspfac] + standard_name = tke_dissipative_heating_factor + long_name = tke dissipative heating factor + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[bl_upfr] + standard_name = updraft_fraction_in_boundary_layer_mass_flux_scheme + long_name = updraft fraction in boundary layer mass flux scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[bl_dnfr] + standard_name = downdraft_fraction_in_boundary_layer_mass_flux_scheme + long_name = downdraft fraction in boundary layer mass flux scheme + 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 + 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 2d5a8e852743c6823e2613291555f63bcffd14dc Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 18 Nov 2019 14:31:12 -0700 Subject: [PATCH 37/84] physics/sascnvn.*, physics/shalcnv.*: add SAS deep and shallow convection schemes --- physics/sascnvn.F | 2155 ++++++++++++++++++++++++++++++++++++++++++ physics/sascnvn.meta | 583 ++++++++++++ physics/shalcnv.F | 1351 ++++++++++++++++++++++++++ physics/shalcnv.meta | 466 +++++++++ 4 files changed, 4555 insertions(+) create mode 100644 physics/sascnvn.F create mode 100644 physics/sascnvn.meta create mode 100644 physics/shalcnv.F create mode 100644 physics/shalcnv.meta diff --git a/physics/sascnvn.F b/physics/sascnvn.F new file mode 100644 index 000000000..79c1bdc36 --- /dev/null +++ b/physics/sascnvn.F @@ -0,0 +1,2155 @@ +!> \defgroup SAS Simplified Arakawa-Schubert Deep Convection +!! @{ +!! \brief The Simplified Arakawa-Schubert scheme parameterizes the effect of deep convection on the environment (represented by the model state variables) in the following way. First, a simple cloud model is used to determine the change in model state variables due to one entraining/detraining cloud type, per unit cloud-base mass flux. Next, the total change in state variables is retrieved by determining the actual cloud base mass flux using the quasi-equilibrium assumption, whereby convection is assumed to be steady-state. This implies that the generation of the cloud work function (interpreted as entrainment-moderated convective available potential energy (CAPE)) by the large scale dynamics is in balance with the consumption of the cloud work function by the convection. +!! +!! The SAS scheme uses the working concepts put forth in Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 but includes modifications and simplifications from Grell (1993) \cite grell_1993 such as saturated downdrafts and only one cloud type (the deepest possible), rather than a spectrum based on cloud top heights or assumed entrainment rates. The scheme was implemented for the GFS in 1995 by Pan and Wu \cite pan_and_wu_1995, with further modifications discussed in Han and Pan (2011) \cite han_and_pan_2011 , including the calculation of cloud top, a greater CFL-criterion-based maximum cloud base mass flux, updated cloud model entrainment and detrainment, improved convective transport of horizontal momentum, a more general triggering function, and the inclusion of convective overshooting. +!! +!! \section diagram Calling Hierarchy Diagram +!! \image html SAS_Flowchart.png "Diagram depicting how the SAS deep convection scheme is called from the GSM physics time loop" height=2cm +!! \section intraphysics Intraphysics Communication +!! This space is reserved for a description of how this scheme uses information from other scheme types and/or how information calculated in this scheme is used in other scheme types. + +!> \file sascnvn.F +!! Contains the entire SAS deep convection scheme. + module sascnvn + + implicit none + + private + + public :: sascnvn_init, sascnvn_run, sascnvn_finalize + + contains + +!! +!! \section arg_table_sascnvn_init Argument Table +!! \htmlinclude sascnvn_init.html +!! + subroutine sascnvn_init(imfdeepcnv,imfdeepcnv_sas,errmsg,errflg) +! + integer, intent(in) :: imfdeepcnv, imfdeepcnv_sas + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! + if (imfdeepcnv/=imfdeepcnv_sas) then + write(errmsg,'(*(a))') 'Logic error: sascnvn incompatible with',& + & ' value of imfdeepcnv' + errflg = 1 + return + endif +! + end subroutine sascnvn_init + +! \brief This subroutine is empty since there are no procedures that need to be done to finalize the sascnvn code. +!! +!! \section arg_table_sascnvn_finalize Argument Table +!! + subroutine sascnvn_finalize + end subroutine sascnvn_finalize + +!> \brief This subroutine contains the entirety of the SAS deep convection scheme. +!! +!! As in Grell (1993) \cite grell_1993 , the SAS convective scheme can be described in terms of three types of "controls": static, dynamic, and feedback. The static control component consists of the simple entraining/detraining updraft/downdraft cloud model and is used to determine the cloud properties, convective precipitation, as well as the convective cloud top height. The dynamic control is the determination of the potential energy available for convection to "consume", or how primed the large-scale environment is for convection to occur due to changes by the dyanmics of the host model. The feedback control is the determination of how the parameterized convection changes the large-scale environment (the host model state variables) given the changes to the state variables per unit cloud base mass flux calculated in the static control portion and the deduced cloud base mass flux determined from the dynamic control. +!! +!! \param[in] im number of used points +!! \param[in] ix horizontal dimension +!! \param[in] km vertical layer dimension +!! \param[in] jcap number of spectral wave trancation +!! \param[in] delt physics time step in seconds +!! \param[in] delp pressure difference between level k and k+1 (Pa) +!! \param[in] prslp mean layer presure (Pa) +!! \param[in] psp surface pressure (Pa) +!! \param[in] phil layer geopotential (\f$m^2/s^2\f$) +!! \param[inout] qlc cloud water (kg/kg) +!! \param[inout] qli ice (kg/kg) +!! \param[inout] q1 updated tracers (kg/kg) +!! \param[inout] t1 updated temperature (K) +!! \param[inout] u1 updated zonal wind (\f$m s^{-1}\f$) +!! \param[inout] v1 updated meridional wind (\f$m s^{-1}\f$) +!! \param[out] cldwrk cloud workfunction (\f$m^2/s^2\f$) +!! \param[out] rn convective rain (m) +!! \param[out] kbot index for cloud base +!! \param[out] ktop index for cloud top +!! \param[out] kcnv flag to denote deep convection (0=no, 1=yes) +!! \param[in] islimsk sea/land/ice mask (=0/1/2) +!! \param[in] dot layer mean vertical velocity (Pa/s) +!! \param[in] ncloud number of cloud species +!! \param[out] ud_mf updraft mass flux multiplied by time step (\f$kg/m^2\f$) +!! \param[out] dd_mf downdraft mass flux multiplied by time step (\f$kg/m^2\f$) +!! \param[out] dt_mf ud_mf at cloud top (\f$kg/m^2\f$) +!! \param[out] cnvw convective cloud water (kg/kg) +!! \param[out] cnvc convective cloud cover (unitless) +!! +!! \section general General Algorithm +!! -# Compute preliminary quantities needed for static, dynamic, and feedback control portions of the algorithm. +!! -# Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +!! -# Perform calculations related to the downdraft of the entraining/detraining cloud model ("static control"). +!! -# Using the updated temperature and moisture profiles that were modified by the convection on a short time-scale, recalculate the total cloud work function to determine the change in the cloud work function due to convection, or the stabilizing effect of the cumulus. +!! -# For the "dynamic control", using a reference cloud work function, estimate the change in cloud work function due to the large-scale dynamics. Following the quasi-equilibrium assumption, calculate the cloud base mass flux required to keep the large-scale convective destabilization in balance with the stabilization effect of the convection. +!! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!! \section detailed Detailed Algorithm +!! +!! \section arg_table_sascnvn_run Argument Table +!! \htmlinclude sascnvn_run.html +!! +!! @{ + subroutine sascnvn_run( + & grav,cp,hvap,rv,fv,t0c,rgas,cvap,cliq,eps,epsm1, & + & im,ix,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & + & q1,t1,u1,v1,cldwrk,rn,kbot,ktop,kcnv,islimsk, & + & dot,ncloud,ud_mf,dd_mf,dt_mf,cnvw,cnvc, & + & qlcn,qicn,w_upi,cf_upi,cnv_mfd, & + & cnv_dqldt,clcn,cnv_fice,cnv_ndrop,cnv_nice,mp_phys, & + & mp_phys_mg,clam,c0,c1,betal,betas,evfact,evfactl,pgcon, & + & errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs +! use physcons, grav => con_g, cp => con_cp, hvap => con_hvap & +! &, rv => con_rv, fv => con_fvirt, t0c => con_t0c & +! &, cvap => con_cvap, cliq => con_cliq & +! &, eps => con_eps, epsm1 => con_epsm1,rgas => con_rd + implicit none +! +! Interface variables +! + real(kind=kind_phys), intent(in) :: grav, cp, hvap, rv, fv, t0c, & + & rgas, cvap, cliq, eps, epsm1 + integer, intent(in) :: im, ix, km, jcap, ncloud, & + & mp_phys, mp_phys_mg + integer, intent(inout) :: kbot(:), ktop(:), kcnv(:) + integer, intent(in) :: islimsk(:) + real(kind=kind_phys), intent(in) :: delt, clam, c0, c1, pgcon + real(kind=kind_phys), intent(in) :: betal, betas, evfact, evfactl + real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & + & prslp(:,:), dot(:,:), & + & phil(:,:) + real(kind=kind_phys), intent(inout) :: & + & qlc(:,:), qli(:,:), & + & q1(:,:), t1(:,:), & + & u1(:,:), v1(:,:), & + & cnvw(:,:), cnvc(:,:) + real(kind=kind_phys), intent(out) :: cldwrk(:), rn(:), & + & ud_mf(:,:), dd_mf(:,:), & + & dt_mf(:,:) + real(kind=kind_phys), intent(inout) :: & + & qlcn(:,:), qicn(:,:), & + & w_upi(:,:), cnv_mfd(:,:), & + & cnv_dqldt(:,:), clcn(:,:), & + & cnv_fice(:,:), cnv_ndrop(:,:),& + & cnv_nice(:,:), cf_upi(:,:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! Local variables +! + integer i, indx, jmn, k, kk, km1 +! integer latd,lond +! + real(kind=kind_phys) cxlamu, xlamde, xlamdd +! +! real(kind=kind_phys) detad + real(kind=kind_phys) adw, aup, aafac, + & beta, + & dellat, delta, + & desdt, dg, + & dh, dhh, dp, + & dq, dqsdp, dqsdt, dt, + & dt2, dtmax, dtmin, dv1h, + & dv1q, dv2h, dv2q, dv1u, + & dv1v, dv2u, dv2v, dv3q, + & dv3h, dv3u, dv3v, + & dz, dz1, e1, edtmax, + & edtmaxl, edtmaxs, el2orc, elocp, + & es, etah, cthk, dthk, + & evef, fact1, + & fact2, factor, fjcap, fkm, + & g, gamma, pprime, + & qlk, qrch, qs, + & rain, rfact, shear, tem1, + & val, val1, + & val2, w1, w1l, w1s, + & w2, w2l, w2s, w3, + & w3l, w3s, w4, w4l, + & w4s, xdby, xpw, xpwd, + & xqrch, mbdt, tem, + & ptem, ptem1 +! + integer kb(im), kbcon(im), kbcon1(im), + & ktcon(im), ktcon1(im), + & jmin(im), lmin(im), kbmax(im), + & kbm(im), kmax(im) +! + real(kind=kind_phys) ps(im), del(ix,km), prsl(ix,km) +! + real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), + & delhbar(im), delq(im), delq2(im), + & delqbar(im), delqev(im), deltbar(im), + & deltv(im), dtconv(im), edt(im), + & edto(im), edtx(im), fld(im), + & hcdo(im,km), hmax(im), hmin(im), + & ucdo(im,km), vcdo(im,km),aa2(im), + & pbcdif(im), pdot(im), po(im,km), + & pwavo(im), pwevo(im), xlamud(im), + & qcdo(im,km), qcond(im), qevap(im), + & rntot(im), vshear(im), xaa0(im), + & xk(im), xlamd(im), + & xmb(im), xmbmax(im), xpwav(im), + & xpwev(im), delubar(im),delvbar(im) +! + real(kind=kind_phys) cincr, cincrmax, cincrmin +! +! physical parameters +! parameter(g=grav) +! parameter(elocp=hvap/cp, +! & el2orc=hvap*hvap/(rv*cp)) +! parameter(c0=.002,c1=.002,delta=fv) +! parameter(delta=fv) +! parameter(fact1=(cvap-cliq)/rv,fact2=hvap/rv-fact1*t0c) + parameter(cthk=150.,cincrmax=180.,cincrmin=120.,dthk=25.) +! + real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), + & uo(im,km), vo(im,km), qeso(im,km) +! cloud water +! real(kind=kind_phys) tvo(im,km) + real(kind=kind_phys) qlko_ktcon(im), dellal(im,km), tvo(im,km), + & dbyo(im,km), zo(im,km), xlamue(im,km), + & fent1(im,km), fent2(im,km), frh(im,km), + & heo(im,km), heso(im,km), + & qrcd(im,km), dellah(im,km), dellaq(im,km), + & dellau(im,km), dellav(im,km), hcko(im,km), + & ucko(im,km), vcko(im,km), qcko(im,km), + & eta(im,km), etad(im,km), zi(im,km), + & qrcko(im,km), qrcdo(im,km), + & pwo(im,km), pwdo(im,km), + & tx1(im), sumx(im), cnvwt(im,km) +! &, rhbar(im) +! + logical totflg, cnvflg(im), flg(im) +! + real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) +! save pcrit, acritt + data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., + & 350.,300.,250.,200.,150./ + data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, + & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ +! gdas derived acrit +! data acritt/.203,.515,.521,.566,.625,.665,.659,.688, +! & .743,.813,.886,.947,1.138,1.377,1.896/ + real(kind=kind_phys) tf, tcr, tcrf + parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) +! +!----------------------------------------------------------------------- +!************************************************************************ +! replace (derived) constants above with regular variables + g = grav + elocp = hvap/cp + el2orc = hvap*hvap/(rv*cp) + delta = fv + fact1 = (cvap-cliq)/rv + fact2 = hvap/rv-fact1*t0c +!************************************************************************ +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!************************************************************************ +!> ## Compute preliminary quantities needed for static, dynamic, and feedback control portions of the algorithm. +!> - Convert input pressure terms to centibar units. +!************************************************************************ +! convert input pa terms to cb terms -- moorthi + ps = psp * 0.001 + prsl = prslp * 0.001 + del = delp * 0.001 +!************************************************************************ +! +! + km1 = km - 1 +!> - Initialize column-integrated and other single-value-per-column variable arrays. +! +! initialize arrays +! + do i=1,im + cnvflg(i) = .true. + rn(i)=0. + kbot(i)=km+1 + ktop(i)=0 + kbcon(i)=km + ktcon(i)=1 + dtconv(i) = 3600. + cldwrk(i) = 0. + pdot(i) = 0. + pbcdif(i)= 0. + lmin(i) = 1 + jmin(i) = 1 + qlko_ktcon(i) = 0. + edt(i) = 0. + edto(i) = 0. + edtx(i) = 0. + acrt(i) = 0. + acrtfct(i) = 1. + aa1(i) = 0. + aa2(i) = 0. + xaa0(i) = 0. + pwavo(i)= 0. + pwevo(i)= 0. + xpwav(i)= 0. + xpwev(i)= 0. + vshear(i) = 0. + enddo +!> - Initialize convective cloud water and cloud cover to zero. + do k = 1, km + do i = 1, im + cnvw(i,k) = 0. + cnvc(i,k) = 0. + enddo + enddo +!> - Initialize updraft, downdraft, detrainment mass fluxes to zero. +! hchuang code change + do k = 1, km + do i = 1, im + ud_mf(i,k) = 0. + dd_mf(i,k) = 0. + dt_mf(i,k) = 0. + if(mp_phys == mp_phys_mg) then + qlcn(i,k) = 0.0 + qicn(i,k) = 0.0 + w_upi(i,k) = 0.0 + cf_upi(i,k) = 0.0 + cnv_mfd(i,k) = 0.0 +! cnv_prc3(i,k) = 0.0 + cnv_dqldt(i,k) = 0.0 + clcn(i,k) = 0.0 + cnv_fice(i,k) = 0.0 + cnv_ndrop(i,k) = 0.0 + cnv_nice(i,k) = 0.0 + end if + enddo + enddo +!> - Initialize the reference cloud work function, define min/max convective adjustment timescales, and tunable parameters. +! + do k = 1, 15 + acrit(k) = acritt(k) * (975. - pcrit(k)) + enddo + dt2 = delt + val = 1200. + dtmin = max(dt2, val ) + val = 3600. + dtmax = max(dt2, val ) +! model tunable parameters are all here + mbdt = 10. + edtmaxl = .3 + edtmaxs = .3 +! clam = .1 + aafac = .1 +! betal = .15 +! betas = .15 +! betal = .05 +! betas = .05 +! evef = 0.07 +! evfact = 0.3 +! evfactl = 0.3 +! + cxlamu = 1.0e-4 + xlamde = 1.0e-4 + xlamdd = 1.0e-4 +! +! pgcon = 0.7 ! gregory et al. (1997, qjrms) +! pgcon = 0.55 ! zhang & wu (2003,jas) + fjcap = (float(jcap) / 126.) ** 2 + val = 1. + fjcap = max(fjcap,val) + fkm = (float(km) / 28.) ** 2 + fkm = max(fkm,val) + w1l = -8.e-3 + w2l = -4.e-2 + w3l = -5.e-3 + w4l = -5.e-4 + w1s = -2.e-4 + w2s = -2.e-3 + w3s = -1.e-3 + w4s = -2.e-5 +!> - Determine maximum indices for the parcel starting point (kbm), LFC (kbmax), and cloud top (kmax). +! +! define top layer for search of the downdraft originating layer +! and the maximum thetae for updraft +! + do i=1,im + kbmax(i) = km + kbm(i) = km + kmax(i) = km + tx1(i) = 1.0 / ps(i) + enddo +! + do k = 1, km + do i=1,im + if (prsl(i,k)*tx1(i) .gt. 0.04) kmax(i) = k + 1 + if (prsl(i,k)*tx1(i) .gt. 0.45) kbmax(i) = k + 1 + if (prsl(i,k)*tx1(i) .gt. 0.70) kbm(i) = k + 1 + enddo + enddo + do i=1,im + kmax(i) = min(km,kmax(i)) + kbmax(i) = min(kbmax(i),kmax(i)) + kbm(i) = min(kbm(i),kmax(i)) + enddo +! +! hydrostatic height assume zero terr and initially assume +! updraft entrainment rate as an inverse function of height +! +!> - Calculate hydrostatic height at layer centers assuming a flat surface (no terrain) from the geopotential. + do k = 1, km + do i=1,im + zo(i,k) = phil(i,k) / g + enddo + enddo +!> - Calculate interface height and the initial entrainment rate as an inverse function of height. + do k = 1, km1 + do i=1,im + zi(i,k) = 0.5*(zo(i,k)+zo(i,k+1)) + xlamue(i,k) = clam / zi(i,k) + enddo + enddo +!> - Convert prsl from centibar to millibar, set normalized mass fluxes to 1, cloud properties to 0, and save model state variables (after advection/turbulence). +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! convert surface pressure to mb from cb +! + do k = 1, km + do i = 1, im + if (k .le. kmax(i)) then + pfld(i,k) = prsl(i,k) * 10.0 + eta(i,k) = 1. + fent1(i,k)= 1. + fent2(i,k)= 1. + frh(i,k) = 0. + hcko(i,k) = 0. + qcko(i,k) = 0. + qrcko(i,k)= 0. + ucko(i,k) = 0. + vcko(i,k) = 0. + etad(i,k) = 1. + hcdo(i,k) = 0. + qcdo(i,k) = 0. + ucdo(i,k) = 0. + vcdo(i,k) = 0. + qrcd(i,k) = 0. + qrcdo(i,k)= 0. + dbyo(i,k) = 0. + pwo(i,k) = 0. + pwdo(i,k) = 0. + dellal(i,k) = 0. + to(i,k) = t1(i,k) + qo(i,k) = q1(i,k) + uo(i,k) = u1(i,k) + vo(i,k) = v1(i,k) +! uo(i,k) = u1(i,k) * rcs(i) +! vo(i,k) = v1(i,k) * rcs(i) + cnvwt(i,k)= 0. + endif + enddo + enddo +! +! column variables +! p is pressure of the layer (mb) +! t is temperature at t-dt (k)..tn +! q is mixing ratio at t-dt (kg/kg)..qn +! to is temperature at t+dt (k)... this is after advection and turbulan +! qo is mixing ratio at t+dt (kg/kg)..q1 +! +!> - Calculate saturation mixing ratio and enforce minimum moisture values. + do k = 1, km + do i=1,im + if (k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) +! tvo(i,k) = to(i,k) + delta * to(i,k) * qo(i,k) + endif + enddo + enddo +! +! compute moist static energy +! +!> - Calculate moist static energy (heo) and saturation moist static energy (heso). + do k = 1, km + do i=1,im + if (k .le. kmax(i)) then +! tem = g * zo(i,k) + cp * to(i,k) + tem = phil(i,k) + cp * to(i,k) + heo(i,k) = tem + hvap * qo(i,k) + heso(i,k) = tem + hvap * qeso(i,k) +! heo(i,k) = min(heo(i,k),heso(i,k)) + endif + enddo + enddo + +!> ## Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +! +! determine level with largest moist static energy +! this is the level where updraft starts +! +!> - Search below index "kbm" for the level of maximum moist static energy. + do i=1,im + hmax(i) = heo(i,1) + kb(i) = 1 + enddo + do k = 2, km + do i=1,im + if (k .le. kbm(i)) then + if(heo(i,k).gt.hmax(i)) then + kb(i) = k + hmax(i) = heo(i,k) + endif + endif + enddo + enddo +!> - Calculate the temperature, water vapor mixing ratio, and pressure at interface levels. +! + do k = 1, km1 + do i=1,im + if (k .le. kmax(i)-1) then + dz = .5 * (zo(i,k+1) - zo(i,k)) + dp = .5 * (pfld(i,k+1) - pfld(i,k)) + es = 0.01 * fpvs(to(i,k+1)) ! fpvs is in pa + pprime = pfld(i,k+1) + epsm1 * es + qs = eps * es / pprime + dqsdp = - qs / pprime + desdt = es * (fact1 / to(i,k+1) + fact2 / (to(i,k+1)**2)) + dqsdt = qs * pfld(i,k+1) * desdt / (es * pprime) + gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) + dt = (g * dz + hvap * dqsdp * dp) / (cp * (1. + gamma)) + dq = dqsdt * dt + dqsdp * dp + to(i,k) = to(i,k+1) + dt + qo(i,k) = qo(i,k+1) + dq + po(i,k) = .5 * (pfld(i,k) + pfld(i,k+1)) + endif + enddo + enddo +!> - Recalculate saturation mixing ratio, moist static energy, saturation moist static energy, and horizontal momentum on interface levels. Enforce minimum mixing ratios and calculate \f$(1 - RH)\f$. +! + do k = 1, km1 + do i=1,im + if (k .le. kmax(i)-1) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (po(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) + frh(i,k) = 1. - min(qo(i,k)/qeso(i,k), 1.) + heo(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qeso(i,k) + uo(i,k) = .5 * (uo(i,k) + uo(i,k+1)) + vo(i,k) = .5 * (vo(i,k) + vo(i,k+1)) + endif + enddo + enddo +! +! look for the level of free convection as cloud base +! +!> - Search below the index "kbmax" for the level of free convection (LFC) where the condition \f$h_b > h^*\f$ is first met, where \f$h_b, h^*\f$ are the state moist static energy at the parcel's starting level and saturation moist static energy, respectively. Set "kbcon" to the index of the LFC. + do i=1,im + flg(i) = .true. + kbcon(i) = kmax(i) + enddo + do k = 1, km1 + do i=1,im + if (flg(i).and.k.le.kbmax(i)) then + if(k.gt.kb(i).and.heo(i,kb(i)).gt.heso(i,k)) then + kbcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +!> - If no LFC, return to the calling routine without modifying state variables. +! + do i=1,im + if(kbcon(i).eq.kmax(i)) cnvflg(i) = .false. + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine critical convective inhibition +! as a function of vertical velocity at cloud base. +! +!> - Determine the vertical pressure velocity at the LFC. After Han and Pan (2011) \cite han_and_pan_2011 , determine the maximum pressure thickness between a parcel's starting level and the LFC. If a parcel doesn't reach the LFC within the critical thickness, then the convective inhibition is deemed too great for convection to be triggered, and the subroutine returns to the calling routine without modifying the state variables. + do i=1,im + if(cnvflg(i)) then +! pdot(i) = 10.* dot(i,kbcon(i)) + pdot(i) = 0.01 * dot(i,kbcon(i)) ! now dot is in pa/s + endif + enddo + do i=1,im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif + if(pdot(i).le.w4) then + tem = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i).ge.-w4) then + tem = - (pdot(i) + w4) / (w4 - w3) + else + tem = 0. + endif + val1 = -1. + tem = max(tem,val1) + val2 = 1. + tem = min(tem,val2) + tem = 1. - tem + tem1= .5*(cincrmax-cincrmin) + cincr = cincrmax - tem * tem1 + pbcdif(i) = pfld(i,kb(i)) - pfld(i,kbcon(i)) + if(pbcdif(i).gt.cincr) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! assume that updraft entrainment rate above cloud base is +! same as that at cloud base +! +!> - Calculate the entrainment rate according to Han and Pan (2011) \cite han_and_pan_2011 , equation 8, after Bechtold et al. (2008) \cite bechtold_et_al_2008, equation 2 given by: +!! \f[ +!! \epsilon = \epsilon_0F_0 + d_1\left(1-RH\right)F_1 +!! \f] +!! where \f$\epsilon_0\f$ is the cloud base entrainment rate, \f$d_1\f$ is a tunable constant, and \f$F_0=\left(\frac{q_s}{q_{s,b}}\right)^2\f$ and \f$F_1=\left(\frac{q_s}{q_{s,b}}\right)^3\f$ where \f$q_s\f$ and \f$q_{s,b}\f$ are the saturation specific humidities at a given level and cloud base, respectively. The detrainment rate in the cloud is assumed to be equal to the entrainment rate at cloud base. + do k = 2, km1 + do i=1,im + if(cnvflg(i).and. + & (k.gt.kbcon(i).and.k.lt.kmax(i))) then + xlamue(i,k) = xlamue(i,kbcon(i)) + endif + enddo + enddo +! +! assume the detrainment rate for the updrafts to be same as +! the entrainment rate at cloud base +! +!> - The updraft detrainment rate is set constant and equal to the entrainment rate at cloud base. + do i = 1, im + if(cnvflg(i)) then + xlamud(i) = xlamue(i,kbcon(i)) + endif + enddo +! +! functions rapidly decreasing with height, mimicking a cloud ensemble +! (bechtold et al., 2008) +! + do k = 2, km1 + do i=1,im + if(cnvflg(i).and. + & (k.gt.kbcon(i).and.k.lt.kmax(i))) then + tem = qeso(i,k)/qeso(i,kbcon(i)) + fent1(i,k) = tem**2 + fent2(i,k) = tem**3 + endif + enddo + enddo +! +! final entrainment rate as the sum of turbulent part and organized entrainment +! depending on the environmental relative humidity +! (bechtold et al., 2008) +! + do k = 2, km1 + do i=1,im + if(cnvflg(i).and. + & (k.ge.kbcon(i).and.k.lt.kmax(i))) then + tem = cxlamu * frh(i,k) * fent2(i,k) + xlamue(i,k) = xlamue(i,k)*fent1(i,k) + tem + endif + enddo + enddo +! +! determine updraft mass flux for the subcloud layers +! +!> - Calculate the normalized mass flux for subcloud and in-cloud layers according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 1: +!! \f[ +!! \frac{1}{\eta}\frac{\partial \eta}{\partial z} = \lambda_e - \lambda_d +!! \f] +!! where \f$\eta\f$ is the normalized mass flux, \f$\lambda_e\f$ is the entrainment rate and \f$\lambda_d\f$ is the detrainment rate. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i)) then + if(k.lt.kbcon(i).and.k.ge.kb(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k+1))-xlamud(i) + eta(i,k) = eta(i,k+1) / (1. + ptem * dz) + endif + endif + enddo + enddo +! +! compute mass flux above cloud base +! + do k = 2, km1 + do i = 1, im + if(cnvflg(i))then + if(k.gt.kbcon(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k-1))-xlamud(i) + eta(i,k) = eta(i,k-1) * (1 + ptem * dz) + endif + endif + enddo + enddo +! +! compute updraft cloud properties +! +!> - Set initial cloud properties equal to the state variables at cloud base. + do i = 1, im + if(cnvflg(i)) then + indx = kb(i) + hcko(i,indx) = heo(i,indx) + ucko(i,indx) = uo(i,indx) + vcko(i,indx) = vo(i,indx) + pwavo(i) = 0. + endif + enddo +! +! cloud property is modified by the entrainment process +! +!> - Calculate the cloud properties as a parcel ascends, modified by entrainment and detrainment. Discretization follows Appendix B of Grell (1993) \cite grell_1993 . Following Han and Pan (2006) \cite han_and_pan_2006, the convective momentum transport is reduced by the convection-induced pressure gradient force by the constant "pgcon", currently set to 0.55 after Zhang and Wu (2003) \cite zhang_and_wu_2003 . + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + ptem = 0.5 * tem + pgcon + ptem1= 0.5 * tem - pgcon + hcko(i,k) = ((1.-tem1)*hcko(i,k-1)+tem*0.5* + & (heo(i,k)+heo(i,k-1)))/factor + ucko(i,k) = ((1.-tem1)*ucko(i,k-1)+ptem*uo(i,k) + & +ptem1*uo(i,k-1))/factor + vcko(i,k) = ((1.-tem1)*vcko(i,k-1)+ptem*vo(i,k) + & +ptem1*vo(i,k-1))/factor + dbyo(i,k) = hcko(i,k) - heso(i,k) + endif + endif + enddo + enddo +! +! taking account into convection inhibition due to existence of +! dry layers below cloud base +! +!> - With entrainment, recalculate the LFC as the first level where buoyancy is positive. The difference in pressure levels between LFCs calculated with/without entrainment must be less than a threshold (currently 25 hPa). Otherwise, convection is inhibited and the scheme returns to the calling routine without modifying the state variables. This is the subcloud dryness trigger modification discussed in Han and Pan (2011) \cite han_and_pan_2011. + do i=1,im + flg(i) = cnvflg(i) + kbcon1(i) = kmax(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k.lt.kmax(i)) then + if(k.ge.kbcon(i).and.dbyo(i,k).gt.0.) then + kbcon1(i) = k + flg(i) = .false. + endif + endif + enddo + enddo + do i=1,im + if(cnvflg(i)) then + if(kbcon1(i).eq.kmax(i)) cnvflg(i) = .false. + endif + enddo + do i=1,im + if(cnvflg(i)) then + tem = pfld(i,kbcon(i)) - pfld(i,kbcon1(i)) + if(tem.gt.dthk) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i = 1, im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine first guess cloud top as the level of zero buoyancy +! +!> - Calculate the cloud top as the first level where parcel buoyancy becomes negative. If the thickness of the calculated convection is less than a threshold (currently 150 hPa), then convection is inhibited, and the scheme returns to the calling routine. + do i = 1, im + flg(i) = cnvflg(i) + ktcon(i) = 1 + enddo + do k = 2, km1 + do i = 1, im + if (flg(i).and.k .lt. kmax(i)) then + if(k.gt.kbcon1(i).and.dbyo(i,k).lt.0.) then + ktcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +! + do i = 1, im + if(cnvflg(i)) then + tem = pfld(i,kbcon(i))-pfld(i,ktcon(i)) + if(tem.lt.cthk) cnvflg(i) = .false. + endif + enddo +!! + totflg = .true. + do i = 1, im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! search for downdraft originating level above theta-e minimum +! +!> - To originate the downdraft, search for the level above the minimum in moist static energy. Return to the calling routine without modification if this level is determined to be outside of the convective cloud layers. + do i = 1, im + if(cnvflg(i)) then + hmin(i) = heo(i,kbcon1(i)) + lmin(i) = kbmax(i) + jmin(i) = kbmax(i) + endif + enddo + do k = 2, km1 + do i = 1, im + if (cnvflg(i) .and. k .le. kbmax(i)) then + if(k.gt.kbcon1(i).and.heo(i,k).lt.hmin(i)) then + lmin(i) = k + 1 + hmin(i) = heo(i,k) + endif + endif + enddo + enddo +! +! make sure that jmin(i) is within the cloud +! + do i = 1, im + if(cnvflg(i)) then + jmin(i) = min(lmin(i),ktcon(i)-1) + jmin(i) = max(jmin(i),kbcon1(i)+1) + if(jmin(i).ge.ktcon(i)) cnvflg(i) = .false. + endif + enddo +! +! specify upper limit of mass flux at cloud base +! +!> - Calculate the maximum value of the cloud base mass flux using the CFL-criterion-based formula of Han and Pan (2011) \cite han_and_pan_2011, equation 7. + do i = 1, im + if(cnvflg(i)) then +! xmbmax(i) = .1 +! + k = kbcon(i) + dp = 1000. * del(i,k) + xmbmax(i) = dp / (g * dt2) +! +! tem = dp / (g * dt2) +! xmbmax(i) = min(tem, xmbmax(i)) + endif + enddo +! +! compute cloud moisture property and precipitation +! +!> - Initialize the cloud moisture at cloud base and set the cloud work function to zero. + do i = 1, im + if (cnvflg(i)) then + aa1(i) = 0. + qcko(i,kb(i)) = qo(i,kb(i)) + qrcko(i,kb(i)) = qo(i,kb(i)) +! rhbar(i) = 0. + endif + enddo +!> - Calculate the moisture content of the entraining/detraining parcel (qcko) and the value it would have if just saturated (qrch), according to equation A.14 in Grell (1993) \cite grell_1993 . Their difference is the amount of convective cloud water (qlk = rain + condensate). Determine the portion of convective cloud water that remains suspended and the portion that is converted into convective precipitation (pwo). Calculate and save the negative cloud work function (aa1) due to water loading. The liquid water in the updraft layer is assumed to be detrained from the layers above the level of the minimum moist static energy into the grid-scale cloud water (dellal). + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +! + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) +! +! check if there is excess moisture to release latent heat +! + if(k.ge.kbcon(i).and.dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + dp = 1000. * del(i,k) + if(ncloud.gt.0..and.k.gt.jmin(i)) then + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + aa1(i) = aa1(i) - dz * g * qlk + qcko(i,k) = qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + pwavo(i) = pwavo(i) + pwo(i,k) +! cnvwt(i,k) = (etah*qlk + pwo(i,k)) * g / dp + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! do i = 1, im +! if(cnvflg(i)) then +! indx = ktcon(i) - kb(i) - 1 +! rhbar(i) = rhbar(i) / float(indx) +! endif +! enddo +! +! calculate cloud work function +! +!> - Calculate the cloud work function according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 4: +!! \f[ +!! A_u=\int_{z_0}^{z_t}\frac{g}{c_pT(z)}\frac{\eta}{1 + \gamma}[h(z)-h^*(z)]dz +!! \f] +!! (discretized according to Grell (1993) \cite grell_1993 equation B.10 using B.2 and B.3 of Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 and assuming \f$\eta=1\f$) where \f$A_u\f$ is the updraft cloud work function, \f$z_0\f$ and \f$z_t\f$ are cloud base and cloud top, respectively, \f$\gamma = \frac{L}{c_p}\left(\frac{\partial \overline{q_s}}{\partial T}\right)_p\f$ and other quantities are previously defined. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.kbcon(i).and.k.lt.ktcon(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa1(i) = aa1(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + val = 0. + aa1(i)=aa1(i)+ + & dz1 * g * delta * + & max(val,(qeso(i,k) - qo(i,k))) + endif + endif + enddo + enddo +!> - If the updraft cloud work function is negative, convection does not occur, and the scheme returns to the calling routine. + do i = 1, im + if(cnvflg(i).and.aa1(i).le.0.) cnvflg(i) = .false. + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! estimate the onvective overshooting as the level +! where the [aafac * cloud work function] becomes zero, +! which is the final cloud top +! +!> - Continue calculating the cloud work function past the point of neutral buoyancy to represent overshooting according to Han and Pan (2011) \cite han_and_pan_2011 . Convective overshooting stops when \f$ cA_u < 0\f$ where \f$c\f$ is currently 10%, or when 10% of the updraft cloud work function has been consumed by the stable buoyancy force. + do i = 1, im + if (cnvflg(i)) then + aa2(i) = aafac * aa1(i) + endif + enddo +! + do i = 1, im + flg(i) = cnvflg(i) + ktcon1(i) = kmax(i) - 1 + enddo + do k = 2, km1 + do i = 1, im + if (flg(i)) then + if(k.ge.ktcon(i).and.k.lt.kmax(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa2(i) = aa2(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + if(aa2(i).lt.0.) then + ktcon1(i) = k + flg(i) = .false. + endif + endif + endif + enddo + enddo +! +! compute cloud moisture property, detraining cloud water +! and precipitation in overshooting layers +! +!> - For the overshooting convection, calculate the moisture content of the entraining/detraining parcel as before. Partition convective cloud water and precipitation and detrain convective cloud water above the mimimum in moist static energy. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.ktcon(i).and.k.lt.ktcon1(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +! + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + dp = 1000. * del(i,k) + if(ncloud.gt.0.) then + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + qcko(i,k) = qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + pwavo(i) = pwavo(i) + pwo(i,k) +! cnvwt(i,k) = (etah*qlk + pwo(i,k)) * g / dp + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! exchange ktcon with ktcon1 +! +!> - Swap the indices of the convective cloud top (ktcon) and the overshooting convection top (ktcon1) to use the same cloud top level in the calculations of \f$A^+\f$ and \f$A^*\f$. + do i = 1, im + if(cnvflg(i)) then + kk = ktcon(i) + ktcon(i) = ktcon1(i) + ktcon1(i) = kk + endif + enddo +! +! this section is ready for cloud water +! +!> - Separate the total updraft cloud water at cloud top into vapor and condensate. + if(ncloud.gt.0) then +! +! compute liquid and vapor separation at cloud top +! + do i = 1, im + if(cnvflg(i)) then + k = ktcon(i) - 1 + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) + dq = qcko(i,k) - qrch +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + qlko_ktcon(i) = dq + qcko(i,k) = qrch + endif + endif + enddo + endif +! +! if(lat.eq.latd.and.lon.eq.lond.and.cnvflg(i)) then +! print *, ' aa1(i) before dwndrft =', aa1(i) +! endif +! +!------- downdraft calculations +! +!--- compute precipitation efficiency in terms of windshear +! +!> ## Perform calculations related to the downdraft of the entraining/detraining cloud model ("static control"). +!! - First, in order to calculate the downdraft mass flux (as a fraction of the updraft mass flux), calculate the wind shear and precipitation efficiency according to equation 58 in Fritsch and Chappell (1980) \cite fritsch_and_chappell_1980 : +!! \f[ +!! E = 1.591 - 0.639\frac{\Delta V}{\Delta z} + 0.0953\left(\frac{\Delta V}{\Delta z}\right)^2 - 0.00496\left(\frac{\Delta V}{\Delta z}\right)^3 +!! \f] +!! where \f$\Delta V\f$ is the integrated horizontal shear over the cloud depth, \f$\Delta z\f$, (the ratio is converted to units of \f$10^{-3} s^{-1}\f$). The variable "edto" is \f$1-E\f$ and is constrained to the range \f$[0,0.9]\f$. + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 0. + endif + enddo + do k = 2, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + shear= sqrt((uo(i,k)-uo(i,k-1)) ** 2 + & + (vo(i,k)-vo(i,k-1)) ** 2) + vshear(i) = vshear(i) + shear + endif + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 1.e3 * vshear(i) / (zi(i,ktcon(i))-zi(i,kb(i))) + e1=1.591-.639*vshear(i) + & +.0953*(vshear(i)**2)-.00496*(vshear(i)**3) + edt(i)=1.-e1 + val = .9 + edt(i) = min(edt(i),val) + val = .0 + edt(i) = max(edt(i),val) + edto(i)=edt(i) + edtx(i)=edt(i) + endif + enddo +! +! determine detrainment rate between 1 and kbcon +! +!> - Next, calculate the variable detrainment rate between the surface and the LFC according to: +!! \f[ +!! \lambda_d = \frac{1-\beta^{\frac{1}{k_{LFC}}}}{\overline{\Delta z}} +!! \f] +!! \f$\lambda_d\f$ is the detrainment rate, \f$\beta\f$ is a constant currently set to 0.05, \f$k_{LFC}\f$ is the vertical index of the LFC level, and \f$\overline{\Delta z}\f$ is the average vertical grid spacing below the LFC. + do i = 1, im + if(cnvflg(i)) then + sumx(i) = 0. + endif + enddo + do k = 1, km1 + do i = 1, im + if(cnvflg(i).and.k.ge.1.and.k.lt.kbcon(i)) then + dz = zi(i,k+1) - zi(i,k) + sumx(i) = sumx(i) + dz + endif + enddo + enddo + do i = 1, im + beta = betas + if(islimsk(i) == 1) beta = betal + if(cnvflg(i)) then + dz = (sumx(i)+zi(i,1))/float(kbcon(i)) + tem = 1./float(kbcon(i)) + xlamd(i) = (1.-beta**tem)/dz + endif + enddo +! +! determine downdraft mass flux +! +!> - Calculate the normalized downdraft mass flux from equation 1 of Pan and Wu (1995) \cite pan_and_wu_1995 . Downdraft entrainment and detrainment rates are constants from the downdraft origination to the LFC. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)-1) then + if(k.lt.jmin(i).and.k.ge.kbcon(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = xlamdd - xlamde + etad(i,k) = etad(i,k+1) * (1. - ptem * dz) + else if(k.lt.kbcon(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = xlamd(i) + xlamdd - xlamde + etad(i,k) = etad(i,k+1) * (1. - ptem * dz) + endif + endif + enddo + enddo +! +!--- downdraft moisture properties +! +!> - Set initial cloud downdraft properties equal to the state variables at the downdraft origination level. + do i = 1, im + if(cnvflg(i)) then + jmn = jmin(i) + hcdo(i,jmn) = heo(i,jmn) + qcdo(i,jmn) = qo(i,jmn) + qrcdo(i,jmn)= qo(i,jmn) + ucdo(i,jmn) = uo(i,jmn) + vcdo(i,jmn) = vo(i,jmn) + pwevo(i) = 0. + endif + enddo +!j +!> - Calculate the cloud properties as a parcel descends, modified by entrainment and detrainment. Discretization follows Appendix B of Grell (1993) \cite grell_1993 . + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k.lt.jmin(i)) then + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + ptem = 0.5 * tem - pgcon + ptem1= 0.5 * tem + pgcon + hcdo(i,k) = ((1.-tem1)*hcdo(i,k+1)+tem*0.5* + & (heo(i,k)+heo(i,k+1)))/factor + ucdo(i,k) = ((1.-tem1)*ucdo(i,k+1)+ptem*uo(i,k+1) + & +ptem1*uo(i,k))/factor + vcdo(i,k) = ((1.-tem1)*vcdo(i,k+1)+ptem*vo(i,k+1) + & +ptem1*vo(i,k))/factor + dbyo(i,k) = hcdo(i,k) - heso(i,k) + endif + enddo + enddo +! +!> - Compute the amount of moisture that is necessary to keep the downdraft saturated. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i).and.k.lt.jmin(i)) then + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrcdo(i,k) = qeso(i,k)+ + & (1./hvap)*(gamma/(1.+gamma))*dbyo(i,k) +! detad = etad(i,k+1) - etad(i,k) +! + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + qcdo(i,k) = ((1.-tem1)*qrcdo(i,k+1)+tem*0.5* + & (qo(i,k)+qo(i,k+1)))/factor +! +! pwdo(i,k) = etad(i,k+1) * qcdo(i,k+1) - +! & etad(i,k) * qrcdo(i,k) +! pwdo(i,k) = pwdo(i,k) - detad * +! & .5 * (qrcdo(i,k) + qrcdo(i,k+1)) +! + pwdo(i,k) = etad(i,k) * (qcdo(i,k) - qrcdo(i,k)) + pwevo(i) = pwevo(i) + pwdo(i,k) + endif + enddo + enddo +! +!--- final downdraft strength dependent on precip +!--- efficiency (edt), normalized condensate (pwav), and +!--- evaporate (pwev) +! +!> - Update the precipitation efficiency (edto) based on the ratio of normalized cloud condensate (pwavo) to normalized cloud evaporate (pwevo). + do i = 1, im + edtmax = edtmaxl + if(islimsk(i) == 0) edtmax = edtmaxs + if(cnvflg(i)) then + if(pwevo(i).lt.0.) then + edto(i) = -edto(i) * pwavo(i) / pwevo(i) + edto(i) = min(edto(i),edtmax) + else + edto(i) = 0. + endif + endif + enddo +! +!--- downdraft cloudwork functions +! +!> - Calculate downdraft cloud work function (\f$A_d\f$) according to equation A.42 (discretized by B.11) in Grell (1993) \cite grell_1993 . Add it to the updraft cloud work function, \f$A_u\f$. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .lt. jmin(i)) then + gamma = el2orc * qeso(i,k) / to(i,k)**2 + dhh=hcdo(i,k) + dt=to(i,k) + dg=gamma + dh=heso(i,k) + dz=-1.*(zo(i,k+1)-zo(i,k)) + aa1(i)=aa1(i)+edto(i)*dz*(g/(cp*dt))*((dhh-dh)/(1.+dg)) + & *(1.+delta*cp*dg*dt/hvap) + val=0. + aa1(i)=aa1(i)+edto(i)* + & dz*g*delta*max(val,(qeso(i,k)-qo(i,k))) + endif + enddo + enddo +!> - Check for negative total cloud work function; if found, return to calling routine without modifying state variables. + do i = 1, im + if(cnvflg(i).and.aa1(i).le.0.) then + cnvflg(i) = .false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!--- what would the change be, that a cloud with unit mass +!--- will do to the environment? +! +!> - Calculate the change in moist static energy, moisture mixing ratio, and horizontal winds per unit cloud base mass flux near the surface using equations B.18 and B.19 from Grell (1993) \cite grell_1993, for all layers below cloud top from equations B.14 and B.15, and for the cloud top from B.16 and B.17. + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)) then + dellah(i,k) = 0. + dellaq(i,k) = 0. + dellau(i,k) = 0. + dellav(i,k) = 0. + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + dp = 1000. * del(i,1) + dellah(i,1) = edto(i) * etad(i,1) * (hcdo(i,1) + & - heo(i,1)) * g / dp + dellaq(i,1) = edto(i) * etad(i,1) * (qrcdo(i,1) + & - qo(i,1)) * g / dp + dellau(i,1) = edto(i) * etad(i,1) * (ucdo(i,1) + & - uo(i,1)) * g / dp + dellav(i,1) = edto(i) * etad(i,1) * (vcdo(i,1) + & - vo(i,1)) * g / dp + endif + enddo +! +!--- changed due to subsidence and entrainment +! + do k = 2, km1 + do i = 1, im + if (cnvflg(i).and.k.lt.ktcon(i)) then + aup = 1. + if(k.le.kb(i)) aup = 0. + adw = 1. + if(k.gt.jmin(i)) adw = 0. + dp = 1000. * del(i,k) + dz = zi(i,k) - zi(i,k-1) +! + dv1h = heo(i,k) + dv2h = .5 * (heo(i,k) + heo(i,k-1)) + dv3h = heo(i,k-1) + dv1q = qo(i,k) + dv2q = .5 * (qo(i,k) + qo(i,k-1)) + dv3q = qo(i,k-1) + dv1u = uo(i,k) + dv2u = .5 * (uo(i,k) + uo(i,k-1)) + dv3u = uo(i,k-1) + dv1v = vo(i,k) + dv2v = .5 * (vo(i,k) + vo(i,k-1)) + dv3v = vo(i,k-1) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) + tem1 = xlamud(i) +! + if(k.le.kbcon(i)) then + ptem = xlamde + ptem1 = xlamd(i)+xlamdd + else + ptem = xlamde + ptem1 = xlamdd + endif +! + dellah(i,k) = dellah(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1h + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3h + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2h*dz + & + aup*tem1*eta(i,k-1)*.5*(hcko(i,k)+hcko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(hcdo(i,k)+hcdo(i,k-1))*dz + & ) *g/dp +! + dellaq(i,k) = dellaq(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1q + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3q + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2q*dz + & + aup*tem1*eta(i,k-1)*.5*(qrcko(i,k)+qcko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(qrcdo(i,k)+qcdo(i,k-1))*dz + & ) *g/dp +! + dellau(i,k) = dellau(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1u + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3u + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2u*dz + & + aup*tem1*eta(i,k-1)*.5*(ucko(i,k)+ucko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(ucdo(i,k)+ucdo(i,k-1))*dz + & - pgcon*(aup*eta(i,k-1)-adw*edto(i)*etad(i,k))*(dv1u-dv3u) + & ) *g/dp +! + dellav(i,k) = dellav(i,k) + + & ((aup*eta(i,k)-adw*edto(i)*etad(i,k))*dv1v + & - (aup*eta(i,k-1)-adw*edto(i)*etad(i,k-1))*dv3v + & - (aup*tem*eta(i,k-1)+adw*edto(i)*ptem*etad(i,k))*dv2v*dz + & + aup*tem1*eta(i,k-1)*.5*(vcko(i,k)+vcko(i,k-1))*dz + & + adw*edto(i)*ptem1*etad(i,k)*.5*(vcdo(i,k)+vcdo(i,k-1))*dz + & - pgcon*(aup*eta(i,k-1)-adw*edto(i)*etad(i,k))*(dv1v-dv3v) + & ) *g/dp +! + endif + enddo + enddo +! +!------- cloud top +! + do i = 1, im + if(cnvflg(i)) then + indx = ktcon(i) + dp = 1000. * del(i,indx) + dv1h = heo(i,indx-1) + dellah(i,indx) = eta(i,indx-1) * + & (hcko(i,indx-1) - dv1h) * g / dp + dv1q = qo(i,indx-1) + dellaq(i,indx) = eta(i,indx-1) * + & (qcko(i,indx-1) - dv1q) * g / dp + dv1u = uo(i,indx-1) + dellau(i,indx) = eta(i,indx-1) * + & (ucko(i,indx-1) - dv1u) * g / dp + dv1v = vo(i,indx-1) + dellav(i,indx) = eta(i,indx-1) * + & (vcko(i,indx-1) - dv1v) * g / dp +! +! cloud water +! + dellal(i,indx) = eta(i,indx-1) * + & qlko_ktcon(i) * g / dp + endif + enddo +! +!------- final changed variable per unit mass flux +! +!> - Calculate the change in the temperature and moisture profiles per unit cloud base mass flux. + do k = 1, km + do i = 1, im + if (cnvflg(i).and.k .le. kmax(i)) then + if(k.gt.ktcon(i)) then + qo(i,k) = q1(i,k) + to(i,k) = t1(i,k) + endif + if(k.le.ktcon(i)) then + qo(i,k) = dellaq(i,k) * mbdt + q1(i,k) + dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp + to(i,k) = dellat * mbdt + t1(i,k) + val = 1.e-10 + qo(i,k) = max(qo(i,k), val ) + endif + endif + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!--- the above changed environment is now used to calulate the +!--- effect the arbitrary cloud (with unit mass flux) +!--- would have on the stability, +!--- which then is used to calculate the real mass flux, +!--- necessary to keep this change in balance with the large-scale +!--- destabilization. +! +!--- environmental conditions again, first heights +! +!> ## Using the updated temperature and moisture profiles that were modified by the convection on a short time-scale, recalculate the total cloud work function to determine the change in the cloud work function due to convection, or the stabilizing effect of the cumulus. +!! - Using notation from Pan and Wu (1995) \cite pan_and_wu_1995, the previously calculated cloud work function is denoted by \f$A^+\f$. Now, it is necessary to use the entraining/detraining cloud model ("static control") to determine the cloud work function of the environment after the stabilization of the arbitrary convective element (per unit cloud base mass flux) has been applied, denoted by \f$A^*\f$. +!! - Recalculate saturation specific humidity. + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k)+epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) +! tvo(i,k) = to(i,k) + delta * to(i,k) * qo(i,k) + endif + enddo + enddo +! +!--- moist static energy +! +!! - Recalculate moist static energy and saturation moist static energy. + do k = 1, km1 + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)-1) then + dz = .5 * (zo(i,k+1) - zo(i,k)) + dp = .5 * (pfld(i,k+1) - pfld(i,k)) + es = 0.01 * fpvs(to(i,k+1)) ! fpvs is in pa + pprime = pfld(i,k+1) + epsm1 * es + qs = eps * es / pprime + dqsdp = - qs / pprime + desdt = es * (fact1 / to(i,k+1) + fact2 / (to(i,k+1)**2)) + dqsdt = qs * pfld(i,k+1) * desdt / (es * pprime) + gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) + dt = (g * dz + hvap * dqsdp * dp) / (cp * (1. + gamma)) + dq = dqsdt * dt + dqsdp * dp + to(i,k) = to(i,k+1) + dt + qo(i,k) = qo(i,k+1) + dq + po(i,k) = .5 * (pfld(i,k) + pfld(i,k+1)) + endif + enddo + enddo + do k = 1, km1 + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)-1) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (po(i,k) + epsm1 * qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) + heo(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qeso(i,k) + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + k = kmax(i) + heo(i,k) = g * zo(i,k) + cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = g * zo(i,k) + cp * to(i,k) + hvap * qeso(i,k) +! heo(i,k) = min(heo(i,k),heso(i,k)) + endif + enddo +! +!**************************** static control +! +!------- moisture and cloud work functions +! +!> - As before, recalculate the updraft cloud work function. + do i = 1, im + if(cnvflg(i)) then + xaa0(i) = 0. + xpwav(i) = 0. + endif + enddo +! + do i = 1, im + if(cnvflg(i)) then + indx = kb(i) + hcko(i,indx) = heo(i,indx) + qcko(i,indx) = qo(i,indx) + endif + enddo + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + hcko(i,k) = ((1.-tem1)*hcko(i,k-1)+tem*0.5* + & (heo(i,k)+heo(i,k-1)))/factor + endif + endif + enddo + enddo + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + xdby = hcko(i,k) - heso(i,k) + xqrch = qeso(i,k) + & + gamma * xdby / (hvap * (1. + gamma)) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor +! + dq = eta(i,k) * (qcko(i,k) - xqrch) +! + if(k.ge.kbcon(i).and.dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + if(ncloud.gt.0..and.k.gt.jmin(i)) then + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + if(k.lt.ktcon1(i)) then + xaa0(i) = xaa0(i) - dz * g * qlk + endif + qcko(i,k) = qlk + xqrch + xpw = etah * c0 * dz * qlk + xpwav(i) = xpwav(i) + xpw + endif + endif + if(k.ge.kbcon(i).and.k.lt.ktcon1(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + xaa0(i) = xaa0(i) + & + dz1 * (g / (cp * to(i,k))) + & * xdby / (1. + gamma) + & * rfact + val=0. + xaa0(i)=xaa0(i)+ + & dz1 * g * delta * + & max(val,(qeso(i,k) - qo(i,k))) + endif + endif + enddo + enddo +! +!------- downdraft calculations +! +!--- downdraft moisture properties +! +!> - As before, recalculate the downdraft cloud work function. + do i = 1, im + if(cnvflg(i)) then + jmn = jmin(i) + hcdo(i,jmn) = heo(i,jmn) + qcdo(i,jmn) = qo(i,jmn) + qrcd(i,jmn) = qo(i,jmn) + xpwev(i) = 0. + endif + enddo +! + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k.lt.jmin(i)) then + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + hcdo(i,k) = ((1.-tem1)*hcdo(i,k+1)+tem*0.5* + & (heo(i,k)+heo(i,k+1)))/factor + endif + enddo + enddo +! + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .lt. jmin(i)) then + dq = qeso(i,k) + dt = to(i,k) + gamma = el2orc * dq / dt**2 + dh = hcdo(i,k) - heso(i,k) + qrcd(i,k)=dq+(1./hvap)*(gamma/(1.+gamma))*dh +! detad = etad(i,k+1) - etad(i,k) +! + dz = zi(i,k+1) - zi(i,k) + if(k.ge.kbcon(i)) then + tem = xlamde * dz + tem1 = 0.5 * xlamdd * dz + else + tem = xlamde * dz + tem1 = 0.5 * (xlamd(i)+xlamdd) * dz + endif + factor = 1. + tem - tem1 + qcdo(i,k) = ((1.-tem1)*qrcd(i,k+1)+tem*0.5* + & (qo(i,k)+qo(i,k+1)))/factor +! +! xpwd = etad(i,k+1) * qcdo(i,k+1) - +! & etad(i,k) * qrcd(i,k) +! xpwd = xpwd - detad * +! & .5 * (qrcd(i,k) + qrcd(i,k+1)) +! + xpwd = etad(i,k) * (qcdo(i,k) - qrcd(i,k)) + xpwev(i) = xpwev(i) + xpwd + endif + enddo + enddo +! + do i = 1, im + edtmax = edtmaxl + if(islimsk(i) == 0) edtmax = edtmaxs + if(cnvflg(i)) then + if(xpwev(i).ge.0.) then + edtx(i) = 0. + else + edtx(i) = -edtx(i) * xpwav(i) / xpwev(i) + edtx(i) = min(edtx(i),edtmax) + endif + endif + enddo +! +! +!--- downdraft cloudwork functions +! +! + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k.lt.jmin(i)) then + gamma = el2orc * qeso(i,k) / to(i,k)**2 + dhh=hcdo(i,k) + dt= to(i,k) + dg= gamma + dh= heso(i,k) + dz=-1.*(zo(i,k+1)-zo(i,k)) + xaa0(i)=xaa0(i)+edtx(i)*dz*(g/(cp*dt))*((dhh-dh)/(1.+dg)) + & *(1.+delta*cp*dg*dt/hvap) + val=0. + xaa0(i)=xaa0(i)+edtx(i)* + & dz*g*delta*max(val,(qeso(i,k)-qo(i,k))) + endif + enddo + enddo +! +! calculate critical cloud work function +! +!> ## For the "dynamic control", using a reference cloud work function, estimate the change in cloud work function due to the large-scale dynamics. Following the quasi-equilibrium assumption, calculate the cloud base mass flux required to keep the large-scale convective destabilization in balance with the stabilization effect of the convection. +!! - Calculate the reference, or "critical", cloud work function derived from observations, denoted by \f$A^0\f$. + do i = 1, im + if(cnvflg(i)) then + if(pfld(i,ktcon(i)).lt.pcrit(15))then + acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) + & /(975.-pcrit(15)) + else if(pfld(i,ktcon(i)).gt.pcrit(1))then + acrt(i)=acrit(1) + else + k = int((850. - pfld(i,ktcon(i)))/50.) + 2 + k = min(k,15) + k = max(k,2) + acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* + & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) + endif + endif + enddo +!> - Calculate a correction factor, "acrtfct", that is a function of the cloud base vertical velocity, to multiply the critical cloud work function. + do i = 1, im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif +! +! modify critical cloud workfunction by cloud base vertical velocity +! + if(pdot(i).le.w4) then + acrtfct(i) = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i).ge.-w4) then + acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) + else + acrtfct(i) = 0. + endif + val1 = -1. + acrtfct(i) = max(acrtfct(i),val1) + val2 = 1. + acrtfct(i) = min(acrtfct(i),val2) + acrtfct(i) = 1. - acrtfct(i) +! +! modify acrtfct(i) by colume mean rh if rhbar(i) is greater than 80 percent +! +! if(rhbar(i).ge..8) then +! acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. +! endif +! +! modify adjustment time scale by cloud base vertical velocity +! +!> - Also, modify the time scale over which the large-scale destabilization takes place (dtconv) according to the cloud base vertical velocity, ensuring that this timescale stays between previously calculated minimum and maximum values. + dtconv(i) = dt2 + max((1800. - dt2),0.) * + & (pdot(i) - w2) / (w1 - w2) +! dtconv(i) = max(dtconv(i), dt2) +! dtconv(i) = 1800. * (pdot(i) - w2) / (w1 - w2) + dtconv(i) = max(dtconv(i),dtmin) + dtconv(i) = min(dtconv(i),dtmax) +! + endif + enddo +! +!--- large scale forcing +! +!> - Calculate the large scale destabilization as in equation 5 of Pan and Wu (1995) \cite pan_and_wu_1995 : +!! \f[ +!! \frac{\partial A}{\partial t}_{LS}=\frac{A^+-cA^0}{\Delta t_{LS}} +!! \f] +!! where \f$c\f$ is the correction factor "acrtfct", \f$\Delta t_{LS}\f$ is the modified timescale over which the environment is destabilized, and the other quantities have been previously defined. + do i= 1, im + if(cnvflg(i)) then + fld(i)=(aa1(i)-acrt(i)* acrtfct(i))/dtconv(i) + if(fld(i).le.0.) cnvflg(i) = .false. + endif +!> - Calculate the stabilization effect of the convection (per unit cloud base mass flux) as in equation 6 of Pan and Wu (1995) \cite pan_and_wu_1995 : +!! \f[ +!! \frac{\partial A}{\partial t}_{cu}=\frac{A^*-A^+}{\Delta t_{cu}} +!! \f] +!! \f$\Delta t_{cu}\f$ is the short timescale of the convection. + if(cnvflg(i)) then +! xaa0(i) = max(xaa0(i),0.) + xk(i) = (xaa0(i) - aa1(i)) / mbdt + if(xk(i).ge.0.) cnvflg(i) = .false. + endif +! +!--- kernel, cloud base mass flux +! +!> - The cloud base mass flux (xmb) is then calculated from equation 7 of Pan and Wu (1995) \cite pan_and_wu_1995 +!! \f[ +!! M_c=\frac{-\frac{\partial A}{\partial t}_{LS}}{\frac{\partial A}{\partial t}_{cu}} +!! \f] + if(cnvflg(i)) then + xmb(i) = -fld(i) / xk(i) + xmb(i) = min(xmb(i),xmbmax(i)) + endif + enddo +!! +!> - If the large scale destabilization is less than zero, or the stabilization by the convection is greater than zero, then the scheme returns to the calling routine without modifying the state variables. + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! restore to,qo,uo,vo to t1,q1,u1,v1 in case convection stops +! + + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + to(i,k) = t1(i,k) + qo(i,k) = q1(i,k) + uo(i,k) = u1(i,k) + vo(i,k) = v1(i,k) + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!--- feedback: simply the changes from the cloud with unit mass flux +!--- multiplied by the mass flux necessary to keep the +!--- equilibrium with the larger-scale. +! +!> ## For the "feedback" control, calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!> - Calculate the temperature tendency from the moist static energy and specific humidity tendencies. +!> - Update the temperature, specific humidity, and horiztonal wind state variables by multiplying the cloud base mass flux-normalized tendencies by the cloud base mass flux. +!> - Accumulate column-integrated tendencies. + do i = 1, im + delhbar(i) = 0. + delqbar(i) = 0. + deltbar(i) = 0. + delubar(i) = 0. + delvbar(i) = 0. + qcond(i) = 0. + enddo + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + if(k.le.ktcon(i)) then + dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp + t1(i,k) = t1(i,k) + dellat * xmb(i) * dt2 + q1(i,k) = q1(i,k) + dellaq(i,k) * xmb(i) * dt2 +! tem = 1./rcs(i) +! u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 * tem +! v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 * tem + u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 + v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 + dp = 1000. * del(i,k) + delhbar(i) = delhbar(i) + dellah(i,k)*xmb(i)*dp/g + delqbar(i) = delqbar(i) + dellaq(i,k)*xmb(i)*dp/g + deltbar(i) = deltbar(i) + dellat*xmb(i)*dp/g + delubar(i) = delubar(i) + dellau(i,k)*xmb(i)*dp/g + delvbar(i) = delvbar(i) + dellav(i,k)*xmb(i)*dp/g + endif + endif + enddo + enddo +!> - Recalculate saturation specific humidity using the updated temperature. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + if(k.le.ktcon(i)) then + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k)/(pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + endif + enddo + enddo +! +!> - Add up column-integrated convective precipitation by multiplying the normalized value by the cloud base mass flux. + do i = 1, im + rntot(i) = 0. + delqev(i) = 0. + delq2(i) = 0. + flg(i) = cnvflg(i) + enddo + do k = km, 1, -1 + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + if(k.lt.ktcon(i)) then + aup = 1. + if(k.le.kb(i)) aup = 0. + adw = 1. + if(k.ge.jmin(i)) adw = 0. + rain = aup * pwo(i,k) + adw * edto(i) * pwdo(i,k) + rntot(i) = rntot(i) + rain * xmb(i) * .001 * dt2 + endif + endif + enddo + enddo +!> - Determine the evaporation of the convective precipitation and update the integrated convective precipitation. +!> - Update state temperature and moisture to account for evaporation of convective precipitation. +!> - Update column-integrated tendencies to account for evaporation of convective precipitation. + do k = km, 1, -1 + do i = 1, im + if (k .le. kmax(i)) then + deltv(i) = 0. + delq(i) = 0. + qevap(i) = 0. + if(cnvflg(i).and.k.lt.ktcon(i)) then + aup = 1. + if(k.le.kb(i)) aup = 0. + adw = 1. + if(k.ge.jmin(i)) adw = 0. + rain = aup * pwo(i,k) + adw * edto(i) * pwdo(i,k) + rn(i) = rn(i) + rain * xmb(i) * .001 * dt2 + endif + if(flg(i).and.k.lt.ktcon(i)) then + evef = edt(i) * evfact + if(islimsk(i) == 1) evef=edt(i) * evfactl +! if(islimsk(i) == 1) evef=.07 +! if(islimsk(i) == 1) evef = 0. + qcond(i) = evef * (q1(i,k) - qeso(i,k)) + & / (1. + el2orc * qeso(i,k) / t1(i,k)**2) + dp = 1000. * del(i,k) + if(rn(i).gt.0..and.qcond(i).lt.0.) then + qevap(i) = -qcond(i) * (1.-exp(-.32*sqrt(dt2*rn(i)))) + qevap(i) = min(qevap(i), rn(i)*1000.*g/dp) + delq2(i) = delqev(i) + .001 * qevap(i) * dp / g + endif + if(rn(i).gt.0..and.qcond(i).lt.0..and. + & delq2(i).gt.rntot(i)) then + qevap(i) = 1000.* g * (rntot(i) - delqev(i)) / dp + flg(i) = .false. + endif + if(rn(i).gt.0..and.qevap(i).gt.0.) then + q1(i,k) = q1(i,k) + qevap(i) + t1(i,k) = t1(i,k) - elocp * qevap(i) + rn(i) = rn(i) - .001 * qevap(i) * dp / g + deltv(i) = - elocp*qevap(i)/dt2 + delq(i) = + qevap(i)/dt2 + delqev(i) = delqev(i) + .001*dp*qevap(i)/g + endif + dellaq(i,k) = dellaq(i,k) + delq(i) / xmb(i) + delqbar(i) = delqbar(i) + delq(i)*dp/g + deltbar(i) = deltbar(i) + deltv(i)*dp/g + endif + endif + enddo + enddo +! +! do i = 1, im +! if(me.eq.31.and.cnvflg(i)) then +! if(cnvflg(i)) then +! print *, ' deep delhbar, delqbar, deltbar = ', +! & delhbar(i),hvap*delqbar(i),cp*deltbar(i) +! print *, ' deep delubar, delvbar = ',delubar(i),delvbar(i) +! print *, ' precip =', hvap*rn(i)*1000./dt2 +! print*,'pdif= ',pfld(i,kbcon(i))-pfld(i,ktcon(i)) +! endif +! enddo +! +! precipitation rate converted to actual precip +! in unit of m instead of kg +! + do i = 1, im + if(cnvflg(i)) then +! +! in the event of upper level rain evaporation and lower level downdraft +! moistening, rn can become negative, in this case, we back out of the +! heating and the moistening +! + + if(rn(i).lt.0..and..not.flg(i)) rn(i) = 0. + if(rn(i).le.0.) then + rn(i) = 0. + else + ktop(i) = ktcon(i) + kbot(i) = kbcon(i) + kcnv(i) = 1 + cldwrk(i) = aa1(i) + endif + endif + enddo +! +! convective cloud water +! +!> - Calculate convective cloud water. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo +! +! convective cloud cover +! +!> - Calculate convective cloud cover. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvc(i,k) = 0.04 * log(1. + 675. * eta(i,k) * xmb(i)) + cnvc(i,k) = min(cnvc(i,k), 0.6) + cnvc(i,k) = max(cnvc(i,k), 0.0) + endif + endif + enddo + enddo + +! +! cloud water +! +!> - Separate detrained cloud water into liquid and ice species as a function of temperature only. + if (ncloud.gt.0) then +! + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.gt.kb(i).and.k.le.ktcon(i)) then + tem = dellal(i,k) * xmb(i) * dt2 + tem1 = max(0.0, min(1.0, (tcr-t1(i,k))*tcrf)) + if (qlc(i,k) .gt. -999.0) then + qli(i,k) = qli(i,k) + tem * tem1 ! ice + qlc(i,k) = qlc(i,k) + tem *(1.0-tem1) ! water + else + qli(i,k) = qli(i,k) + tem + endif + endif + endif + enddo + enddo +! + endif +! +!> - If convective precipitation is zero or negative, reset the updated state variables back to their original values (negating convective changes). + do k = 1, km + do i = 1, im + if(cnvflg(i).and.rn(i).le.0.) then + if (k .le. kmax(i)) then + t1(i,k) = to(i,k) + q1(i,k) = qo(i,k) + u1(i,k) = uo(i,k) + v1(i,k) = vo(i,k) + endif + endif + enddo + enddo +! +! hchuang code change +! +!> - Calculate the updraft convective mass flux. + do k = 1, km + do i = 1, im + if(cnvflg(i).and.rn(i).gt.0.) then + if(k.ge.kb(i) .and. k.lt.ktop(i)) then + ud_mf(i,k) = eta(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo +!> - Calculate the detrainment mass flux at cloud top. + do i = 1, im + if(cnvflg(i).and.rn(i).gt.0.) then + k = ktop(i)-1 + dt_mf(i,k) = ud_mf(i,k) + endif + enddo +!> - Calculate the downdraft convective mass flux. + do k = 1, km + do i = 1, im + if(cnvflg(i).and.rn(i).gt.0.) then + if(k.ge.1 .and. k.le.jmin(i)) then + dd_mf(i,k) = edto(i) * etad(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo + + if(mp_phys == mp_phys_mg) then + do k=1,km + do i=1,im + qlcn(i,k) = qlc(i,k) + qicn(i,k) = qli(i,k) + cf_upi(i,k) = cnvc(i,k) + w_upi(i,k) = ud_mf(i,k)*t1(i,k)*rgas / + & (dt2*max(cf_upi(i,k),1.e-12)*prslp(i,k)) + cnv_mfd(i,k) = ud_mf(i,k)/dt2 + clcn(i,k) = cnvc(i,k) + cnv_fice(i,k) = qicn(i,k) + & / max(1.e-10,qlcn(i,k)+qicn(i,k)) + enddo + enddo + endif + +!! + return +!> @} +!! @} + end subroutine sascnvn_run + + end module sascnvn +! \section original Original Documentation +! Penetrative convection is simulated following Pan and Wu (1994), which is based on Arakawa and Schubert(1974) as simplified by Grell (1993) and with a saturated downdraft. Convection occurs when the cloud work function (CWF) exceeds a certain threshold. Mass flux of the cloud is determined using a quasi-equilibrium assumption based on this threshold CWF. The CWF is a function of temperature and moisture in each air column of the model gridpoint. The temperature and moisture profiles are adjusted towards the equilibrium CWF within a specified time scale using the deduced mass flux. A major simplification of the original Arakawa-Shubert scheme is to consider only the deepest cloud and not the spectrum of clouds. The cloud model incorporates a downdraft mechanism as well as the evaporation of precipitation. Entrainment of the updraft and detrainment of the downdraft in the sub-cloud layers are included. Downdraft strength is based on the vertical wind shear through the cloud. The critical CWF is a function of the cloud base vertical motion. As the large-scale rising motion becomes strong, the CWF [similar to convective available potential energy (CAPE)] is allowed to approach zero (therefore approaching neutral stability). +! +! Mass fluxes induced in the updraft and the downdraft are allowed to transport momentum. The momentum exchange is calculated through the mass flux formulation in a manner similar to that for heat and moisture. The effect of the convection-induced pressure gradient force on cumulus momentum transport is parameterized in terms of mass flux and vertical wind shear (Han and Pan, 2006). As a result, the cumulus momentum exchange is reduced by about 55 % compared to the full exchange. +! +! The entrainment rate in cloud layers is dependent upon environmental humidity (Han and Pan, 2010). A drier environment increases the entrainment, suppressing the convection. The entrainment rate in sub-cloud layers is given as inversely proportional to height. The detrainment rate is assumed to be a constant in all layers and equal to the entrainment rate value at cloud base, which is O(10-4). The liquid water in the updraft layer is assumed to be detrained from the layers above the level of the minimum moist static energy into the grid-scale cloud water with conversion parameter of 0.002 m-1, which is same as the rain conversion parameter. +! +! Following Han and Pan (2010), the trigger condition is that a parcel lifted from the convection starting level without entrainment must reach its level of free convection within 120-180 hPa of ascent, proportional to the large-scale vertical velocity. This is intended to produce more convection in large-scale convergent regions but less convection in large-scale subsidence regions. Another important trigger mechanism is to include the effect of environmental humidity in the sub-cloud layer, taking into account convection inhibition due to existence of dry layers below cloud base. On the other hand, the cloud parcel might overshoot beyond the level of neutral buoyancy due to its inertia, eventually stopping its overshoot at cloud top. The CWF is used to model the overshoot. The overshoot of the cloud top is stopped at the height where a parcel lifted from the neutral buoyancy level with energy equal to 10% of the CWF would first have zero energy. +! +! Deep convection parameterization (SAS) modifications include: +! - Detraining cloud water from every updraft layer +! - Starting convection from the level of maximum moist static energy within PBL +! - Random cloud top is eliminated and only deepest cloud is considered +! - Cloud water is detrained from every cloud layer +! - Finite entrainment and detrainment rates for heat, moisture, and momentum are specified +! - Similar to shallow convection scheme, +! - entrainment rate is given to be inversely proportional to height in sub-cloud layers +! - detrainment rate is set to be a constant as entrainment rate at the cloud base. +! -Above cloud base, an organized entrainment is added, which is a function of environmental relative humidity diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta new file mode 100644 index 000000000..eecc4f07b --- /dev/null +++ b/physics/sascnvn.meta @@ -0,0 +1,583 @@ +[ccpp-arg-table] + name = sascnvn_init + type = scheme +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_sas] + standard_name = flag_for_sas_deep_convection_scheme + long_name = flag for SAS deep convection scheme + 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 + +######################################################################## +[ccpp-arg-table] + name = sascnvn_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sascnvn_run + type = scheme +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[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 +[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 +[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 +[fv] + 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 +[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 +[rgas] + 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 +[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 +[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 +[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 +[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 +[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 +[km] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[jcap] + standard_name = number_of_spectral_wave_trancation_for_sas + long_name = number of spectral wave trancation used only by sascnv and sascnvn + units = count + dimensions = () + type = integer + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslp] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psp] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + 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 + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + 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 + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q1] + 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 + optional = F +[t1] + 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 +[u1] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v1] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cldwrk] + standard_name = cumulative_cloud_work_function + long_name = cumulative cloud work function (valid only with sas) + units = m2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[rn] + 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 = inout + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + 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 +[islimsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dot] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ncloud] + standard_name = number_of_hydrometeors + long_name = number of hydrometeors + units = count + dimensions = () + type = integer + 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 +[dt_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 +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + 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 +[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 +[clam] + standard_name = entrainment_rate_coefficient_deep_convection + long_name = entrainment rate coefficient for deep convection + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c0] + standard_name = rain_conversion_parameter_deep_convection + long_name = convective rain conversion parameter for deep convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c1] + standard_name = detrainment_conversion_parameter_deep_convection + long_name = convective detrainment conversion parameter for deep convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[betal] + standard_name = downdraft_fraction_reaching_surface_over_land_deep_convection + long_name = downdraft fraction reaching surface over land for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[betas] + standard_name = downdraft_fraction_reaching_surface_over_ocean_deep_convection + long_name = downdraft fraction reaching surface over ocean for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[evfact] + standard_name = rain_evaporation_coefficient_deep_convection + long_name = convective rain evaporation coefficient for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[evfactl] + standard_name = rain_evaporation_coefficient_over_land_deep_convection + long_name = convective rain evaporation coefficient over land for deep convection + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pgcon] + standard_name = momentum_transport_reduction_factor_pgf_deep_convection + long_name = reduction factor in momentum transport due to deep convection induced pressure gradient force + units = frac + 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 + 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/shalcnv.F b/physics/shalcnv.F new file mode 100644 index 000000000..5c9e65203 --- /dev/null +++ b/physics/shalcnv.F @@ -0,0 +1,1351 @@ +!> \defgroup SASHAL Mass-Flux Shallow Convection +!! @{ +!! \brief The Mass-Flux shallow convection scheme parameterizes the effect of shallow convection on the environment much like the \ref SAS scheme with a few key modifications. Perhaps most importantly, no quasi-equilibrium assumption is necessary since the shallow cloud base mass flux is parameterized from the surface buoyancy flux. Further, there are no convective downdrafts, the entrainment rate is greater than for deep convection, and the shallow convection is limited to not extend over the level where \f$p=0.7p_{sfc}\f$. +!! +!! This scheme was designed to replace the previous eddy-diffusivity approach to shallow convection with a mass-flux based approach as it is used for deep convection. Differences between the shallow and deep SAS schemes are presented in Han and Pan (2011) \cite han_and_pan_2011 . Like the deep scheme, it uses the working concepts put forth in Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 but includes modifications and simplifications from Grell (1993) \cite grell_1993 such as only one cloud type (the deepest possible, up to \f$p=0.7p_{sfc}\f$), rather than a spectrum based on cloud top heights or assumed entrainment rates, although it assumes no convective downdrafts. It contains many modifications associated with deep scheme as discussed in Han and Pan (2011) \cite han_and_pan_2011 , including the calculation of cloud top, a greater CFL-criterion-based maximum cloud base mass flux, and the inclusion of convective overshooting. +!! +!! \section diagram Calling Hierarchy Diagram +!! \image html Shallow_SAS_Flowchart.png "Diagram depicting how the SAS shallow convection scheme is called from the GSM physics time loop" height=2cm +!! \section intraphysics Intraphysics Communication +!! This space is reserved for a description of how this scheme uses information from other scheme types and/or how information calculated in this scheme is used in other scheme types. + +!> \file shalcnv.F +!! Contains the entire SAS shallow convection scheme. + module shalcnv + + implicit none + + private + + public :: shalcnv_init, shalcnv_run, shalcnv_finalize + + contains + +!! +!! \section arg_table_shalcnv_init Argument Table +!! \htmlinclude shalcnv_init.html +!! + subroutine shalcnv_init(do_shoc,shal_cnv,imfshalcnv, & + & imfshalcnv_sas,errmsg,errflg) +! + logical, intent(in) :: do_shoc,shal_cnv + integer, intent(in) :: imfshalcnv, imfshalcnv_sas + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! + if (do_shoc .or. .not.shal_cnv .or. & + & imfshalcnv/=imfshalcnv_sas) then + write(errmsg,'(*(a))') 'Logic error: shalcnv incompatible with',& + & ' control flags do_shoc, shal_cnv or imfshalcnv' + errflg = 1 + return + endif +! + end subroutine shalcnv_init + +! \brief This subroutine is empty since there are no procedures that need to be done to finalize the shalcnv code. +!! +!! \section arg_table_shalcnv_finalize Argument Table +!! + subroutine shalcnv_finalize + end subroutine shalcnv_finalize + +!> \brief This subroutine contains the entirety of the SAS shallow convection scheme. +!! +!! This routine follows the \ref SAS scheme quite closely, although it can be interpreted as only having the "static" and "feedback" control portions, since the "dynamic" control is not necessary to find the cloud base mass flux. The algorithm is simplified from SAS deep convection by excluding convective downdrafts and being confined to operate below \f$p=0.7p_{sfc}\f$. Also, entrainment is both simpler and stronger in magnitude compared to the deep scheme. +!! +!! \param[in] im number of used points +!! \param[in] ix horizontal dimension +!! \param[in] km vertical layer dimension +!! \param[in] jcap number of spectral wave trancation +!! \param[in] delt physics time step in seconds +!! \param[in] delp pressure difference between level k and k+1 (Pa) +!! \param[in] prslp mean layer presure (Pa) +!! \param[in] psp surface pressure (Pa) +!! \param[in] phil layer geopotential (\f$m^2/s^2\f$) +!! \param[inout] qlc cloud water (kg/kg) +!! \param[inout] qli ice (kg/kg) +!! \param[inout] q1 updated tracers (kg/kg) +!! \param[inout] t1 updated temperature (K) +!! \param[inout] u1 updated zonal wind (\f$m s^{-1}\f$) +!! \param[inout] v1 updated meridional wind (\f$m s^{-1}\f$) +!! \param[out] rn convective rain (m) +!! \param[out] kbot index for cloud base +!! \param[out] ktop index for cloud top +!! \param[out] kcnv flag to denote deep convection (0=no, 1=yes) +!! \param[in] islimsk sea/land/ice mask (=0/1/2) +!! \param[in] dot layer mean vertical velocity (Pa/s) +!! \param[in] ncloud number of cloud species +!! \param[in] hpbl PBL height (m) +!! \param[in] heat surface sensible heat flux (K m/s) +!! \param[in] evap surface latent heat flux (kg/kg m/s) +!! \param[out] ud_mf updraft mass flux multiplied by time step (\f$kg/m^2\f$) +!! \param[out] dt_mf ud_mf at cloud top (\f$kg/m^2\f$) +!! \param[out] cnvw convective cloud water (kg/kg) +!! \param[out] cnvc convective cloud cover (unitless) +!! +!! \section general General Algorithm +!! -# Compute preliminary quantities needed for the static and feedback control portions of the algorithm. +!! -# Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +!! -# Calculate the tendencies of the state variables (per unit cloud base mass flux) and the cloud base mass flux. +!! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!! \section detailed Detailed Algorithm +!! +!! \section arg_table_shalcnv_run Argument Table +!! \htmlinclude shalcnv_run.html +!! +!! @{ + subroutine shalcnv_run( & + & grav,cp,hvap,rv,fv,t0c,rd,cvap,cliq,eps,epsm1, & + & im,ix,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & + & q1,t1,u1,v1,rn,kbot,ktop,kcnv,islimsk, & + & dot,ncloud,hpbl,heat,evap,ud_mf,dt_mf,cnvw,cnvc, & + & clam,c0,c1,pgcon,errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs +! use physcons, grav => con_g, cp => con_cp, hvap => con_hvap & +! &, rv => con_rv, fv => con_fvirt, t0c => con_t0c & +! &, rd => con_rd, cvap => con_cvap, cliq => con_cliq & +! &, eps => con_eps, epsm1 => con_epsm1 + implicit none +! +! Interface variables +! + real(kind=kind_phys), intent(in) :: grav, cp, hvap, rv, fv, t0c, & + & rd, cvap, cliq, eps, epsm1 + integer, intent(in) :: im, ix, km, jcap, ncloud + integer, intent(inout) :: kbot(:), ktop(:), kcnv(:) + integer, intent(in) :: islimsk(:) + real(kind=kind_phys), intent(in) :: delt, clam, c0, c1, pgcon + real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & + & prslp(:,:), dot(:,:), & + & phil(:,:), hpbl(:), & + & heat(:), evap(:) + real(kind=kind_phys), intent(inout) :: & + & qlc(:,:), qli(:,:), & + & q1(:,:), t1(:,:), & + & u1(:,:), v1(:,:), & + & cnvw(:,:), cnvc(:,:) + real(kind=kind_phys), intent(out) :: rn(:), ud_mf(:,:), dt_mf(:,:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! Local variables +! + integer i,j,indx, k, kk, km1 + integer kpbl(im) +! + real(kind=kind_phys) dellat, delta, + & desdt, + & dp, + & dq, dqsdp, dqsdt, dt, + & dt2, dtmax, dtmin, dv1h, + & dv1q, dv2h, dv2q, dv1u, + & dv1v, dv2u, dv2v, dv3q, + & dv3h, dv3u, dv3v, + & dz, dz1, e1, + & el2orc, elocp, aafac, + & es, etah, h1, dthk, + & evef, evfact, evfactl, fact1, + & fact2, factor, fjcap, + & g, gamma, pprime, betaw, + & qlk, qrch, qs, + & rfact, shear, tem1, + & val, val1, + & val2, w1, w1l, w1s, + & w2, w2l, w2s, w3, + & w3l, w3s, w4, w4l, + & w4s, tem, ptem, ptem1 +! + integer kb(im), kbcon(im), kbcon1(im), + & ktcon(im), ktcon1(im), + & kbm(im), kmax(im) +! + real(kind=kind_phys) aa1(im), + & delhbar(im), delq(im), delq2(im), + & delqbar(im), delqev(im), deltbar(im), + & deltv(im), edt(im), + & wstar(im), sflx(im), + & pdot(im), po(im,km), + & qcond(im), qevap(im), hmax(im), + & rntot(im), vshear(im), + & xlamud(im), xmb(im), xmbmax(im), + & delubar(im), delvbar(im), + & ps(im), del(im,km), prsl(im,km) +! + real(kind=kind_phys) cincr, cincrmax, cincrmin +! +! physical parameters +! parameter(g=grav) +! parameter(elocp=hvap/cp, +! & el2orc=hvap*hvap/(rv*cp)) +! parameter(c0=.002,c1=5.e-4,delta=fv) +! parameter(delta=fv) +! parameter(fact1=(cvap-cliq)/rv,fact2=hvap/rv-fact1*t0c) + parameter(cincrmax=180.,cincrmin=120.,dthk=25.) + parameter(h1=0.33333333) +! local variables and arrays + real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), + & uo(im,km), vo(im,km), qeso(im,km) +! cloud water +! real(kind=kind_phys) qlko_ktcon(im), dellal(im,km), tvo(im,km), + real(kind=kind_phys) qlko_ktcon(im), dellal(im,km), + & dbyo(im,km), zo(im,km), xlamue(im,km), + & heo(im,km), heso(im,km), + & dellah(im,km), dellaq(im,km), + & dellau(im,km), dellav(im,km), hcko(im,km), + & ucko(im,km), vcko(im,km), qcko(im,km), + & qrcko(im,km), eta(im,km), + & zi(im,km), pwo(im,km), + & tx1(im), cnvwt(im,km) +! + logical totflg, cnvflg(im), flg(im) +! + real(kind=kind_phys) tf, tcr, tcrf + parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) +! +!----------------------------------------------------------------------- +! +!************************************************************************ +! replace (derived) constants above with regular variables + g = grav + elocp = hvap/cp + el2orc = hvap*hvap/(rv*cp) + delta = fv + fact1 = (cvap-cliq)/rv + fact2 = hvap/rv-fact1*t0c +!************************************************************************ +! initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!************************************************************************ +! convert input pa terms to cb terms -- moorthi +!> ## Compute preliminary quantities needed for the static and feedback control portions of the algorithm. +!> - Convert input pressure terms to centibar units. + ps = psp * 0.001 + prsl = prslp * 0.001 + del = delp * 0.001 +!************************************************************************ +! + km1 = km - 1 +! +! compute surface buoyancy flux +! +!> - Compute the surface buoyancy flux according to +!! \f[ +!! \overline{w'\theta_v'}=\overline{w'\theta'}+\left(\frac{R_v}{R_d}-1\right)T_0\overline{w'q'} +!! \f] +!! where \f$\overline{w'\theta'}\f$ is the surface sensible heat flux, \f$\overline{w'q'}\f$ is the surface latent heat flux, \f$R_v\f$ is the gas constant for water vapor, \f$R_d\f$ is the gas constant for dry air, and \f$T_0\f$ is a reference temperature. + do i=1,im + sflx(i) = heat(i)+fv*t1(i,1)*evap(i) + enddo +! +! initialize arrays +! +!> - Initialize column-integrated and other single-value-per-column variable arrays. + do i=1,im + cnvflg(i) = .true. + if(kcnv(i).eq.1) cnvflg(i) = .false. + if(sflx(i).le.0.) cnvflg(i) = .false. + if(cnvflg(i)) then + kbot(i)=km+1 + ktop(i)=0 + endif + rn(i)=0. + kbcon(i)=km + ktcon(i)=1 + kb(i)=km + pdot(i) = 0. + qlko_ktcon(i) = 0. + edt(i) = 0. + aa1(i) = 0. + vshear(i) = 0. + enddo +!> - Initialize updraft and detrainment mass fluxes to zero. +! hchuang code change + do k = 1, km + do i = 1, im + ud_mf(i,k) = 0. + dt_mf(i,k) = 0. + enddo + enddo +!! +!> - Return to the calling routine if deep convection is present or the surface buoyancy flux is negative. + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +!> - Define tunable parameters. + dt2 = delt + val = 1200. + dtmin = max(dt2, val ) + val = 3600. + dtmax = max(dt2, val ) +! model tunable parameters are all here +! clam = .3 + aafac = .1 + betaw = .03 +! evef = 0.07 + evfact = 0.3 + evfactl = 0.3 +! +! pgcon = 0.7 ! gregory et al. (1997, qjrms) +! pgcon = 0.55 ! zhang & wu (2003,jas) + fjcap = (float(jcap) / 126.) ** 2 + val = 1. + fjcap = max(fjcap,val) + w1l = -8.e-3 + w2l = -4.e-2 + w3l = -5.e-3 + w4l = -5.e-4 + w1s = -2.e-4 + w2s = -2.e-3 + w3s = -1.e-3 + w4s = -2.e-5 +! +! define top layer for search of the downdraft originating layer +! and the maximum thetae for updraft +! +!> - Determine maximum indices for the parcel starting point (kbm) and cloud top (kmax). + do i=1,im + kbm(i) = km + kmax(i) = km + tx1(i) = 1.0 / ps(i) + enddo +! + do k = 1, km + do i=1,im + if (prsl(i,k)*tx1(i) .gt. 0.70) kbm(i) = k + 1 + if (prsl(i,k)*tx1(i) .gt. 0.60) kmax(i) = k + 1 + enddo + enddo + do i=1,im + kbm(i) = min(kbm(i),kmax(i)) + enddo +! +! hydrostatic height assume zero terr and compute +! updraft entrainment rate as an inverse function of height +! +!> - Calculate hydrostatic height at layer centers assuming a flat surface (no terrain) from the geopotential. + do k = 1, km + do i=1,im + zo(i,k) = phil(i,k) / g + enddo + enddo +!> - Calculate interface height and the entrainment rate as an inverse function of height. + do k = 1, km1 + do i=1,im + zi(i,k) = 0.5*(zo(i,k)+zo(i,k+1)) + xlamue(i,k) = clam / zi(i,k) + enddo + enddo + do i=1,im + xlamue(i,km) = xlamue(i,km1) + enddo +! +! pbl height +! +!> - Find the index for the PBL top using the PBL height; enforce that it is lower than the maximum parcel starting level. + do i=1,im + flg(i) = cnvflg(i) + kpbl(i)= 1 + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.zo(i,k).le.hpbl(i)) then + kpbl(i) = k + else + flg(i) = .false. + endif + enddo + enddo + do i=1,im + kpbl(i)= min(kpbl(i),kbm(i)) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! convert surface pressure to mb from cb +! +!> - Convert prsl from centibar to millibar, set normalized mass flux to 1, cloud properties to 0, and save model state variables (after advection/turbulence). + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + pfld(i,k) = prsl(i,k) * 10.0 + eta(i,k) = 1. + hcko(i,k) = 0. + qcko(i,k) = 0. + qrcko(i,k)= 0. + ucko(i,k) = 0. + vcko(i,k) = 0. + dbyo(i,k) = 0. + pwo(i,k) = 0. + dellal(i,k) = 0. + to(i,k) = t1(i,k) + qo(i,k) = q1(i,k) + uo(i,k) = u1(i,k) + vo(i,k) = v1(i,k) +! uo(i,k) = u1(i,k) * rcs(i) +! vo(i,k) = v1(i,k) * rcs(i) + cnvwt(i,k) = 0. + endif + enddo + enddo +! +! column variables +! p is pressure of the layer (mb) +! t is temperature at t-dt (k)..tn +! q is mixing ratio at t-dt (kg/kg)..qn +! to is temperature at t+dt (k)... this is after advection and turbulan +! qo is mixing ratio at t+dt (kg/kg)..q1 +! +!> - Calculate saturation mixing ratio and enforce minimum moisture values. + do k = 1, km + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) +! tvo(i,k) = to(i,k) + delta * to(i,k) * qo(i,k) + endif + enddo + enddo +! +! compute moist static energy +! +!> - Calculate moist static energy (heo) and saturation moist static energy (heso). + do k = 1, km + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)) then +! tem = g * zo(i,k) + cp * to(i,k) + tem = phil(i,k) + cp * to(i,k) + heo(i,k) = tem + hvap * qo(i,k) + heso(i,k) = tem + hvap * qeso(i,k) +! heo(i,k) = min(heo(i,k),heso(i,k)) + endif + enddo + enddo +! +! determine level with largest moist static energy within pbl +! this is the level where updraft starts +! +!> ## Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). +!> - Search in the PBL for the level of maximum moist static energy to start the ascending parcel. + do i=1,im + if (cnvflg(i)) then + hmax(i) = heo(i,1) + kb(i) = 1 + endif + enddo + do k = 2, km + do i=1,im + if (cnvflg(i).and.k.le.kpbl(i)) then + if(heo(i,k).gt.hmax(i)) then + kb(i) = k + hmax(i) = heo(i,k) + endif + endif + enddo + enddo +! +!> - Calculate the temperature, water vapor mixing ratio, and pressure at interface levels. + do k = 1, km1 + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)-1) then + dz = .5 * (zo(i,k+1) - zo(i,k)) + dp = .5 * (pfld(i,k+1) - pfld(i,k)) + es = 0.01 * fpvs(to(i,k+1)) ! fpvs is in pa + pprime = pfld(i,k+1) + epsm1 * es + qs = eps * es / pprime + dqsdp = - qs / pprime + desdt = es * (fact1 / to(i,k+1) + fact2 / (to(i,k+1)**2)) + dqsdt = qs * pfld(i,k+1) * desdt / (es * pprime) + gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) + dt = (g * dz + hvap * dqsdp * dp) / (cp * (1. + gamma)) + dq = dqsdt * dt + dqsdp * dp + to(i,k) = to(i,k+1) + dt + qo(i,k) = qo(i,k+1) + dq + po(i,k) = .5 * (pfld(i,k) + pfld(i,k+1)) + endif + enddo + enddo +! +!> - Recalculate saturation mixing ratio, moist static energy, saturation moist static energy, and horizontal momentum on interface levels. Enforce minimum mixing ratios. + do k = 1, km1 + do i=1,im + if (cnvflg(i) .and. k .le. kmax(i)-1) then + qeso(i,k) = 0.01 * fpvs(to(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (po(i,k) + epsm1*qeso(i,k)) + val1 = 1.e-8 + qeso(i,k) = max(qeso(i,k), val1) + val2 = 1.e-10 + qo(i,k) = max(qo(i,k), val2 ) +! qo(i,k) = min(qo(i,k),qeso(i,k)) + heo(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qo(i,k) + heso(i,k) = .5 * g * (zo(i,k) + zo(i,k+1)) + + & cp * to(i,k) + hvap * qeso(i,k) + uo(i,k) = .5 * (uo(i,k) + uo(i,k+1)) + vo(i,k) = .5 * (vo(i,k) + vo(i,k+1)) + endif + enddo + enddo +! +! look for the level of free convection as cloud base +!!> - Search below the index "kbm" for the level of free convection (LFC) where the condition \f$h_b > h^*\f$ is first met, where \f$h_b, h^*\f$ are the state moist static energy at the parcel's starting level and saturation moist static energy, respectively. Set "kbcon" to the index of the LFC. + do i=1,im + flg(i) = cnvflg(i) + if(flg(i)) kbcon(i) = kmax(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k.lt.kbm(i)) then + if(k.gt.kb(i).and.heo(i,kb(i)).gt.heso(i,k)) then + kbcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +! +!> - If no LFC, return to the calling routine without modifying state variables. + do i=1,im + if(cnvflg(i)) then + if(kbcon(i).eq.kmax(i)) cnvflg(i) = .false. + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine critical convective inhibition +! as a function of vertical velocity at cloud base. +! +!> - Determine the vertical pressure velocity at the LFC. After Han and Pan (2011) \cite han_and_pan_2011 , determine the maximum pressure thickness between a parcel's starting level and the LFC. If a parcel doesn't reach the LFC within the critical thickness, then the convective inhibition is deemed too great for convection to be triggered, and the subroutine returns to the calling routine without modifying the state variables. + do i=1,im + if(cnvflg(i)) then +! pdot(i) = 10.* dot(i,kbcon(i)) + pdot(i) = 0.01 * dot(i,kbcon(i)) ! now dot is in pa/s + endif + enddo + do i=1,im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif + if(pdot(i).le.w4) then + ptem = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i).ge.-w4) then + ptem = - (pdot(i) + w4) / (w4 - w3) + else + ptem = 0. + endif + val1 = -1. + ptem = max(ptem,val1) + val2 = 1. + ptem = min(ptem,val2) + ptem = 1. - ptem + ptem1= .5*(cincrmax-cincrmin) + cincr = cincrmax - ptem * ptem1 + tem1 = pfld(i,kb(i)) - pfld(i,kbcon(i)) + if(tem1.gt.cincr) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! assume the detrainment rate for the updrafts to be same as +! the entrainment rate at cloud base +! +!> - The updraft detrainment rate is set constant and equal to the entrainment rate at cloud base. + do i = 1, im + if(cnvflg(i)) then + xlamud(i) = xlamue(i,kbcon(i)) + endif + enddo +! +! determine updraft mass flux for the subcloud layers +! +!> - Calculate the normalized mass flux for subcloud and in-cloud layers according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 1: +!! \f[ +!! \frac{1}{\eta}\frac{\partial \eta}{\partial z} = \lambda_e - \lambda_d +!! \f] +!! where \f$\eta\f$ is the normalized mass flux, \f$\lambda_e\f$ is the entrainment rate and \f$\lambda_d\f$ is the detrainment rate. The normalized mass flux increases upward below the cloud base and decreases upward above. + do k = km1, 1, -1 + do i = 1, im + if (cnvflg(i)) then + if(k.lt.kbcon(i).and.k.ge.kb(i)) then + dz = zi(i,k+1) - zi(i,k) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k+1))-xlamud(i) + eta(i,k) = eta(i,k+1) / (1. + ptem * dz) + endif + endif + enddo + enddo +! +! compute mass flux above cloud base +! + do k = 2, km1 + do i = 1, im + if(cnvflg(i))then + if(k.gt.kbcon(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + ptem = 0.5*(xlamue(i,k)+xlamue(i,k-1))-xlamud(i) + eta(i,k) = eta(i,k-1) * (1 + ptem * dz) + endif + endif + enddo + enddo +! +! compute updraft cloud property +! +!> - Set initial cloud properties equal to the state variables at cloud base. + do i = 1, im + if(cnvflg(i)) then + indx = kb(i) + hcko(i,indx) = heo(i,indx) + ucko(i,indx) = uo(i,indx) + vcko(i,indx) = vo(i,indx) + endif + enddo +! +!> - Calculate the cloud properties as a parcel ascends, modified by entrainment and detrainment. Discretization follows Appendix B of Grell (1993) \cite grell_1993 . Following Han and Pan (2006) \cite han_and_pan_2006, the convective momentum transport is reduced by the convection-induced pressure gradient force by the constant "pgcon", currently set to 0.55 after Zhang and Wu (2003) \cite zhang_and_wu_2003 . + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + ptem = 0.5 * tem + pgcon + ptem1= 0.5 * tem - pgcon + hcko(i,k) = ((1.-tem1)*hcko(i,k-1)+tem*0.5* + & (heo(i,k)+heo(i,k-1)))/factor + ucko(i,k) = ((1.-tem1)*ucko(i,k-1)+ptem*uo(i,k) + & +ptem1*uo(i,k-1))/factor + vcko(i,k) = ((1.-tem1)*vcko(i,k-1)+ptem*vo(i,k) + & +ptem1*vo(i,k-1))/factor + dbyo(i,k) = hcko(i,k) - heso(i,k) + endif + endif + enddo + enddo +! +! taking account into convection inhibition due to existence of +! dry layers below cloud base +! +!> - With entrainment, recalculate the LFC as the first level where buoyancy is positive. The difference in pressure levels between LFCs calculated with/without entrainment must be less than a threshold (currently 25 hPa). Otherwise, convection is inhibited and the scheme returns to the calling routine without modifying the state variables. This is the subcloud dryness trigger modification discussed in Han and Pan (2011) \cite han_and_pan_2011. + do i=1,im + flg(i) = cnvflg(i) + kbcon1(i) = kmax(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k.lt.kbm(i)) then + if(k.ge.kbcon(i).and.dbyo(i,k).gt.0.) then + kbcon1(i) = k + flg(i) = .false. + endif + endif + enddo + enddo + do i=1,im + if(cnvflg(i)) then + if(kbcon1(i).eq.kmax(i)) cnvflg(i) = .false. + endif + enddo + do i=1,im + if(cnvflg(i)) then + tem = pfld(i,kbcon(i)) - pfld(i,kbcon1(i)) + if(tem.gt.dthk) then + cnvflg(i) = .false. + endif + endif + enddo +!! + totflg = .true. + do i = 1, im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! determine first guess cloud top as the level of zero buoyancy +! limited to the level of sigma=0.7 +! +!> - Calculate the cloud top as the first level where parcel buoyancy becomes negative; the maximum possible value is at \f$p=0.7p_{sfc}\f$. + do i = 1, im + flg(i) = cnvflg(i) + if(flg(i)) ktcon(i) = kbm(i) + enddo + do k = 2, km1 + do i=1,im + if (flg(i).and.k .lt. kbm(i)) then + if(k.gt.kbcon1(i).and.dbyo(i,k).lt.0.) then + ktcon(i) = k + flg(i) = .false. + endif + endif + enddo + enddo +! +! turn off shallow convection if cloud top is less than pbl top +! +! do i=1,im +! if(cnvflg(i)) then +! kk = kpbl(i)+1 +! if(ktcon(i).le.kk) cnvflg(i) = .false. +! endif +! enddo +!! +! totflg = .true. +! do i = 1, im +! totflg = totflg .and. (.not. cnvflg(i)) +! enddo +! if(totflg) return +!! +! +! specify upper limit of mass flux at cloud base +! +!> - Calculate the maximum value of the cloud base mass flux using the CFL-criterion-based formula of Han and Pan (2011) \cite han_and_pan_2011, equation 7. + do i = 1, im + if(cnvflg(i)) then +! xmbmax(i) = .1 +! + k = kbcon(i) + dp = 1000. * del(i,k) + xmbmax(i) = dp / (g * dt2) +! +! tem = dp / (g * dt2) +! xmbmax(i) = min(tem, xmbmax(i)) + endif + enddo +! +! compute cloud moisture property and precipitation +! +!> - Initialize the cloud moisture at cloud base and set the cloud work function to zero. + do i = 1, im + if (cnvflg(i)) then + aa1(i) = 0. + qcko(i,kb(i)) = qo(i,kb(i)) + qrcko(i,kb(i)) = qo(i,kb(i)) + endif + enddo +!> - Calculate the moisture content of the entraining/detraining parcel (qcko) and the value it would have if just saturated (qrch), according to equation A.14 in Grell (1993) \cite grell_1993 . Their difference is the amount of convective cloud water (qlk = rain + condensate). Determine the portion of convective cloud water that remains suspended and the portion that is converted into convective precipitation (pwo). Calculate and save the negative cloud work function (aa1) due to water loading. Above the level of minimum moist static energy, some of the cloud water is detrained into the grid-scale cloud water from every cloud layer with a rate of 0.0005 \f$m^{-1}\f$ (dellal). + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +!j + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +!j + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) +! +! below lfc check if there is excess moisture to release latent heat +! + if(k.ge.kbcon(i).and.dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + if(ncloud.gt.0.) then + dp = 1000. * del(i,k) + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + aa1(i) = aa1(i) - dz * g * qlk + qcko(i,k)= qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! calculate cloud work function +! +!> - Calculate the cloud work function according to Pan and Wu (1995) \cite pan_and_wu_1995 equation 4: +!! \f[ +!! A_u=\int_{z_0}^{z_t}\frac{g}{c_pT(z)}\frac{\eta}{1 + \gamma}[h(z)-h^*(z)]dz +!! \f] +!! (discretized according to Grell (1993) \cite grell_1993 equation B.10 using B.2 and B.3 of Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 and assuming \f$\eta=1\f$) where \f$A_u\f$ is the updraft cloud work function, \f$z_0\f$ and \f$z_t\f$ are cloud base and cloud top, respectively, \f$\gamma = \frac{L}{c_p}\left(\frac{\partial \overline{q_s}}{\partial T}\right)_p\f$ and other quantities are previously defined. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.kbcon(i).and.k.lt.ktcon(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa1(i) = aa1(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + val = 0. + aa1(i)=aa1(i)+ + & dz1 * g * delta * + & max(val,(qeso(i,k) - qo(i,k))) + endif + endif + enddo + enddo +!> - If the updraft cloud work function is negative, convection does not occur, and the scheme returns to the calling routine. + do i = 1, im + if(cnvflg(i).and.aa1(i).le.0.) cnvflg(i) = .false. + enddo +!! + totflg = .true. + do i=1,im + totflg = totflg .and. (.not. cnvflg(i)) + enddo + if(totflg) return +!! +! +! estimate the onvective overshooting as the level +! where the [aafac * cloud work function] becomes zero, +! which is the final cloud top +! limited to the level of sigma=0.7 +! +!> - Continue calculating the cloud work function past the point of neutral buoyancy to represent overshooting according to Han and Pan (2011) \cite han_and_pan_2011 . Convective overshooting stops when \f$ cA_u < 0\f$ where \f$c\f$ is currently 10%, or when 10% of the updraft cloud work function has been consumed by the stable buoyancy force. Overshooting is also limited to the level where \f$p=0.7p_{sfc}\f$. + do i = 1, im + if (cnvflg(i)) then + aa1(i) = aafac * aa1(i) + endif + enddo +! + do i = 1, im + flg(i) = cnvflg(i) + ktcon1(i) = kbm(i) + enddo + do k = 2, km1 + do i = 1, im + if (flg(i)) then + if(k.ge.ktcon(i).and.k.lt.kbm(i)) then + dz1 = zo(i,k+1) - zo(i,k) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + rfact = 1. + delta * cp * gamma + & * to(i,k) / hvap + aa1(i) = aa1(i) + + & dz1 * (g / (cp * to(i,k))) + & * dbyo(i,k) / (1. + gamma) + & * rfact + if(aa1(i).lt.0.) then + ktcon1(i) = k + flg(i) = .false. + endif + endif + endif + enddo + enddo +! +! compute cloud moisture property, detraining cloud water +! and precipitation in overshooting layers +! +!> - For the overshooting convection, calculate the moisture content of the entraining/detraining parcel as before. Partition convective cloud water and precipitation and detrain convective cloud water in the overshooting layers. + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.ge.ktcon(i).and.k.lt.ktcon1(i)) then + dz = zi(i,k) - zi(i,k-1) + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) +!j + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem1 = 0.5 * xlamud(i) * dz + factor = 1. + tem - tem1 + qcko(i,k) = ((1.-tem1)*qcko(i,k-1)+tem*0.5* + & (qo(i,k)+qo(i,k-1)))/factor + qrcko(i,k) = qcko(i,k) +!j + dq = eta(i,k) * (qcko(i,k) - qrch) +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + etah = .5 * (eta(i,k) + eta(i,k-1)) + if(ncloud.gt.0.) then + dp = 1000. * del(i,k) + qlk = dq / (eta(i,k) + etah * (c0 + c1) * dz) + dellal(i,k) = etah * c1 * dz * qlk * g / dp + else + qlk = dq / (eta(i,k) + etah * c0 * dz) + endif + qcko(i,k) = qlk + qrch + pwo(i,k) = etah * c0 * dz * qlk + cnvwt(i,k) = etah * qlk * g / dp + endif + endif + endif + enddo + enddo +! +! exchange ktcon with ktcon1 +! + do i = 1, im + if(cnvflg(i)) then + kk = ktcon(i) + ktcon(i) = ktcon1(i) + ktcon1(i) = kk + endif + enddo +! +! this section is ready for cloud water +! + if(ncloud.gt.0) then +! +! compute liquid and vapor separation at cloud top +! +!> - => Separate the total updraft cloud water at cloud top into vapor and condensate. + do i = 1, im + if(cnvflg(i)) then + k = ktcon(i) - 1 + gamma = el2orc * qeso(i,k) / (to(i,k)**2) + qrch = qeso(i,k) + & + gamma * dbyo(i,k) / (hvap * (1. + gamma)) + dq = qcko(i,k) - qrch +! +! check if there is excess moisture to release latent heat +! + if(dq.gt.0.) then + qlko_ktcon(i) = dq + qcko(i,k) = qrch + endif + endif + enddo + endif +! +!--- compute precipitation efficiency in terms of windshear +! +!! - Calculate the wind shear and precipitation efficiency according to equation 58 in Fritsch and Chappell (1980) \cite fritsch_and_chappell_1980 : +!! \f[ +!! E = 1.591 - 0.639\frac{\Delta V}{\Delta z} + 0.0953\left(\frac{\Delta V}{\Delta z}\right)^2 - 0.00496\left(\frac{\Delta V}{\Delta z}\right)^3 +!! \f] +!! where \f$\Delta V\f$ is the integrated horizontal shear over the cloud depth, \f$\Delta z\f$, (the ratio is converted to units of \f$10^{-3} s^{-1}\f$). The variable "edt" is \f$1-E\f$ and is constrained to the range \f$[0,0.9]\f$. + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 0. + endif + enddo + do k = 2, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + shear= sqrt((uo(i,k)-uo(i,k-1)) ** 2 + & + (vo(i,k)-vo(i,k-1)) ** 2) + vshear(i) = vshear(i) + shear + endif + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + vshear(i) = 1.e3 * vshear(i) / (zi(i,ktcon(i))-zi(i,kb(i))) + e1=1.591-.639*vshear(i) + & +.0953*(vshear(i)**2)-.00496*(vshear(i)**3) + edt(i)=1.-e1 + val = .9 + edt(i) = min(edt(i),val) + val = .0 + edt(i) = max(edt(i),val) + endif + enddo +! +!--- what would the change be, that a cloud with unit mass +!--- will do to the environment? +! +!> ## Calculate the tendencies of the state variables (per unit cloud base mass flux) and the cloud base mass flux. +!> - Calculate the change in moist static energy, moisture mixing ratio, and horizontal winds per unit cloud base mass flux for all layers below cloud top from equations B.14 and B.15 from Grell (1993) \cite grell_1993, and for the cloud top from B.16 and B.17. + do k = 1, km + do i = 1, im + if(cnvflg(i) .and. k .le. kmax(i)) then + dellah(i,k) = 0. + dellaq(i,k) = 0. + dellau(i,k) = 0. + dellav(i,k) = 0. + endif + enddo + enddo +! +!--- changed due to subsidence and entrainment +! + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.lt.ktcon(i)) then + dp = 1000. * del(i,k) + dz = zi(i,k) - zi(i,k-1) +! + dv1h = heo(i,k) + dv2h = .5 * (heo(i,k) + heo(i,k-1)) + dv3h = heo(i,k-1) + dv1q = qo(i,k) + dv2q = .5 * (qo(i,k) + qo(i,k-1)) + dv3q = qo(i,k-1) + dv1u = uo(i,k) + dv2u = .5 * (uo(i,k) + uo(i,k-1)) + dv3u = uo(i,k-1) + dv1v = vo(i,k) + dv2v = .5 * (vo(i,k) + vo(i,k-1)) + dv3v = vo(i,k-1) +! + tem = 0.5 * (xlamue(i,k)+xlamue(i,k-1)) + tem1 = xlamud(i) +!j + dellah(i,k) = dellah(i,k) + + & ( eta(i,k)*dv1h - eta(i,k-1)*dv3h + & - tem*eta(i,k-1)*dv2h*dz + & + tem1*eta(i,k-1)*.5*(hcko(i,k)+hcko(i,k-1))*dz + & ) *g/dp +!j + dellaq(i,k) = dellaq(i,k) + + & ( eta(i,k)*dv1q - eta(i,k-1)*dv3q + & - tem*eta(i,k-1)*dv2q*dz + & + tem1*eta(i,k-1)*.5*(qrcko(i,k)+qcko(i,k-1))*dz + & ) *g/dp +!j + dellau(i,k) = dellau(i,k) + + & ( eta(i,k)*dv1u - eta(i,k-1)*dv3u + & - tem*eta(i,k-1)*dv2u*dz + & + tem1*eta(i,k-1)*.5*(ucko(i,k)+ucko(i,k-1))*dz + & - pgcon*eta(i,k-1)*(dv1u-dv3u) + & ) *g/dp +!j + dellav(i,k) = dellav(i,k) + + & ( eta(i,k)*dv1v - eta(i,k-1)*dv3v + & - tem*eta(i,k-1)*dv2v*dz + & + tem1*eta(i,k-1)*.5*(vcko(i,k)+vcko(i,k-1))*dz + & - pgcon*eta(i,k-1)*(dv1v-dv3v) + & ) *g/dp +!j + endif + endif + enddo + enddo +! +!------- cloud top +! + do i = 1, im + if(cnvflg(i)) then + indx = ktcon(i) + dp = 1000. * del(i,indx) + dv1h = heo(i,indx-1) + dellah(i,indx) = eta(i,indx-1) * + & (hcko(i,indx-1) - dv1h) * g / dp + dv1q = qo(i,indx-1) + dellaq(i,indx) = eta(i,indx-1) * + & (qcko(i,indx-1) - dv1q) * g / dp + dv1u = uo(i,indx-1) + dellau(i,indx) = eta(i,indx-1) * + & (ucko(i,indx-1) - dv1u) * g / dp + dv1v = vo(i,indx-1) + dellav(i,indx) = eta(i,indx-1) * + & (vcko(i,indx-1) - dv1v) * g / dp +! +! cloud water +! + dellal(i,indx) = eta(i,indx-1) * + & qlko_ktcon(i) * g / dp + endif + enddo +! +! mass flux at cloud base for shallow convection +! (grant, 2001) +! +!> - Calculate the cloud base mass flux according to equation 6 in Grant (2001) \cite grant_2001, based on the subcloud layer convective velocity scale, \f$w_*\f$. +!! \f[ +!! M_c = 0.03\rho w_* +!! \f] +!! where \f$M_c\f$ is the cloud base mass flux, \f$\rho\f$ is the air density, and \f$w_*=\left(\frac{g}{T_0}\overline{w'\theta_v'}h\right)^{1/3}\f$ with \f$h\f$ the PBL height and other quantities have been defined previously. + do i= 1, im + if(cnvflg(i)) then + k = kbcon(i) +! ptem = g*sflx(i)*zi(i,k)/t1(i,1) + ptem = g*sflx(i)*hpbl(i)/t1(i,1) + wstar(i) = ptem**h1 + tem = po(i,k)*100. / (rd*t1(i,k)) + xmb(i) = betaw*tem*wstar(i) + xmb(i) = min(xmb(i),xmbmax(i)) + endif + enddo +!> ## For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. +!! - Recalculate saturation specific humidity. +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. k .le. kmax(i)) then + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k) / (pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + enddo + enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!> - Calculate the temperature tendency from the moist static energy and specific humidity tendencies. +!> - Update the temperature, specific humidity, and horiztonal wind state variables by multiplying the cloud base mass flux-normalized tendencies by the cloud base mass flux. +!> - Accumulate column-integrated tendencies. + do i = 1, im + delhbar(i) = 0. + delqbar(i) = 0. + deltbar(i) = 0. + delubar(i) = 0. + delvbar(i) = 0. + qcond(i) = 0. + enddo + do k = 1, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp + t1(i,k) = t1(i,k) + dellat * xmb(i) * dt2 + q1(i,k) = q1(i,k) + dellaq(i,k) * xmb(i) * dt2 +! tem = 1./rcs(i) +! u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 * tem +! v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 * tem + u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 + v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 + dp = 1000. * del(i,k) + delhbar(i) = delhbar(i) + dellah(i,k)*xmb(i)*dp/g + delqbar(i) = delqbar(i) + dellaq(i,k)*xmb(i)*dp/g + deltbar(i) = deltbar(i) + dellat*xmb(i)*dp/g + delubar(i) = delubar(i) + dellau(i,k)*xmb(i)*dp/g + delvbar(i) = delvbar(i) + dellav(i,k)*xmb(i)*dp/g + endif + endif + enddo + enddo +!> - Recalculate saturation specific humidity using the updated temperature. + do k = 1, km + do i = 1, im + if (cnvflg(i)) then + if(k.gt.kb(i).and.k.le.ktcon(i)) then + qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = eps * qeso(i,k)/(pfld(i,k) + epsm1*qeso(i,k)) + val = 1.e-8 + qeso(i,k) = max(qeso(i,k), val ) + endif + endif + enddo + enddo +! +!> - Add up column-integrated convective precipitation by multiplying the normalized value by the cloud base mass flux. + do i = 1, im + rntot(i) = 0. + delqev(i) = 0. + delq2(i) = 0. + flg(i) = cnvflg(i) + enddo + do k = km, 1, -1 + do i = 1, im + if (cnvflg(i)) then + if(k.lt.ktcon(i).and.k.gt.kb(i)) then + rntot(i) = rntot(i) + pwo(i,k) * xmb(i) * .001 * dt2 + endif + endif + enddo + enddo +! +! evaporating rain +! +!> - Determine the evaporation of the convective precipitation and update the integrated convective precipitation. +!> - Update state temperature and moisture to account for evaporation of convective precipitation. +!> - Update column-integrated tendencies to account for evaporation of convective precipitation. + do k = km, 1, -1 + do i = 1, im + if (k .le. kmax(i)) then + deltv(i) = 0. + delq(i) = 0. + qevap(i) = 0. + if(cnvflg(i)) then + if(k.lt.ktcon(i).and.k.gt.kb(i)) then + rn(i) = rn(i) + pwo(i,k) * xmb(i) * .001 * dt2 + endif + endif + if(flg(i).and.k.lt.ktcon(i)) then + evef = edt(i) * evfact + if(islimsk(i) == 1) evef=edt(i) * evfactl +! if(islimsk(i) == 1) evef=.07 +! if(islimsk(i) == 1) evef = 0. + qcond(i) = evef * (q1(i,k) - qeso(i,k)) + & / (1. + el2orc * qeso(i,k) / t1(i,k)**2) + dp = 1000. * del(i,k) + if(rn(i).gt.0..and.qcond(i).lt.0.) then + qevap(i) = -qcond(i) * (1.-exp(-.32*sqrt(dt2*rn(i)))) + qevap(i) = min(qevap(i), rn(i)*1000.*g/dp) + delq2(i) = delqev(i) + .001 * qevap(i) * dp / g + endif + if(rn(i).gt.0..and.qcond(i).lt.0..and. + & delq2(i).gt.rntot(i)) then + qevap(i) = 1000.* g * (rntot(i) - delqev(i)) / dp + flg(i) = .false. + endif + if(rn(i).gt.0..and.qevap(i).gt.0.) then + tem = .001 * dp / g + tem1 = qevap(i) * tem + if(tem1.gt.rn(i)) then + qevap(i) = rn(i) / tem + rn(i) = 0. + else + rn(i) = rn(i) - tem1 + endif + q1(i,k) = q1(i,k) + qevap(i) + t1(i,k) = t1(i,k) - elocp * qevap(i) + deltv(i) = - elocp*qevap(i)/dt2 + delq(i) = + qevap(i)/dt2 + delqev(i) = delqev(i) + .001*dp*qevap(i)/g + endif + dellaq(i,k) = dellaq(i,k) + delq(i) / xmb(i) + delqbar(i) = delqbar(i) + delq(i)*dp/g + deltbar(i) = deltbar(i) + deltv(i)*dp/g + endif + endif + enddo + enddo +!j +! do i = 1, im +! if(me.eq.31.and.cnvflg(i)) then +! if(cnvflg(i)) then +! print *, ' shallow delhbar, delqbar, deltbar = ', +! & delhbar(i),hvap*delqbar(i),cp*deltbar(i) +! print *, ' shallow delubar, delvbar = ',delubar(i),delvbar(i) +! print *, ' precip =', hvap*rn(i)*1000./dt2 +! print*,'pdif= ',pfld(i,kbcon(i))-pfld(i,ktcon(i)) +! endif +! enddo +!j + do i = 1, im + if(cnvflg(i)) then + if(rn(i).lt.0..or..not.flg(i)) rn(i) = 0. + ktop(i) = ktcon(i) + kbot(i) = kbcon(i) + kcnv(i) = 0 + endif + enddo +! +! convective cloud water +! +!> - Calculate shallow convective cloud water. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo + +! +! convective cloud cover +! +!> - Calculate shallow convective cloud cover. + do k = 1, km + do i = 1, im + if (cnvflg(i) .and. rn(i).gt.0.) then + if (k.ge.kbcon(i).and.k.lt.ktcon(i)) then + cnvc(i,k) = 0.04 * log(1. + 675. * eta(i,k) * xmb(i)) + cnvc(i,k) = min(cnvc(i,k), 0.2) + cnvc(i,k) = max(cnvc(i,k), 0.0) + endif + endif + enddo + enddo + +! +! cloud water +! +!> - Separate detrained cloud water into liquid and ice species as a function of temperature only. + if (ncloud.gt.0) then +! + do k = 1, km1 + do i = 1, im + if (cnvflg(i)) then + if (k.gt.kb(i).and.k.le.ktcon(i)) then + tem = dellal(i,k) * xmb(i) * dt2 + tem1 = max(0.0, min(1.0, (tcr-t1(i,k))*tcrf)) + if (qlc(i,k) .gt. -999.0) then + qli(i,k) = qli(i,k) + tem * tem1 ! ice + qlc(i,k) = qlc(i,k) + tem *(1.0-tem1) ! water + else + qli(i,k) = qli(i,k) + tem + endif + endif + endif + enddo + enddo +! + endif +! +! hchuang code change +! +!> - Calculate the updraft shallow convective mass flux. + do k = 1, km + do i = 1, im + if(cnvflg(i)) then + if(k.ge.kb(i) .and. k.lt.ktop(i)) then + ud_mf(i,k) = eta(i,k) * xmb(i) * dt2 + endif + endif + enddo + enddo +!> - Calculate the detrainment mass flux at shallow cloud top. + do i = 1, im + if(cnvflg(i)) then + k = ktop(i)-1 + dt_mf(i,k) = ud_mf(i,k) + endif + enddo +!! + return + + end subroutine shalcnv_run + + end module shalcnv +!> @} +!! @} diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta new file mode 100644 index 000000000..a8f8a8ba3 --- /dev/null +++ b/physics/shalcnv.meta @@ -0,0 +1,466 @@ +[ccpp-arg-table] + name = shalcnv_init + type = scheme +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + intent = in + optional = F +[shal_cnv] + standard_name = flag_for_shallow_convection + long_name = flag for calling shallow convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_sas] + standard_name = flag_for_sas_shallow_convection_scheme + long_name = flag for SAS shallow convection scheme + 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 + +######################################################################## +[ccpp-arg-table] + name = shalcnv_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = shalcnv_run + type = scheme +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[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 +[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 +[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 +[fv] + 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 +[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 +[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 +[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 +[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 +[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 +[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 +[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 +[km] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[jcap] + standard_name = number_of_spectral_wave_trancation_for_sas + long_name = number of spectral wave trancation used only by sascnv and shalcnv + units = count + dimensions = () + type = integer + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslp] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psp] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + 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 + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + 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 + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q1] + 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 + optional = F +[t1] + 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 +[u1] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[v1] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rn] + standard_name = lwe_thickness_of_shallow_convective_precipitation_amount + long_name = shallow 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 = inout + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + 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 +[islimsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dot] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ncloud] + standard_name = number_of_hydrometeors + long_name = number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = pbl height + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_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 +[dt_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 +[cnvw] + standard_name = convective_cloud_water_mixing_ratio + long_name = moist convective cloud water mixing ratio + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnvc] + standard_name = convective_cloud_cover + long_name = convective cloud cover + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clam] + standard_name = entrainment_rate_coefficient_shallow_convection + long_name = entrainment rate coefficient for shallow convection + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c0] + standard_name = rain_conversion_parameter_shallow_convection + long_name = convective rain conversion parameter for shallow convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[c1] + standard_name = detrainment_conversion_parameter_shallow_convection + long_name = convective detrainment conversion parameter for shallow convection + units = m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pgcon] + standard_name = momentum_transport_reduction_factor_pgf_shallow_convection + long_name = reduction factor in momentum transport due to shallow convection induced pressure gradient force + units = frac + 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 + 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 bd473788ffe2ac5e3cc9d552d2701d51d480117d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 19 Nov 2019 14:47:15 -0700 Subject: [PATCH 38/84] physics/sascnvn.meta: bugfix, use correct variable for cloud work function --- physics/sascnvn.meta | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta index eecc4f07b..48c56d4b9 100644 --- a/physics/sascnvn.meta +++ b/physics/sascnvn.meta @@ -275,9 +275,9 @@ intent = inout optional = F [cldwrk] - standard_name = cumulative_cloud_work_function - long_name = cumulative cloud work function (valid only with sas) - units = m2 s-1 + standard_name = cloud_work_function + long_name = cloud work function + units = m2 s-2 dimensions = (horizontal_dimension) type = real kind = kind_phys From cbbac67726041aca4bca942fa52036d82f06be00 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 20 Nov 2019 09:41:05 -0700 Subject: [PATCH 39/84] mfpbltq.f, mfscuq.f, satmedmfvdifq.F: change comments in code from "HAFS version" to "updated version" --- physics/mfpbltq.f | 2 +- physics/mfscuq.f | 2 +- physics/satmedmfvdifq.F | 8 ++++---- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/mfpbltq.f b/physics/mfpbltq.f index 1a267370a..0f4004444 100644 --- a/physics/mfpbltq.f +++ b/physics/mfpbltq.f @@ -1,7 +1,7 @@ !>\file mfpbltq.f !! This file contains the subroutine that calculates mass flux and !! updraft parcel properties for thermals driven by surface heating -!! for use in the TKE-EDMF PBL scheme (HAFS version). +!! for use in the TKE-EDMF PBL scheme (updated version). !>\ingroup satmedmfq !! This subroutine computes mass flux and updraft parcel properties for diff --git a/physics/mfscuq.f b/physics/mfscuq.f index ba35cde9f..c6f66b74b 100644 --- a/physics/mfscuq.f +++ b/physics/mfscuq.f @@ -1,6 +1,6 @@ !>\file mfscuq.f !! This file contains the mass flux and downdraft parcel preperties -!! parameterization for stratocumulus-top-driven turbulence (HAFS version). +!! parameterization for stratocumulus-top-driven turbulence (updated version). !>\ingroup satmedmfq !! This subroutine computes mass flux and downdraft parcel properties diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 0e939efd6..c3d061a9c 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -1,6 +1,6 @@ !> \file satmedmfvdifq.F -!! This file contains the CCPP-compliant SATMEDMF scheme (HAFS version) which computes -!! subgrid vertical turbulence mixing using scale-aware TKE-based moist +!! This file contains the CCPP-compliant SATMEDMF scheme (updated version) which +!! computes subgrid vertical turbulence mixing using scale-aware TKE-based moist !! eddy-diffusion mass-flux (TKE-EDMF) parameterization (by Jongil Han). module satmedmfvdifq @@ -33,10 +33,10 @@ end subroutine satmedmfvdifq_init subroutine satmedmfvdifq_finalize () end subroutine satmedmfvdifq_finalize -!> \defgroup satmedmfq GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF, HAFS version) Scheme Module +!> \defgroup satmedmfq GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF, updated version) Scheme Module !! @{ !! \brief This subroutine contains all of the logic for the -!! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF, HAFS version) scheme. +!! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF, updated version) scheme. !! !> \section arg_table_satmedmfvdifq_run Argument Table !! \htmlinclude satmedmfvdifq_run.html From 27c21dba95568fc6c57a01e0f48081391cad7955 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 22 Nov 2019 15:38:25 -0700 Subject: [PATCH 40/84] From @mzhangw: add Ferrier-Aligo microphysics scheme and make corresponding changes in interstitial and radiation code --- physics/GFS_MP_generic.F90 | 9 +- physics/GFS_MP_generic.meta | 8 + physics/GFS_PBL_generic.F90 | 43 +- physics/GFS_PBL_generic.meta | 32 + physics/GFS_rrtmg_pre.F90 | 18 +- physics/GFS_rrtmg_pre.meta | 45 + physics/GFS_suite_interstitial.F90 | 28 +- physics/GFS_suite_interstitial.meta | 16 + physics/docs/ccpp_doxyfile | 4 + physics/maximum_hourly_diagnostics.F90 | 11 +- physics/maximum_hourly_diagnostics.meta | 8 + physics/module_MP_FER_HIRES.F90 | 2923 +++++++++++++++++++++++ physics/mp_fer_hires.F90 | 401 ++++ physics/mp_fer_hires.meta | 426 ++++ physics/radiation_clouds.f | 3 + 15 files changed, 3946 insertions(+), 29 deletions(-) create mode 100644 physics/module_MP_FER_HIRES.F90 create mode 100644 physics/mp_fer_hires.F90 create mode 100644 physics/mp_fer_hires.meta diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 512257258..a7afa2ee0 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -81,7 +81,7 @@ end subroutine GFS_MP_generic_post_init !> \section gfs_mp_gen GFS MP Generic Post General Algorithm !> @{ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, & - imp_physics_thompson, imp_physics_mg, cal_pre, lssav, ldiag3d, cplflx, cplchm, con_g, dtf, frain, rainc, rain1, & + imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires, cal_pre, lssav, ldiag3d, cplflx, cplchm, con_g, dtf, frain, rainc, rain1, & rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_qv, rain0, ice0, snow0, & 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, & @@ -93,7 +93,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt implicit none 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 + 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 real(kind=kind_phys), intent(in) :: dtf, frain, con_g @@ -179,6 +179,10 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt graupel = frain*graupel0 ! time-step graupel ice = frain*ice0 ! time-step ice snow = frain*snow0 ! time-step snow + + else if (imp_physics == imp_physics_fer_hires) then + tprcp = max (0.,rain) ! time-step convective and explicit precip + ice = frain*rain1*sr ! time-step ice end if if (lsm==lsm_ruc) then @@ -296,7 +300,6 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt ! if (snow0(i)+ice0(i)+graupel0(i)+csnow > 0.0) then ! Sfcprop%srflag(i) = 1. ! clu: set srflag to 'snow' (i.e. 1) ! endif -! compute fractional srflag total_precip = snow0(i)+ice0(i)+graupel0(i)+rain0(i)+rainc(i) if (total_precip > rainmin) then srflag(i) = (snow0(i)+ice0(i)+graupel0(i)+csnow)/total_precip diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 2e55b6ad5..3a11a9983 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -234,6 +234,14 @@ type = integer intent = in optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [cal_pre] standard_name = flag_for_precipitation_type_algorithm long_name = flag controls precip type algorithm diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index ec6134ed5..4bebae589 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -81,9 +81,9 @@ end subroutine GFS_PBL_generic_pre_finalize !! subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, & ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, & - ntwa, ntia, ntgl, ntoz, ntke, ntkev, trans_aero, ntchs, ntchm, & + 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, cplchm, ltaerosol, hybedmf, do_shoc, & + imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, cplchm, ltaerosol, hybedmf, do_shoc, & satmedmf, qgrs, vdftra, errmsg, errflg) use machine, only : kind_phys @@ -93,10 +93,10 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, integer, intent(in) :: im, levs, nvdiff, ntrac integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc - integer, intent(in) :: ntwa, ntia, ntgl, ntoz, ntke, ntkev, ntchs, ntchm + integer, intent(in) :: ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef,ntchs, ntchm logical, intent(in) :: trans_aero integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 - integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg + 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, levs, ntrac), intent(in) :: qgrs @@ -126,6 +126,20 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,4) = qgrs(i,k,ntoz) enddo enddo + + ! Ferrier-Aligo + elseif (imp_physics == imp_physics_fer_hires) then + do k=1,levs + do i=1,im + vdftra(i,k,1) = qgrs(i,k,ntqv) + vdftra(i,k,2) = qgrs(i,k,ntcw) + vdftra(i,k,3) = qgrs(i,k,ntiw) + vdftra(i,k,4) = qgrs(i,k,ntrw) + vdftra(i,k,5) = qgrs(i,k,nqrimef) + vdftra(i,k,6) = qgrs(i,k,ntoz) + enddo + enddo + elseif (imp_physics == imp_physics_thompson) then ! Thompson if(ltaerosol) then @@ -263,9 +277,10 @@ end subroutine GFS_PBL_generic_post_finalize !! \htmlinclude GFS_PBL_generic_post_run.html !! subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, & - ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev, & + ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, 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, & ltaerosol, cplflx, cplchm, lssav, ldiag3d, lsidea, hybedmf, do_shoc, satmedmf, shinhong, do_ysu, & dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, & @@ -280,10 +295,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, implicit none integer, intent(in) :: im, levs, nvdiff, ntrac, ntchs, ntchm - integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev + integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef logical, intent(in) :: trans_aero integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 - integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg + integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu @@ -365,6 +380,20 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntoz) = dvdftra(i,k,4) enddo enddo + + elseif (imp_physics == imp_physics_fer_hires) then + ! Ferrier-Aligo + do k=1,levs + do i=1,im + dqdt(i,k,ntqv) = dvdftra(i,k,1) + dqdt(i,k,ntcw) = dvdftra(i,k,2) + dqdt(i,k,ntiw) = dvdftra(i,k,3) + dqdt(i,k,ntrw) = dvdftra(i,k,4) + dqdt(i,k,nqrimef) = dvdftra(i,k,5) + dqdt(i,k,ntoz) = dvdftra(i,k,6) + enddo + enddo + elseif (imp_physics == imp_physics_thompson) then ! Thompson if(ltaerosol) then diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 25e696add..51764e04d 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -161,6 +161,14 @@ type = integer intent = in optional = F +[nqrimef] + standard_name = index_for_mass_weighted_rime_factor + long_name = tracer index for mass weighted rime factor + units = index + dimensions = () + type = integer + intent = in + optional = F [trans_aero] standard_name = flag_for_aerosol_convective_transport_and_PBL_diffusion long_name = flag for aerosol convective transport and PBL diffusion @@ -233,6 +241,14 @@ type = integer intent = in optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) @@ -473,6 +489,14 @@ type = integer intent = in optional = F +[nqrimef] + standard_name = index_for_mass_weighted_rime_factor + long_name = tracer index for mass weighted rime factor + units = index + dimensions = () + type = integer + intent = in + optional = F [trans_aero] standard_name = flag_for_aerosol_convective_transport_and_PBL_diffusion long_name = flag for aerosol convective transport and PBL diffusion @@ -545,6 +569,14 @@ type = integer intent = in optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [ltaerosol] standard_name = flag_for_aerosol_physics long_name = flag for aerosol physics diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index f6e683bff..aa1ea039e 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -21,6 +21,7 @@ end subroutine GFS_rrtmg_pre_init subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Coupling, & Radtend, & ! input/output + f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only lm, im, lmk, lmp, & ! input kd, kt, kb, raddt, delp, dz, plvl, plyr, & ! output tlvl, tlyr, tsfg, tsfa, qlyr, olyr, & @@ -60,6 +61,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input & NSPC1 use module_radiation_clouds, only: NF_CLDS, & ! cld_init & progcld1, progcld3, & + & progcld2, & & progcld4, progcld5, & & progclduni use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & @@ -81,8 +83,16 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input integer, intent(in) :: im, lm, lmk, lmp integer, intent(out) :: kd, kt, kb + +! F-A mp scheme only + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_ice + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rain + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rimef + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: cwm + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin real(kind=kind_phys), intent(out) :: raddt + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: delp real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: dz real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: plvl @@ -519,7 +529,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water/ice enddo enddo - elseif (Model%ncnd == 2) then ! MG + elseif (Model%ncnd == 2) then ! MG or F-A do k=1,LMK do i=1,IM ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water @@ -713,6 +723,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Model%sup, Model%kdt, me, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + elseif (Model%imp_physics == 11) then ! GFDL cloud scheme if (.not.Model%lgfdlmprad) then @@ -737,8 +748,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif - elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then ! Thompson / WSM6 cloud micrphysics scheme - + elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6 .or. & + Model%imp_physics == 15) then if (Model%kdt == 1) then Tbd%phy_f3d(:,:,Model%nleffr) = 10. Tbd%phy_f3d(:,:,Model%nieffr) = 50. @@ -759,7 +770,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! endif ! end_if_ntcw -! CCPP do k = 1, LMK do i = 1, IM clouds1(i,k) = clouds(i,k,1) diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index d0c370882..7b40e2c1d 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -70,6 +70,51 @@ type = GFS_radtend_type intent = inout optional = F +[f_ice] + standard_name = fraction_of_ice_water_cloud + long_name = fraction of ice water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[f_rain] + standard_name = fraction_of_rain_water_cloud + long_name = fraction of rain water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[f_rimef] + standard_name = rime_factor + long_name = rime factor + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flgmin] + standard_name = minimum_large_ice_fraction + long_name = minimum large ice fraction in F-A mp scheme + units = frac + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[cwm] + standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics + long_name = total cloud condensate mixing ratio (except water vapor) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F [lm] standard_name = number_of_vertical_layers_for_radiation_calculations long_name = number of vertical layers for radiation calculation diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 6ec16f8b9..1df53ff12 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -14,21 +14,22 @@ end subroutine GFS_suite_interstitial_rad_reset_finalize !> \section arg_table_GFS_suite_interstitial_rad_reset_run Argument Table !! \htmlinclude GFS_suite_interstitial_rad_reset_run.html !! - subroutine GFS_suite_interstitial_rad_reset_run (Interstitial, errmsg, errflg) + subroutine GFS_suite_interstitial_rad_reset_run (Interstitial, Model, errmsg, errflg) - use GFS_typedefs, only: GFS_interstitial_type + use GFS_typedefs, only: GFS_control_type,GFS_interstitial_type implicit none ! interface variables type(GFS_interstitial_type), intent(inout) :: Interstitial + type(GFS_control_type), intent(in) :: Model character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg errmsg = '' errflg = 0 - call Interstitial%rad_reset() + call Interstitial%rad_reset(Model) end subroutine GFS_suite_interstitial_rad_reset_run @@ -459,11 +460,16 @@ 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, & - clw, rhc, save_qc, save_qi, errmsg, errflg) + 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, imp_physics_fer_hires, prsi, & + prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, & + work1, work2, kpbl, kinver,clw, rhc, save_qc, save_qi, & + errmsg, errflg) use machine, only: kind_phys @@ -472,7 +478,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,imp_physics_fer_hires integer, dimension(im), intent(in) :: islmsk, kpbl, kinver logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol @@ -619,7 +625,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr else save_qi(:,:) = clw(:,:,1) endif - elseif (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_mg) then + elseif (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_mg .or. imp_physics == imp_physics_fer_hires) then do k=1,levs do i=1,im clw(i,k,1) = gq0(i,k,ntiw) ! ice @@ -680,6 +686,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! dqdti may not be allocated real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -748,6 +755,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to enddo endif endif + else do k=1,levs do i=1,im diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index c07d9341a..44696dcb0 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -9,6 +9,14 @@ type = GFS_interstitial_type intent = inout optional = F +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1275,6 +1283,14 @@ type = integer intent = in optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [prsi] standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces diff --git a/physics/docs/ccpp_doxyfile b/physics/docs/ccpp_doxyfile index 91c80c221..b435664e3 100644 --- a/physics/docs/ccpp_doxyfile +++ b/physics/docs/ccpp_doxyfile @@ -245,6 +245,10 @@ INPUT = pdftxt/mainpage.txt \ ../module_mp_thompson.F90 \ ../module_mp_radar.F90 \ ../mp_thompson_post.F90 \ +### HAFS + ../module_MP_FER_HIRES.F90 \ + ../mp_fer_hires.F90 \ + ../module_mp_fer_hires_pre.F90 \ ### utils ../funcphys.f90 \ ../physparam.f \ diff --git a/physics/maximum_hourly_diagnostics.F90 b/physics/maximum_hourly_diagnostics.F90 index 10533d99d..174e0c95c 100644 --- a/physics/maximum_hourly_diagnostics.F90 +++ b/physics/maximum_hourly_diagnostics.F90 @@ -26,7 +26,8 @@ end subroutine maximum_hourly_diagnostics_finalize !! #endif subroutine maximum_hourly_diagnostics_run(im, levs, reset, lradar, imp_physics, & - imp_physics_gfdl, imp_physics_thompson, con_g, phil, & + imp_physics_gfdl, imp_physics_thompson, & + imp_physics_fer_hires,con_g, phil, & gt0, refl_10cm, refdmax, refdmax263k, u10m, v10m, & u10max, v10max, spd10max, pgr, t2m, q2m, t02max, & t02min, rh02max, rh02min, errmsg, errflg) @@ -34,7 +35,7 @@ subroutine maximum_hourly_diagnostics_run(im, levs, reset, lradar, imp_physics, ! Interface variables integer, intent(in) :: im, levs logical, intent(in) :: reset, lradar - integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson + integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_fer_hires real(kind_phys), intent(in ) :: con_g real(kind_phys), intent(in ) :: phil(im,levs) real(kind_phys), intent(in ) :: gt0(im,levs) @@ -66,9 +67,9 @@ subroutine maximum_hourly_diagnostics_run(im, levs, reset, lradar, imp_physics, errflg = 0 !Calculate hourly max 1-km agl and -10C reflectivity - if (lradar .and. & - (imp_physics == imp_physics_gfdl .or. & - imp_physics == imp_physics_thompson)) then + if (lradar .and. (imp_physics == imp_physics_gfdl .or. & + imp_physics == imp_physics_thompson .or. & + imp_physics == imp_physics_fer_hires)) then allocate(refd(im)) allocate(refd263k(im)) call max_fields(phil,refl_10cm,con_g,im,levs,refd,gt0,refd263k) diff --git a/physics/maximum_hourly_diagnostics.meta b/physics/maximum_hourly_diagnostics.meta index df6f10913..5146ce2f0 100644 --- a/physics/maximum_hourly_diagnostics.meta +++ b/physics/maximum_hourly_diagnostics.meta @@ -57,6 +57,14 @@ type = integer intent = in optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/module_MP_FER_HIRES.F90 new file mode 100644 index 000000000..67d446044 --- /dev/null +++ b/physics/module_MP_FER_HIRES.F90 @@ -0,0 +1,2923 @@ +!>\file module_MP_FER_HIRES.F90 +!! "Modified" fer_hires microphysics - 11 July 2016 version +!! +! (1) Ice nucleation: Fletcher (1962) replaces Meyers et al. (1992) +! (2) Cloud ice is a simple function of the number concentration from (1), and it +! is no longer a fractional function of the large ice. Thus, the FLARGE & +! FSMALL parameters are no longer used. +! (3) T_ICE_init=-12 deg C provides a slight delay in the initial onset of ice. +! (4) NLImax is a function of rime factor (RF) and temperature. +! a) For RF>10, NLImax=1.e3. Mean ice diameters can exceed the 1 mm maximum +! size in the tables so that NLICE=NLImax=1.e3. +! b) Otherwise, NLImax is 10 L-1 at 0C and decreasing to 5 L-1 at <=-40C. +! NLICE>NLImax at the maximum ice diameter of 1 mm. +! (5) Can turn off ice processes by setting T_ICE & T_ICE_init to be < -100 deg C +! (6) Modified the homogeneous freezing of cloud water when TNLImax. +! (10) Ice deposition does not change the rime factor (RF) when RF>=10 & T>T_ICE. +! (11) Limit GAMMAS to <=1.5 (air resistance impact on ice fall speeds) +! (12) NSImax is maximum # conc of ice crsytals. At cold temperature NSImax is +! calculated based on assuming 10% of total ice content is due to cloud ice. +! +!-- Further modifications starting on 23 July 2015 +! (13) RHgrd is passed in as an input argument so that it can vary for different +! domains (RHgrd=0.98 for 12-km parent, 1.0 for 3-km nests) +! (14) Use the old "PRAUT" cloud water autoconversion *threshold* (QAUT0) + +!-- Further modifications starting on 28 July 2015 +! (15) Added calculations for radar reflectivity and number concentrations of +! rain (Nrain) and precipitating ice (Nsnow). +! (16) Removed double counting of air resistance term for riming onto ice (PIACW) +! (17) The maximum rime factor (RFmx) is now a function of MASSI(INDEXS), accounting +! for the increase in unrimed ice particle densities as values of INDEXS +! decrease from the maximum upper limit of 1000 microns to the lower limit of +! 50 microns, coinciding with the assumed size of cloud ice; see lines 1128-1134. +! (18) A new closure is used for updating the rime factor, which is described in +! detail near lines 1643-1682. The revised code is near lines 1683-1718. +! (19) Restructured the two-pass algorithm to be more robust, removed the HAIL +! & LARGE_RF logical variables so that NLICE>NLImax can occur. +! (20) Increased nsimax (see !aug27 below) +! (21) Modified the rain sedimentation (see two !aug27 blocks below) +! (22) NInuclei is the lower of Fletcher (1962), Cooper (1986), or NSImax. +! (23) NLImax is no longer used or enforced. Instead, INDEXS=MDImax when RF>20, +! else INDEXS is a function of temperature. Look for !sep10 comment. +! (24) An override was inserted for (18), such that the rime density is not diluted +! diluted when RF>20. Look for !sep10 comment. +! (25) Radar reflectivity calculations were changes to reduce radar bright bands, +! limit enhanced, mixed-phase reflectivity to RF>=20. Look for !sep10 comments. +! (26) NLICE is not to exceed NSI_max (250 L^-1) when RF<20. Look for !sep16 comments. +! Commented out! (28) Increase hail fall speeds using Thompson et al. (2008). Look for !sep22 comments. +! (29) Modify NLImax, INDEXS for RF>=20. Look for !sep22 comments. +! (30) Check on NSmICE, Vci based on whether FLIMASS<1. Look for !sep22a comments. +! Revised in (34)! (31) Introduced RFlag logical, which if =T enforces a lower limit of drop sizes not +! to go below INDEXRmin and N0r is adjusted. Look for !nov25 comments (corrections, +! refinements to sep25 & nov18 versions, includes an additional fix in nov25-fix). +! Also set INDEXRmin=500 rather than 250 microns. +!----------------------------------------------------------------------------- +!--- The following changes now refer to dates when those were made in 2016. +!----------------------------------------------------------------------------- +! (32) Convective (RF>=20, Ng~10 L^-1, RHOg~500 kg m^-3), transition (RF=10, Ng~25 L^-1, +! RHOg~300 kg m^-3), & stratiform (RF<2) profiles are blended based on RF. !mar08 +! (33) Fixed bug in Biggs' freezing, put back in collisional drop freezing. !mar03 +! (34) Changes in (31) are revised so that INDEXRmin at and below 0C level is +! based on a rain rate equal to the snowfall rate above the 0C level. !mar03 +! (35) Increase radar reflectivity when RF>10 and RQSnew > 2.5 g m^-3. !mar12 +! (36) !mar10 combines all elements of (32)-(35) together. +! (37) Bug fixes for the changes in (34) and the RFLAG variable !apr18 +! (38) Revised Schumann-Ludlam limit. !apr18 +! (39) Simplified PCOND (cloud cond/evap) calculation !apr21 +! (40) Slight change in calculating RF. !apr22 +! (41) Reduce RF values for calculating mean sizes of snow, graupel, sleet/hail !apr22a +! (42) Increase reflectivity from large, wet, high rime factor ice (graupel) by +! assuming |Kw|**2/|Ki|**2 = 0.224 (Smith, 1984, JCAM). +! (43) Major restructuring of code to allow N0r to vary from N0r0 !may11 +! (44) More major restructuring of code to use fixed XLS, XLV, XLF !may12 +! (45) Increased VEL_INC ~ VrimeF**2, put the enhanced graupel/hail fall speeds +! from Thompson into the code but only in limited circumstances, restructured +! and streamlined the INDEXS calculation, removed the upper limit for +! for the vapor mixing ratio is at water saturation when calculating ice +! deposition, and N0r is gradually increased for conditions supporting +! drizzle when rain contents decrease below 0.25 g/m**3. !may17 +! (46) The may11 code changes that increase N0r0 when rain contents exceed 1 g m^-3 +! have been removed, limit the number of iterations calculating final rain +! parameters, remove the revised N0r calculation for reflectivity. All of +! the changes following those made in the may10 code. !may20 +! (47) Reduce the assumed # concentration of hail/sleet when RF>10 from 5 L^-1 to +! 1 L^-1, and also reduce it for graupel when RF>5 from 10 L^-1 to 5 L^-1. +! This is being done to try and make greater use of the Thompson graupel/hail +! fallspeeds by having INDEXS==MDImax. +! (48) Increased NCW from 200e6 to 300e6 for a more delayed onset of drizzle, +! simplified drizzle algorithm to reduce/eliminate N0r bulls eyes and to allow +! for supercooled drizzle, and set limits for 8.e6 <= N0r (m^-4) <= 1.e9 !may31 +! (49) Further restructuring of code to better define STRAT, DRZL logicals, +! add these rain flags to mprates arrays !jun01 +! (50) Increase in reflectivity due to wet ice was commented out. +! (51) Fixed minor bug to update INDEXR2 in the "rain_pass: do" loop. !jun13 +! (52) Final changes to Nsnow for boosting reflectivities from ice for +! mass contents exceeding 5 g m^-3. !jun16 +! (53) Cosmetic changes only that do not affect the calculations. Removed old, unused +! diagnostic arrays. Updated comments. +! +!----------------------------------------------------------------------------- +! + MODULE MODULE_MP_FER_HIRES +! +!----------------------------------------------------------------------------- + +#ifdef MPI + USE mpi +#endif + USE machine +!MZ +!MZ USE MODULE_CONSTANTS,ONLY : PI, CP, EPSQ, GRAV=>G, RHOL=>RHOWATER, & +!MZ RD=>R_D, RV=>R_V, T0C=>TIW, EPS=>EP_2, EPS1=>EP_1, CLIQ, CICE, & +!MZ XLV +!MZ +!MZ temporary values copied from module_CONSTANTS; ideally they come from host model +!side + REAL, PARAMETER :: pi=3.141592653589793 ! ludolf number + REAL, PARAMETER :: cp=1004.6 ! spec. heat for dry air at constant pressure + REAL, PARAMETER :: epsq=1.e-12 ! floor value for specific humidity (kg/kg) + REAL, PARAMETER :: grav= 9.8060226 ! gravity + REAL, PARAMETER :: RHOL=1000. ! density of water (kg/m3) + REAL, PARAMETER :: RD=287.04 ! gas constant for dry air + REAL, PARAMETER :: RV=461.6 ! gas constant for water vapor + REAL, PARAMETER :: T0C= 273.15 ! melting point + REAL, PARAMETER :: EPS=RD/RV + REAL, PARAMETER :: EPS1=RV/RD-1. + REAL, PARAMETER :: CLIQ = 4190. ! MZ: inconsistent value below + REAL, PARAMETER :: CICE = 2106. + REAL, PARAMETER :: XLV = 2.5E6 +!----------------------------------------------------------------------------- + PUBLIC :: FERRIER_INIT_HR, GPVS_HR,FPVS,FPVS0,NX +!----------------------------------------------------------------------------- + REAL,PRIVATE,SAVE :: ABFR, CBFR, CIACW, CIACR, C_N0r0, C_NR, Crain, & !jul28 + & CRACW, ARAUT, BRAUT, ESW0, RFmx1, ARcw, RH_NgC, RH_NgT, & !jul31 !mar08 + & RR_DRmin, RR_DR1, RR_DR2, RR_DR3, RR_DR4, RR_DR5, RR_DRmax, & !may17 + & BETA6, & + & RQhail, AVhail, BVhail, QAUT0 !may17 +! + INTEGER,PRIVATE,PARAMETER :: INDEXRstrmax=500 !mar03, stratiform maximum + REAL,PUBLIC,SAVE :: CN0r0, CN0r_DMRmin, CN0r_DMRmax, & + RFmax, RQR_DRmax, RQR_DRmin +! + INTEGER, PRIVATE,PARAMETER :: MY_T1=1, MY_T2=35 + REAL,PRIVATE,DIMENSION(MY_T1:MY_T2),SAVE :: MY_GROWTH_NMM +! + REAL, PRIVATE,PARAMETER :: DMImin=.05e-3, DMImax=1.e-3, & + & DelDMI=1.e-6,XMImin=1.e6*DMImin + REAL, PUBLIC,PARAMETER :: XMImax=1.e6*DMImax, XMIexp=.0536 + INTEGER, PUBLIC,PARAMETER :: MDImin=XMImin, MDImax=XMImax + REAL, PRIVATE,DIMENSION(MDImin:MDImax) :: & + & ACCRI,VSNOWI,VENTI1,VENTI2 + REAL, PUBLIC,DIMENSION(MDImin:MDImax) :: SDENS !-- For RRTM +! + REAL, PRIVATE,PARAMETER :: DMRmin=.05e-3, DMRmax=1.0e-3, & + & DelDMR=1.e-6, XMRmin=1.e6*DMRmin, XMRmax=1.e6*DMRmax + INTEGER, PUBLIC,PARAMETER :: MDRmin=XMRmin, MDRmax=XMRmax +! + REAL, PRIVATE,DIMENSION(MDRmin:MDRmax):: & + & ACCRR,MASSR,RRATE,VRAIN,VENTR1,VENTR2 +! + INTEGER, PRIVATE,PARAMETER :: Nrime=40 + REAL, DIMENSION(2:9,0:Nrime),PRIVATE,SAVE :: VEL_RF +! + INTEGER,PARAMETER :: NX=7501 + REAL, PARAMETER :: XMIN=180.0,XMAX=330.0 + REAL, DIMENSION(NX),PUBLIC,SAVE :: TBPVS,TBPVS0 + REAL, PUBLIC,SAVE :: C1XPVS0,C2XPVS0,C1XPVS,C2XPVS +! + REAL,DIMENSION(MY_T2+8) :: MP_RESTART_STATE + REAL,DIMENSION(nx) :: TBPVS_STATE,TBPVS0_STATE +! + REAL, PRIVATE,PARAMETER :: CVAP=1846., XLF=3.3358e+5, XLS=XLV+XLF & + & ,EPSQ1=1.001*EPSQ, RCP=1./CP, RCPRV=RCP/RV, RGRAV=1./GRAV & + & ,RRHOL=1./RHOL, XLV1=XLV/CP, XLF1=XLF/CP, XLS1=XLS/CP & + & ,XLV2=XLV*XLV/RV, XLS2=XLS*XLS/RV & + & ,XLV3=XLV*XLV*RCPRV, XLS3=XLS*XLS*RCPRV & +!--- Constants specific to the parameterization follow: +!--- CLIMIT/CLIMIT1 are lower limits for treating accumulated precipitation + & ,CLIMIT=10.*EPSQ, CLIMIT1=-CLIMIT & + & ,C1=1./3. & + & ,DMR1=.1E-3, DMR2=.2E-3, DMR3=.32E-3, DMR4=0.45E-3 & + & ,DMR5=0.67E-3 & + & ,XMR1=1.e6*DMR1, XMR2=1.e6*DMR2, XMR3=1.e6*DMR3 & + & ,XMR4=1.e6*DMR4, XMR5=1.e6*DMR5, RQRmix=0.05E-3, RQSmix=1.E-3 & !jul28 !apr27 + & ,Cdry=1.634e13, Cwet=1./.224 !jul28 !apr27 + INTEGER, PARAMETER :: MDR1=XMR1, MDR2=XMR2, MDR3=XMR3, MDR4=XMR4 & + & , MDR5=XMR5 + +!-- Debug 20120111 +LOGICAL, SAVE :: WARN1=.TRUE.,WARN2=.TRUE.,WARN3=.TRUE.,WARN5=.TRUE. +REAL, SAVE :: Pwarn=75.E2, QTwarn=1.E-3 +INTEGER, PARAMETER :: MAX_ITERATIONS=10 + +! +! ====================================================================== +!--- Important tunable parameters that are exported to other modules +! * T_ICE - temperature (C) threshold at which all remaining liquid water +! is glaciated to ice +! * T_ICE_init - maximum temperature (C) at which ice nucleation occurs +! +!-- To turn off ice processes, set T_ICE & T_ICE_init to <= -100. (i.e., -100 C) +! +! * NSImax - maximum number concentrations (m**-3) of small ice crystals +! * NLImin - minimum number concentrations (m**-3) of large ice (snow/graupel/sleet) +! * N0r0 - assumed intercept (m**-4) of rain drops if drop diameters are between 0.2 and 1.0 mm +! * N0rmin - minimum intercept (m**-4) for rain drops +! * NCW - number concentrations of cloud droplets (m**-3) +! ====================================================================== + REAL, PUBLIC,PARAMETER :: & + & RHgrd_in=1. & + &, P_RHgrd_out=850.E2 & + & ,T_ICE=-40. & + & ,T_ICEK=T0C+T_ICE & + & ,T_ICE_init=-12. & + & ,NSI_max=250.E3 & + & ,NLImin=1.0E3 & + & ,N0r0=8.E6 & + & ,N0rmin=1.E4 & +!! based on Aligo's email,NCW is changed to 250E6 + & ,NCW=250.E6 + !HWRF & ,NCW=300.E6 !- 100.e6 (maritime), 500.e6 (continental) + +!--- Other public variables passed to other routines: + REAL, PUBLIC,DIMENSION(MDImin:MDImax) :: MASSI +! + + CONTAINS +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +!----------------------------------------------------------------------- + +!>\ingroup hafs_famp +!! This is the driver scheme of Ferrier-Aligo microphysics scheme. +!! NOTE: The only differences between FER_HIRES and FER_HIRES_ADVECT +!! is that the QT, and F_* are all local variables in the advected +!! version, and QRIMEF is only in the advected version. The innards +!! are all the same. + SUBROUTINE FER_HIRES (DT,RHgrd, & + & dz8w,rho_phy,p_phy,pi_phy,th_phy,t_phy, & + & q,qt, & + & LOWLYR,SR, & + & F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & + & QC,QR,QS, & + & RAINNC,RAINNCV, & + & threads, & + & ims,ime, jms,jme, lm, & + & d_ss, & + & refl_10cm,DX1 ) +!----------------------------------------------------------------------- + IMPLICIT NONE +!----------------------------------------------------------------------- + INTEGER,INTENT(IN) :: D_SS,IMS,IME,JMS,JME,LM,DX1 + REAL, INTENT(IN) :: DT,RHgrd + INTEGER, INTENT(IN) :: THREADS + REAL, INTENT(IN), DIMENSION(ims:ime, jms:jme, lm):: & + & dz8w,p_phy,pi_phy,rho_phy + REAL, INTENT(INOUT), DIMENSION(ims:ime, jms:jme, lm):: & + & th_phy,t_phy,q,qt + REAL, INTENT(INOUT), DIMENSION(ims:ime,jms:jme, lm ) :: & + & qc,qr,qs + REAL, INTENT(INOUT), DIMENSION(ims:ime, jms:jme,lm) :: & + & F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY + REAL, INTENT(OUT), DIMENSION(ims:ime, jms:jme,lm) :: & + & refl_10cm + REAL, INTENT(INOUT), DIMENSION(ims:ime,jms:jme) :: & + & RAINNC,RAINNCV + REAL, INTENT(OUT), DIMENSION(ims:ime,jms:jme):: SR +! + INTEGER, DIMENSION( ims:ime, jms:jme ),INTENT(INOUT) :: LOWLYR + +!----------------------------------------------------------------------- +! LOCAL VARS +!----------------------------------------------------------------------- + +! TLATGS_PHY,TRAIN_PHY,APREC,PREC,ACPREC,SR are not directly related +! the microphysics scheme. Instead, they will be used by Eta precip +! assimilation. + + REAL, DIMENSION( ims:ime, jms:jme,lm ) :: & + & TLATGS_PHY,TRAIN_PHY + REAL, DIMENSION(ims:ime,jms:jme):: APREC,PREC,ACPREC + + INTEGER :: I,J,K,KK + REAL :: wc +!------------------------------------------------------------------------ +! For subroutine EGCP01COLUMN_hr +!----------------------------------------------------------------------- + INTEGER :: LSFC,I_index,J_index,L + INTEGER,DIMENSION(ims:ime,jms:jme) :: LMH + REAL :: TC,QI,QRdum,QW,Fice,Frain,DUM,ASNOW,ARAIN + REAL,DIMENSION(lm) :: P_col,Q_col,T_col,WC_col, & + RimeF_col,QI_col,QR_col,QW_col, THICK_col,DPCOL,pcond1d, & + pidep1d,piacw1d,piacwi1d,piacwr1d,piacr1d,picnd1d,pievp1d, & + pimlt1d,praut1d,pracw1d,prevp1d,pisub1d,pevap1d,DBZ_col, & + NR_col,NS_col,vsnow1d,vrain11d,vrain21d,vci1d,NSmICE1d, & + INDEXS1d,INDEXR1d,RFlag1d,RHC_col +! +!----------------------------------------------------------------------- +!********************************************************************** +!----------------------------------------------------------------------- +! + +! MZ: HWRF practice start +!---------- +!2015-03-30, recalculate some constants which may depend on phy time step + CALL MY_GROWTH_RATES_NMM_hr (DT) + +!--- CIACW is used in calculating riming rates +! The assumed effective collection efficiency of cloud water rimed onto +! ice is =0.5 below: +! + CIACW=DT*0.25*PI*0.5*(1.E5)**C1 +! +!--- CIACR is used in calculating freezing of rain colliding with large ice +! The assumed collection efficiency is 1.0 +! + CIACR=PI*DT +! +!--- CRACW is used in calculating collection of cloud water by rain (an +! assumed collection efficiency of 1.0) +! + CRACW=DT*0.25*PI*1.0 +! +!-- See comments in subroutine etanewhr_init starting with variable RDIS= +! + BRAUT=DT*1.1E10*BETA6/NCW + + !write(*,*)'dt=',dt + !write(*,*)'pi=',pi + !write(*,*)'c1=',c1 + !write(*,*)'ciacw=',ciacw + !write(*,*)'ciacr=',ciacr + !write(*,*)'cracw=',cracw + !write(*,*)'araut=',araut + !write(*,*)'braut=',braut +!! END OF adding, 2015-03-30 +!----------- +! MZ: HWRF practice end +! + + DO j = jms,jme + DO i = ims,ime + ACPREC(i,j)=0. + APREC (i,j)=0. + PREC (i,j)=0. + SR (i,j)=0. + ENDDO + DO k = 1,lm + DO i = ims,ime + TLATGS_PHY (i,j,k)=0. + TRAIN_PHY (i,j,k)=0. + ENDDO + ENDDO + ENDDO + +!----------------------------------------------------------------------- +!-- Start of original driver for EGCP01COLUMN_hr +!----------------------------------------------------------------------- +! + DO J=JMS,JME + DO I=IMS,IME + LSFC=LM-LOWLYR(I,J)+1 ! "L" of surface + DO K=1,LM + DPCOL(K)=RHO_PHY(I,J,K)*GRAV*dz8w(I,J,K) + ENDDO +! +!--- Initialize column data (1D arrays) +! + L=LM +!-- qt = CWM, total condensate + IF (qt(I,J,L) .LE. EPSQ) qt(I,J,L)=EPSQ + F_ice_phy(I,J,L)=1. + F_rain_phy(I,J,L)=0. + F_RimeF_phy(I,J,L)=1. + do L=LM,1,-1 +! +!--- Pressure (Pa) = (Psfc-Ptop)*(ETA/ETA_sfc)+Ptop +! + P_col(L)=P_phy(I,J,L) +! +!--- Layer thickness = RHO*DZ = -DP/G = (Psfc-Ptop)*D_ETA/(G*ETA_sfc) +! + THICK_col(L)=DPCOL(L)*RGRAV + T_col(L)=T_phy(I,J,L) + TC=T_col(L)-T0C + Q_col(L)=max(EPSQ, q(I,J,L)) + IF (qt(I,J,L) .LE. EPSQ1) THEN + WC_col(L)=0. + IF (TC .LT. T_ICE) THEN + F_ice_phy(I,J,L)=1. + ELSE + F_ice_phy(I,J,L)=0. + ENDIF + F_rain_phy(I,J,L)=0. + F_RimeF_phy(I,J,L)=1. + ELSE + WC_col(L)=qt(I,J,L) + +!-- Debug 20120111 +! TC==TC will fail if NaN, preventing unnecessary error messages +IF (WC_col(L)>QTwarn .AND. P_col(L)1 g/kg condensate in stratosphere; I,J,L,TC,P,QT=', & + I,J,L,TC,.01*P_col(L),1000.*WC_col(L) + QTwarn=MAX(WC_col(L),10.*QTwarn) + Pwarn=MIN(P_col(L),0.5*Pwarn) +ENDIF +!-- TC/=TC will pass if TC is NaN +IF (WARN5 .AND. TC/=TC) THEN + WRITE(0,*) 'WARN5: NaN temperature; I,J,L,P=',I,J,L,.01*P_col(L) + WARN5=.FALSE. +ENDIF + + ENDIF + IF (T_ICE<=-100.) F_ice_phy(I,J,L)=0. +! ! +! !--- Determine composition of condensate in terms of +! ! cloud water, ice, & rain +! ! + WC=WC_col(L) + QI=0. + QRdum=0. + QW=0. + Fice=F_ice_phy(I,J,L) + Frain=F_rain_phy(I,J,L) +! + IF (Fice .GE. 1.) THEN + QI=WC + ELSE IF (Fice .LE. 0.) THEN + QW=WC + ELSE + QI=Fice*WC + QW=WC-QI + ENDIF +! + IF (QW.GT.0. .AND. Frain.GT.0.) THEN + IF (Frain .GE. 1.) THEN + QRdum=QW + QW=0. + ELSE + QRdum=Frain*QW + QW=QW-QRdum + ENDIF + ENDIF + IF (QI .LE. 0.) F_RimeF_phy(I,J,L)=1. + RimeF_col(L)=F_RimeF_phy(I,J,L) ! (real) + QI_col(L)=QI + QR_col(L)=QRdum + QW_col(L)=QW +!GFDL => New. Added RHC_col to allow for height- and grid-dependent values for +!GFDL the relative humidity threshold for condensation ("RHgrd") +!6/11/2010 mod - Use lower RHgrd_out threshold for < 850 hPa +!------------------------------------------------------------ + IF(DX1 .GE. 10 .AND. P_col(L)0) associated with snow +! + APREC(I,J)=(ARAIN+ASNOW)*RRHOL ! Accumulated surface precip (depth in m) !<--- Ying + PREC(I,J)=PREC(I,J)+APREC(I,J) + ACPREC(I,J)=ACPREC(I,J)+APREC(I,J) + IF(APREC(I,J) .LT. 1.E-8) THEN + SR(I,J)=0. + ELSE + SR(I,J)=RRHOL*ASNOW/APREC(I,J) + ENDIF +! +!####################################################################### +!####################################################################### +! + enddo ! End "I" loop + enddo ! End "J" loop +! +!----------------------------------------------------------------------- +!-- End of original driver for EGCP01COLUMN_hr +!----------------------------------------------------------------------- +! + DO j = jms,jme + do k = lm, 1, -1 + DO i = ims,ime + th_phy(i,j,k) = t_phy(i,j,k)/pi_phy(i,j,k) + WC=qt(I,J,K) + QS(I,J,K)=0. + QR(I,J,K)=0. + QC(I,J,K)=0. +! + IF(F_ICE_PHY(I,J,K)>=1.)THEN + QS(I,J,K)=WC + ELSEIF(F_ICE_PHY(I,J,K)<=0.)THEN + QC(I,J,K)=WC + ELSE + QS(I,J,K)=F_ICE_PHY(I,J,K)*WC + QC(I,J,K)=WC-QS(I,J,K) + ENDIF +! + IF(QC(I,J,K)>0..AND.F_RAIN_PHY(I,J,K)>0.)THEN + IF(F_RAIN_PHY(I,J,K).GE.1.)THEN + QR(I,J,K)=QC(I,J,K) + QC(I,J,K)=0. + ELSE + QR(I,J,K)=F_RAIN_PHY(I,J,K)*QC(I,J,K) + QC(I,J,K)=QC(I,J,K)-QR(I,J,K) + ENDIF + ENDIF + ENDDO !- i + ENDDO !- k + ENDDO !- j +! +!- Update rain (convert from m to kg/m**2, which is also equivalent to mm depth) +! + DO j=jms,jme + DO i=ims,ime + RAINNC(i,j)=APREC(i,j)*1000.+RAINNC(i,j) + RAINNCV(i,j)=APREC(i,j)*1000. + ENDDO + ENDDO +! +!----------------------------------------------------------------------- +! + END SUBROUTINE FER_HIRES +! +!----------------------------------------------------------------------- +! +!############################################################################### +! ***** VERSION OF MICROPHYSICS DESIGNED FOR HIGHER RESOLUTION MESO ETA MODEL +! (1) Represents sedimentation by preserving a portion of the precipitation +! through top-down integration from cloud-top. Modified procedure to +! Zhao and Carr (1997). +! (2) Microphysical equations are modified to be less sensitive to time +! steps by use of Clausius-Clapeyron equation to account for changes in +! saturation mixing ratios in response to latent heating/cooling. +! (3) Prevent spurious temperature oscillations across 0C due to +! microphysics. +! (4) Uses lookup tables for: calculating two different ventilation +! coefficients in condensation and deposition processes; accretion of +! cloud water by precipitation; precipitation mass; precipitation rate +! (and mass-weighted precipitation fall speeds). +! (5) Assumes temperature-dependent variation in mean diameter of large ice +! (Houze et al., 1979; Ryan et al., 1996). +! -> 8/22/01: This relationship has been extended to colder temperatures +! to parameterize smaller large-ice particles down to mean sizes of MDImin, +! which is 50 microns reached at -55.9C. +! (6) Attempts to differentiate growth of large and small ice, mainly for +! improved transition from thin cirrus to thick, precipitating ice +! anvils. +! (7) Top-down integration also attempts to treat mixed-phase processes, +! allowing a mixture of ice and water. Based on numerous observational +! studies, ice growth is based on nucleation at cloud top & +! subsequent growth by vapor deposition and riming as the ice particles +! fall through the cloud. There are two modes of ice nucleation +! following Meyers et al. (JAM, 1992): +! a) Deposition & condensation freezing nucleation - eq. (2.4) when +! air is supersaturated w/r/t ice +! b) Contact freezing nucleation - eq. (2.6) in presence of cloud water +! (8) Depositional growth of newly nucleated ice is calculated for large time +! steps using Fig. 8 of Miller and Young (JAS, 1979), at 1 deg intervals +! using their ice crystal masses calculated after 600 s of growth in water +! saturated conditions. The growth rates are normalized by time step +! assuming 3D growth with time**1.5 following eq. (6.3) in Young (1993). +! (9) Ice precipitation rates can increase due to increase in response to +! cloud water riming due to (a) increased density & mass of the rimed +! ice, and (b) increased fall speeds of rimed ice. +!############################################################################### +!############################################################################### +! +!>\ingroup hafs_famp +!! This is the grid-scale microphysical processes of Ferrier-Aligo microphysics +!! scheme (i.e., condensation and precipitation). +!!\param arain accumulated rainfall at the surface (kg) +!!\param asnow accumulated snowfall at the surface (kg) +!!\param dtph physics time step (s) +!!\param rhc_col vertical column of threshold relative humidity for onset of +!! condensation (ratio) +!!\param i_index i index +!!\param j_index j index +!!\param lsfc Eta level of level above surface, ground +!!\param p_col vertical column of model pressure (Pa) +!!\param qi_col vertical column of model ice mixing ratio (kg/kg) +!!\param qr_col vertical column of model rain ratio (kg/kg) +!!\param q_col vertical column of model water vapor specific humidity (kg/kg) +!!\param qw_col +!!\param rimef_col +!!\param t_col +!!\param thick_col +!!\param wc_col +!!\param lm +!!\param pcond1d +!!\param pidep1d +!!\param piacw1d +!!\param piacwi1d + SUBROUTINE EGCP01COLUMN_hr ( ARAIN, ASNOW, DTPH, RHC_col, & + & I_index, J_index, LSFC, & + & P_col, QI_col, QR_col, Q_col, QW_col, RimeF_col, T_col, & + & THICK_col, WC_col ,LM,pcond1d,pidep1d, & + & piacw1d,piacwi1d,piacwr1d,piacr1d,picnd1d,pievp1d,pimlt1d, & + & praut1d,pracw1d,prevp1d,pisub1d,pevap1d, DBZ_col,NR_col,NS_col, & + & vsnow1d,vrain11d,vrain21d,vci1d,NSmICE1d,INDEXS1d,INDEXR1d, & !jul28 + & RFlag1d,DX1) !jun01 +! +!############################################################################### +!############################################################################### +! +!------------------------------------------------------------------------------- +!----- NOTE: Code is currently set up w/o threading! +!------------------------------------------------------------------------------- +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! . . . +! SUBPROGRAM: Grid-scale microphysical processes - condensation & precipitation +! PRGRMMR: Ferrier ORG: W/NP22 DATE: 08-2001 +! PRGRMMR: Jin (Modification for WRF structure) +!------------------------------------------------------------------------------- +! ABSTRACT: +! * Merges original GSCOND & PRECPD subroutines. +! * Code has been substantially streamlined and restructured. +! * Exchange between water vapor & small cloud condensate is calculated using +! the original Asai (1965, J. Japan) algorithm. See also references to +! Yau and Austin (1979, JAS), Rutledge and Hobbs (1983, JAS), and Tao et al. +! (1989, MWR). This algorithm replaces the Sundqvist et al. (1989, MWR) +! parameterization. +!------------------------------------------------------------------------------- +! +! USAGE: +! * CALL EGCP01COLUMN_hr FROM SUBROUTINE EGCP01DRV +! +! INPUT ARGUMENT LIST: +! DTPH - physics time step (s) +! RHgrd - threshold relative humidity (ratio) for onset of condensation +! I_index - I index +! J_index - J index +! LSFC - Eta level of level above surface, ground +! P_col - vertical column of model pressure (Pa) +! QI_col - vertical column of model ice mixing ratio (kg/kg) +! QR_col - vertical column of model rain ratio (kg/kg) +! Q_col - vertical column of model water vapor specific humidity (kg/kg) +! QW_col - vertical column of model cloud water mixing ratio (kg/kg) +! RimeF_col - vertical column of rime factor for ice in model (ratio, defined below) +! T_col - vertical column of model temperature (deg K) +! THICK_col - vertical column of model mass thickness (density*height increment) +! WC_col - vertical column of model mixing ratio of total condensate (kg/kg) +! RHC_col - vertical column of threshold relative humidity for onset of condensation (ratio) !GFDL +! +! +! OUTPUT ARGUMENT LIST: +! ARAIN - accumulated rainfall at the surface (kg) +! ASNOW - accumulated snowfall at the surface (kg) +! Q_col - vertical column of model water vapor specific humidity (kg/kg) +! WC_col - vertical column of model mixing ratio of total condensate (kg/kg) +! QW_col - vertical column of model cloud water mixing ratio (kg/kg) +! QI_col - vertical column of model ice mixing ratio (kg/kg) +! QR_col - vertical column of model rain ratio (kg/kg) +! RimeF_col - vertical column of rime factor for ice in model (ratio, defined below) +! T_col - vertical column of model temperature (deg K) +! DBZ_col - vertical column of radar reflectivity (dBZ) +! NR_col - vertical column of rain number concentration (m^-3) +! NS_col - vertical column of snow number concentration (m^-3) +! +! OUTPUT FILES: +! NONE +! +! Subprograms & Functions called: +! * Real Function CONDENSE - cloud water condensation +! * Real Function DEPOSIT - ice deposition (not sublimation) +! * Integer Function GET_INDEXR - estimate the mean size of raindrops (microns) +! +! UNIQUE: NONE +! +! LIBRARY: NONE +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN 90 +! MACHINE : IBM SP +! +!------------------------------------------------------------------------- +!--------------- Arrays & constants in argument list --------------------- +!------------------------------------------------------------------------- +! + IMPLICIT NONE +! + INTEGER,INTENT(IN) :: LM,I_index, J_index, LSFC,DX1 + REAL,INTENT(IN) :: DTPH + REAL,INTENT(INOUT) :: ARAIN, ASNOW + REAL,DIMENSION(LM),INTENT(INOUT) :: P_col, QI_col,QR_col & + & ,Q_col ,QW_col, RimeF_col, T_col, THICK_col,WC_col,pcond1d & + & ,pidep1d,piacw1d,piacwi1d,piacwr1d,piacr1d,picnd1d,pievp1d & + & ,pimlt1d,praut1d,pracw1d,prevp1d,pisub1d,pevap1d,DBZ_col,NR_col & + & ,NS_col,vsnow1d,vrain11d,vrain21d,vci1d,NSmICE1d,INDEXS1d & !jun01 + & ,INDEXR1d,RFlag1d,RHC_col !jun01 +! +!-------------------------------------------------------------------------------- +!--- The following arrays are integral calculations based on the mean +! snow/graupel diameters, which vary from 50 microns to 1000 microns +! (1 mm) at 1-micron intervals and assume exponential size distributions. +! The values are normalized and require being multipled by the number +! concentration of large ice (NLICE). +!--------------------------------------- +! - VENTI1 - integrated quantity associated w/ ventilation effects +! (capacitance only) for calculating vapor deposition onto ice +! - VENTI2 - integrated quantity associated w/ ventilation effects +! (with fall speed) for calculating vapor deposition onto ice +! - ACCRI - integrated quantity associated w/ cloud water collection by ice +! - MASSI - integrated quantity associated w/ ice mass +! - VSNOWI - mass-weighted fall speed of snow (large ice), used to calculate +! precipitation rates +! - VEL_RF - velocity increase of rimed particles as functions of crude +! particle size categories (at 0.1 mm intervals of mean ice particle +! sizes) and rime factor (different values of Rime Factor of 1.1**N, +! where N=0 to Nrime). +!-------------------------------------------------------------------------------- +!--- The following arrays are integral calculations based on the mean +! rain diameters, which vary from 50 microns to 1000 microns +! (1 mm) at 1-micron intervals and assume exponential size distributions. +! The values are normalized and require being multiplied by the rain intercept +! (N0r). +!--------------------------------------- +! - VENTR1 - integrated quantity associated w/ ventilation effects +! (capacitance only) for calculating evaporation from rain +! - VENTR2 - integrated quantity associated w/ ventilation effects +! (with fall speed) for calculating evaporation from rain +! - ACCRR - integrated quantity associated w/ cloud water collection by rain +! - MASSR - integrated quantity associated w/ rain +! - VRAIN - mass-weighted fall speed of rain, used to calculate +! precipitation rates +! - RRATE - precipitation rates, which should also be equal to RHO*QR*VRAIN +! +!------------------------------------------------------------------------- +!------- Key parameters, local variables, & important comments --------- +!----------------------------------------------------------------------- +! +!--- TOLER => Tolerance or precision for accumulated precipitation +! + REAL, PARAMETER :: TOLER=5.E-7, C2=1./6., RHO0=1.194, & + Xratio=.025, Zmin=0.01, DBZmin=-20. +! +!--- If BLEND=1: +! precipitation (large) ice amounts are estimated at each level as a +! blend of ice falling from the grid point above and the precip ice +! present at the start of the time step (see TOT_ICE below). +!--- If BLEND=0: +! precipitation (large) ice amounts are estimated to be the precip +! ice present at the start of the time step. +! +!--- Extended to include sedimentation of rain on 2/5/01 +! + REAL, PARAMETER :: BLEND=1. +! +!--- This variable is for debugging purposes (if .true.) +! + LOGICAL, PARAMETER :: PRINT_diag=.false. +! +!----------------------------------------------------------------------- +!--- Local variables +!----------------------------------------------------------------------- +! + REAL :: EMAIRI, N0r, NLICE, NSmICE, NInuclei, Nrain, Nsnow, Nmix + REAL :: RHgrd + LOGICAL :: CLEAR, ICE_logical, DBG_logical, RAIN_logical, & + STRAT, DRZL + INTEGER :: INDEX_MY,INDEXR,INDEXR1,INDEXR2,INDEXS,IPASS,ITDX,IXRF,& + & IXS,LBEF,L,INDEXRmin,INDEXS0C,IDR !mar03 !may20 +! +! + REAL :: ABI,ABW,AIEVP,ARAINnew,ASNOWnew,BLDTRH,BUDGET, & + & CREVP,DELI,DELR,DELT,DELV,DELW,DENOMF, & + & DENOMI,DENOMW,DENOMWI,DIDEP, & + & DIEVP,DIFFUS,DLI,DTRHO,DUM,DUM1,DUM2,DUM3, & + & DWV0,DWVI,DWVR,DYNVIS,ESI,ESW,FIR,FLIMASS, & + & FWR,FWS,GAMMAR,GAMMAS, & + & PCOND,PIACR,PIACW,PIACWI,PIACWR,PICND,PIDEP,PIDEP_max, & + & PIEVP,PILOSS,PIMLT,PINIT,PP,PRACW,PRAUT,PREVP,PRLOSS, & + & QI,QInew,QLICE,QR,QRnew,QSI,QSIgrd,QSInew,QSW,QSW0, & + & QSWgrd,QSWnew,QT,QTICE,QTnew,QTRAIN,Q,QW,QWnew,Rcw, & + & RFACTOR,RFmx,RFrime,RHO,RIMEF,RIMEF1,RQR,RR,RRHO,SFACTOR, & + & TC,TCC,TFACTOR,THERM_COND,THICK,TK,TK2,TNEW, & + & TOT_ICE,TOT_ICEnew,TOT_RAIN,TOT_RAINnew, & + & VEL_INC,VENTR,VENTIL,VENTIS,VRAIN1,VRAIN2,VRIMEF,VSNOW, & + & VSNOW1,WC,WCnew,WSgrd,WS,WSnew,WV,WVnew, & + & XLI,XLIMASS,XRF, & + & NSImax,QRdum,QSmICE,QLgIce,RQLICE,VCI,TIMLT, & + & RQSnew,RQRnew,Zrain,Zsnow,Ztot,RHOX0C,RFnew,PSDEP,DELS !mar03 !apr22 + REAL, SAVE :: Revised_LICE=1.e-3 !-- kg/m**3 +! +!####################################################################### +!########################## Begin Execution ############################ +!####################################################################### +! +! + ARAIN=0. ! Accumulated rainfall into grid box from above (kg/m**2) + VRAIN1=0. ! Rain fall speeds into grib box from above (m/s) + VSNOW1=0. ! Ice fall speeds into grib box from above (m/s) + ASNOW=0. ! Accumulated snowfall into grid box from above (kg/m**2) + INDEXS0C=MDImin ! Mean snow/graupel diameter just above (<0C) freezing level (height) + RHOX0C=22.5 ! Estimated ice density at 0C (kg m^-3) !mar03 + TIMLT=0. ! Total ice melting in a layer (drizzle detection) + STRAT=.FALSE. ! Stratiform rain DSD below melting level !may11 + DRZL=.FALSE. ! Drizzle DSD below melting level !may23 +! +!----------------------------------------------------------------------- +!------------ Loop from top (L=1) to surface (L=LSFC) ------------------ +!----------------------------------------------------------------------- +! +big_loop: DO L=LM,1,-1 + pcond1d(L)=0. + pidep1d(L)=0. + piacw1d(L)=0. + piacwi1d(L)=0. + piacwr1d(L)=0. + piacr1d(L)=0. + picnd1d(L)=0. + pievp1d(L)=0. + pimlt1d(L)=0. + praut1d(L)=0. + pracw1d(L)=0. + prevp1d(L)=0. + pisub1d(L)=0. + pevap1d(L)=0. + vsnow1d(L)=0. + vrain11d(L)=0. + vrain21d(L)=0. + vci1d(L)=0. + NSmICE1d(L)=0. + DBZ_col(L)=DBZmin + NR_col(L)=0. + NS_col(L)=0. + INDEXR1d(L)=0. + INDEXS1d(L)=0. + RFlag1d(L)=0. !jun01 +! +!--- Skip this level and go to the next lower level if no condensate +! and very low specific humidities +! +!--- Check if any rain is falling into layer from above +! + IF (ARAIN .GT. CLIMIT) THEN + CLEAR=.FALSE. + VRAIN1=0. + ELSE + CLEAR=.TRUE. + ARAIN=0. + ENDIF +! +!--- Check if any ice is falling into layer from above +! +!--- NOTE that "SNOW" in variable names is often synonomous with +! large, precipitation ice particles +! + IF (ASNOW .GT. CLIMIT) THEN + CLEAR=.FALSE. + VSNOW1=0. + ELSE + ASNOW=0. + ENDIF +! +!----------------------------------------------------------------------- +!------------ Proceed with cloud microphysics calculations ------------- +!----------------------------------------------------------------------- +! + TK=T_col(L) ! Temperature (deg K) + TC=TK-T0C ! Temperature (deg C) + PP=P_col(L) ! Pressure (Pa) + Q=Q_col(L) ! Specific humidity of water vapor (kg/kg) + WV=Q/(1.-Q) ! Water vapor mixing ratio (kg/kg) + WC=WC_col(L) ! Grid-scale mixing ratio of total condensate (water or ice; kg/kg) + RHgrd=RHC_col(L) ! Threshold relative humidity for the onset of condensation +! +!----------------------------------------------------------------------- +!--- Moisture variables below are mixing ratios & not specifc humidities +!----------------------------------------------------------------------- +! +!--- This check is to determine grid-scale saturation when no condensate is present +! + ESW=MIN(1000.*FPVS0(TK),0.99*PP) ! Saturation vapor pressure w/r/t water + QSW=EPS*ESW/(PP-ESW) ! Saturation mixing ratio w/r/t water + WS=QSW ! General saturation mixing ratio (water/ice) + QSI=QSW ! Saturation mixing ratio w/r/t ice + IF (TC .LT. 0.) THEN + ESI=MIN(1000.*FPVS(TK),0.99*PP) ! Saturation vapor pressure w/r/t ice + QSI=EPS*ESI/(PP-ESI) ! Saturation mixing ratio w/r/t water + WS=QSI ! General saturation mixing ratio (water/ice) + ENDIF +! +!--- Effective grid-scale Saturation mixing ratios +! + QSWgrd=RHgrd*QSW + QSIgrd=RHgrd*QSI + WSgrd=RHgrd*WS +! +!--- Check if air is subsaturated and w/o condensate +! + IF (WV.GT.WSgrd .OR. WC.GT.EPSQ) CLEAR=.FALSE. +! +!----------------------------------------------------------------------- +!-- Loop to the end if in clear, subsaturated air free of condensate --- +!----------------------------------------------------------------------- +! + IF (CLEAR) THEN + STRAT=.FALSE. !- Reset stratiform rain flag + DRZL=.FALSE. !- Reset drizzle flag + INDEXRmin=MDRmin !- Reset INDEXRmin + TIMLT=0. !- Reset accumulated ice melting + CYCLE big_loop + ENDIF +! +!----------------------------------------------------------------------- +!--------- Initialize RHO, THICK & microphysical processes ------------- +!----------------------------------------------------------------------- +! +! +!--- Virtual temperature, TV=T*(1./EPS-1)*Q, Q is specific humidity; +! (see pp. 63-65 in Fleagle & Businger, 1963) +! + RHO=PP/(RD*TK*(1.+EPS1*Q)) ! Air density (kg/m**3) + RRHO=1./RHO ! Reciprocal of air density + DTRHO=DTPH*RHO ! Time step * air density + BLDTRH=BLEND*DTRHO ! Blend parameter * time step * air density + THICK=THICK_col(L) ! Layer thickness = RHO*DZ = -DP/G = (Psfc-Ptop)*D_ETA/(G*ETA_sfc) +! + ARAINnew=0. ! Updated accumulated rainfall + ASNOWnew=0. ! Updated accumulated snowfall + QI=QI_col(L) ! Ice mixing ratio + QInew=0. ! Updated ice mixing ratio + QR=QR_col(L) ! Rain mixing ratio + QRnew=0. ! Updated rain ratio + QW=QW_col(L) ! Cloud water mixing ratio + QWnew=0. ! Updated cloud water ratio +! + PCOND=0. ! Condensation (>0) or evaporation (<0) of cloud water (kg/kg) + PIDEP=0. ! Deposition (>0) or sublimation (<0) of ice crystals (kg/kg) + PINIT=0. ! Ice initiation (part of PIDEP calculation, kg/kg) + PIACW=0. ! Cloud water collection (riming) by precipitation ice (kg/kg; >0) + PIACWI=0. ! Growth of precip ice by riming (kg/kg; >0) + PIACWR=0. ! Shedding of accreted cloud water to form rain (kg/kg; >0) + PIACR=0. ! Freezing of rain onto large ice at supercooled temps (kg/kg; >0) + PICND=0. ! Condensation (>0) onto wet, melting ice (kg/kg) + PIEVP=0. ! Evaporation (<0) from wet, melting ice (kg/kg) + PIMLT=0. ! Melting ice (kg/kg; >0) + PRAUT=0. ! Cloud water autoconversion to rain (kg/kg; >0) + PRACW=0. ! Cloud water collection (accretion) by rain (kg/kg; >0) + PREVP=0. ! Rain evaporation (kg/kg; <0) + NSmICE=0. ! Cloud ice number concentration (m^-3) + Nrain=0. ! Rain number concentration (m^-3) !jul28 begin + Nsnow=0. ! "Snow" number concentration (m^-3) + RQRnew=0. ! Final rain content (kg/m**3) + RQSnew=0. ! Final "snow" content (kg/m**3) + Zrain=0. ! Radar reflectivity from rain (mm**6 m-3) + Zsnow=0. ! Radar reflectivity from snow (mm**6 m-3) + Ztot=0. ! Radar reflectivity from rain+snow (mm**6 m-3) + INDEXR=MDRmin ! Mean diameter of rain (microns) + INDEXR1=INDEXR ! 1st updated mean diameter of rain (microns) + INDEXR2=INDEXR ! 2nd updated mean diameter of rain (microns) + N0r=0. ! 1st estimate for rain intercept (m^-4) + DUM1=MIN(0.,TC) + DUM=XMImax*EXP(XMIexp*DUM1) + INDEXS=MIN(MDImax, MAX(MDImin, INT(DUM) ) ) ! 1st estimate for mean diameter of snow (microns) + VCI=0. ! Cloud ice fall speeds (m/s) + VSNOW=0. ! "Snow" (snow/graupel/sleet/hail) fall speeds (m/s) + VRAIN2=0. ! Rain fall speeds out of bottom of grid box (m/s) + RimeF1=1. ! Rime Factor (ratio, >=1, defined below) +! +!--- Double check input hydrometeor mixing ratios +! +! DUM=WC-(QI+QW+QR) +! DUM1=ABS(DUM) +! DUM2=TOLER*MIN(WC, QI+QW+QR) +! IF (DUM1 .GT. DUM2) THEN +! WRITE(0,"(/2(a,i4),a,i2)") '{@ i=',I_index,' j=',J_index, +! & ' L=',L +! WRITE(0,"(4(a12,g11.4,1x))") +! & '{@ TCold=',TC,'P=',.01*PP,'DIFF=',DUM,'WCold=',WC, +! & '{@ QIold=',QI,'QWold=',QW,'QRold=',QR +! ENDIF +! +!*********************************************************************** +!*********** MAIN MICROPHYSICS CALCULATIONS NOW FOLLOW! **************** +!*********************************************************************** +! +!--- Calculate a few variables, which are used more than once below +! +!--- Latent heat of vaporization as a function of temperature from +! Bolton (1980, JAS) +! + TK2=1./(TK*TK) ! 1./TK**2 +! +!--- Basic thermodynamic quantities +! * DYNVIS - dynamic viscosity [ kg/(m*s) ] +! * THERM_COND - thermal conductivity [ J/(m*s*K) ] +! * DIFFUS - diffusivity of water vapor [ m**2/s ] +! + TFACTOR=SQRT(TK*TK*TK)/(TK+120.) + DYNVIS=1.496E-6*TFACTOR + THERM_COND=2.116E-3*TFACTOR + DIFFUS=8.794E-5*TK**1.81/PP +! +!--- Air resistance term for the fall speed of ice following the +! basic research by Heymsfield, Kajikawa, others +! + GAMMAS=MIN(1.5, (1.E5/PP)**C1) !-- limited to 1.5x +! +!--- Air resistance for rain fall speed (Beard, 1985, JAS, p.470) +! + GAMMAR=(RHO0/RHO)**.4 +! +!---------------------------------------------------------------------- +!------------- IMPORTANT MICROPHYSICS DECISION TREE ----------------- +!---------------------------------------------------------------------- +! +!--- Determine if conditions supporting ice are present +! + IF (TC.LT.0. .OR. QI.GT. EPSQ .OR. ASNOW.GT.CLIMIT) THEN + ICE_logical=.TRUE. + ELSE + ICE_logical=.FALSE. + QLICE=0. + QTICE=0. + ENDIF + IF (T_ICE <= -100.) THEN + ICE_logical=.FALSE. + QLICE=0. + QTICE=0. + ENDIF +! +!--- Determine if rain is present +! + RAIN_logical=.FALSE. + IF (ARAIN.GT.CLIMIT .OR. QR.GT.EPSQ) RAIN_logical=.TRUE. +! +ice_test: IF (ICE_logical) THEN +! +!--- IMPORTANT: Estimate time-averaged properties. +! +!--- +! -> Small ice particles are assumed to have a mean diameter of 50 microns. +! * QSmICE - estimated mixing ratio for small cloud ice +!--- +! * TOT_ICE - total mass (small & large) ice before microphysics, +! which is the sum of the total mass of large ice in the +! current layer and the input flux of ice from above +! * PILOSS - greatest loss (<0) of total (small & large) ice by +! sublimation, removing all of the ice falling from above +! and the ice within the layer +! * RimeF1 - Rime Factor, which is the mass ratio of total (unrimed & rimed) +! ice mass to the unrimed ice mass (>=1) +! * VrimeF - the velocity increase due to rime factor or melting (ratio, >=1) +! * VSNOW - Fall speed of rimed snow w/ air resistance correction +! * VCI - Fall speed of 50-micron ice crystals w/ air resistance correction +! * EMAIRI - equivalent mass of air associated layer and with fall of snow into layer +! * XLIMASS - used for debugging, associated with calculating large ice mixing ratio +! * FLIMASS - mass fraction of large ice +! * QTICE - time-averaged mixing ratio of total ice +! * QLICE - time-averaged mixing ratio of large ice +! * NLICE - time-averaged number concentration of large ice +! * NSmICE - number concentration of small ice crystals at current level +! * QSmICE - mixing ratio of small ice crystals at current level +!--- +!--- Assumed number fraction of large ice particles to total (large & small) +! ice particles, which is based on a general impression of the literature. +! + NInuclei=0. + NSmICE=0. + QSmICE=0. + Rcw=0. + IF (TC<0.) THEN +! +!--- Max # conc of small ice crystals based on 10% of total ice content +! or the parameter NSI_max +! + NSImax=MAX(NSI_max, 0.1*RHO*QI/MASSI(MDImin) ) !aug27 +! +!-- Specify Fletcher, Cooper, Meyers, etc. here for ice nuclei concentrations +! Cooper (1986): NInuclei=MIN(5.*EXP(-0.304*TC), NSImax) +! Fletcher (1962): NInuclei=MIN(0.01*EXP(-0.6*TC), NSImax) +! +!aug28: The formulas below mean that Fletcher is used for >-21C and Cooper at colder +! temperatures. In areas of high ice contents near the tops of deep convection, +! the number concentrations will be determined by the lower value of the "FQi" +! contribution to NSImax or Cooper. +! + NInuclei=MIN(0.01*EXP(-0.6*TC), NSImax) !aug28 - Fletcher (1962) + NInuclei=MIN(5.*EXP(-0.304*TC), NInuclei) !aug28 - Cooper (1984) + IF (QI>EPSQ) THEN + DUM=RRHO*MASSI(MDImin) + NSmICE=MIN(NInuclei, QI/DUM) + QSmICE=NSmICE*DUM + ENDIF ! End IF (QI>EPSQ) + ENDIF ! End IF (TC<0.) + init_ice: IF (QI<=EPSQ .AND. ASNOW<=CLIMIT) THEN + TOT_ICE=0. + PILOSS=0. + RimeF1=1. + VrimeF=1. + VEL_INC=GAMMAS + VSNOW=0. + VSNOW1=0. + VCI=0. + EMAIRI=THICK + XLIMASS=RimeF1*MASSI(INDEXS) + FLIMASS=1. + QLICE=0. + RQLICE=0. + QTICE=0. + NLICE=0. + ELSE init_ice + ! + !--- For T<0C mean particle size follows Houze et al. (JAS, 1979, p. 160), + ! converted from Fig. 5 plot of LAMDAs. Similar set of relationships + ! also shown in Fig. 8 of Ryan (BAMS, 1996, p. 66). + ! +! +!sep10 - Start of changes described in (23) at top of code. +! + TOT_ICE=THICK*QI+BLEND*ASNOW + PILOSS=-TOT_ICE/THICK + QLgICE=MAX(0., QI-QSmICE) !-- 1st-guess estimate of large ice + VCI=GAMMAS*VSNOWI(MDImin) +! +!-- Need to save this original value before two_pass iteration +! + LBEF=MAX(1,L-1) + RimeF1=(RimeF_col(L)*THICK*QLgICE & + & +RimeF_col(LBEF)*BLEND*ASNOW)/TOT_ICE +! +!mar08 see (32); !apr22a see (41) start - Estimate mean diameter (INDEXS in microns) + IF (RimeF1>2.) THEN + DUM3=RH_NgC*(RHO*QLgICE)**C1 !- convective mean diameter + DUM2=RH_NgT*(RHO*QLgICE)**C1 !- transition mean diameter + IF (RimeF1>=10.) THEN + DUM=DUM3 + ELSE IF (RimeF1>=5.) THEN + DUM=0.2*(RimeF1-5.) !- Blend at 5<=RF<10 + DUM=DUM3*DUM+DUM2*(1.-DUM) + ELSE + DUM1=REAL(INDEXS) !- stratiform mean diameter + DUM=0.33333*(RimeF1-2.) !- Blend at 2=5. .AND. INDEXS==MDImax .AND. RQLICE>RQhail) THEN +!- Additional increase using Thompson graupel/hail fall speeds + DUM=GAMMAS*AVhail*RQLICE**BVhail + IF (DUM>VSNOW) THEN + VSNOW=DUM + VEL_INC=VSNOW/VSNOWI(INDEXS) + ENDIF + ENDIF + XLIMASS=RimeF1*MASSI(INDEXS) + NLICE=RQLICE/XLIMASS +! +!sep16 - End of change described in (26) at top of code. +! +!=========================================== + IF (IPASS>=2 .OR. & + (NLICE>=NLImin .AND. NLICE<=NSI_max)) EXIT two_pass +!may17 - end +!=========================================== +! +!--- Force NLICE to be between NLImin and NSI_max when IPASS=1 +! +! IF (PRINT_diag .AND. RQLICE>Revised_LICE) DUM2=NLICE !-- For debugging (see DUM2 below) + NLICE=MAX(NLImin, MIN(NSI_max, NLICE) ) +!sep16 - End of changes +! + XLI=RQLICE/(NLICE*RimeF1) !- Mean mass of unrimed ice +new_size: IF (XLI<=MASSI(MDImin) ) THEN + INDEXS=MDImin + ELSE IF (XLI<=MASSI(450) ) THEN new_size + DLI=9.5885E5*XLI**.42066 ! DLI in microns + INDEXS=MIN(MDImax, MAX(MDImin, INT(DLI) ) ) + ELSE IF (XLIRevised_LICE) THEN +! WRITE(0,"(5(a12,g11.4,1x))") '{$ RimeF1=',RimeF1, & +! & ' RHO*QLICE=',RQLICE,' TC=',TC,' NLICE=',NLICE, & +! & ' NLICEold=',DUM2 +! Revised_LICE=1.2*RQLICE +! ENDIF + ENDIF new_size +!=========================================== + ENDDO two_pass +!=========================================== + ENDIF init_ice + ENDIF ice_test +! +!mar03 !may11 !jun01 - start; see (34) above + IF(TC<=0.) THEN + STRAT=.FALSE. + INDEXRmin=MDRmin + TIMLT=0. + INDEXS0C=INDEXS + RHOX0C=22.5*MAX(1.,MIN(RimeF1,40.)) !- Estimated ice density at 0C (kg m^-3) + ELSE ! TC>0. + IF(.NOT.RAIN_logical) THEN + STRAT=.FALSE. !- Reset STRAT + INDEXRmin=MDRmin !- Reset INDEXRmin + IF(.NOT.ICE_logical) TIMLT=0. + ELSE +!- STRAT=T for stratiform rain + IF(TIMLT>EPSQ .AND. RHOX0C<=225.) THEN + STRAT=.TRUE. + ELSE + STRAT=.FALSE. !- Reset STRAT + INDEXRmin=MDRmin !- Reset INDEXRmin + ENDIF + IF(STRAT .AND. INDEXRmin<=MDRmin) THEN + INDEXRmin=INDEXS0C*(0.001*RHOX0C)**C1 + INDEXRmin=MAX(MDRmin, MIN(INDEXRmin, INDEXRstrmax) ) + ENDIF + ENDIF + ENDIF +! + IF(STRAT .OR. TIMLT>EPSQ) THEN + DRZL=.FALSE. + ELSE +!- DRZL=T for drizzle (no melted ice falling from above) + DRZL=.TRUE. !mar30 + ENDIF +!jun01 - end +! +!---------------------------------------------------------------------- +!--------------- Calculate individual processes ----------------------- +!---------------------------------------------------------------------- +! +!--- Cloud water autoconversion to rain (PRAUT) and collection of cloud +! water by precipitation ice (PIACW) +! + IF (QW.GT.EPSQ .AND. TC.GE.T_ICE) THEN +!-- The old autoconversion threshold returns + DUM2=RHO*QW + IF (DUM2>QAUT0) THEN +!-- July 2010 version follows Liu & Daum (JAS, 2004) and Liu et al. (JAS, 2006) + DUM2=DUM2*DUM2 + DUM=BRAUT*DUM2*QW + DUM1=ARAUT*DUM2 + PRAUT=MIN(QW, DUM*(1.-EXP(-DUM1*DUM1)) ) + ENDIF + IF (QLICE .GT. EPSQ) THEN + ! + !--- Collection of cloud water by large ice particles ("snow") + ! PIACWI=PIACW for riming, PIACWI=0 for shedding + ! + FWS=MIN(1., CIACW*VEL_INC*NLICE*ACCRI(INDEXS) ) !jul28 (16) + PIACW=FWS*QW + IF (TC<0.) THEN + PIACWI=PIACW !- Large ice riming + Rcw=ARcw*DUM2**C1 !- Cloud droplet radius in microns + ENDIF + ENDIF ! End IF (QLICE .GT. EPSQ) + ENDIF ! End IF (QW.GT.EPSQ .AND. TC.GE.T_ICE) +! +!---------------------------------------------------------------------- +!--- Calculate homogeneous freezing of cloud water (PIACW, PIACWI) and +! ice deposition (PIDEP), which also includes ice initiation (PINIT) +! +ice_only: IF (TC.LT.T_ICE .AND. (WV.GT.QSWgrd .OR. QW.GT.EPSQ)) THEN + ! + !--- Adjust to ice saturation at T More extensive units conversion than can be described here to go from +! eq. (13) in Liu et al. (JAS, 2006) to what's programmed below. Note that +! the units used throughout the paper are in cgs units! +! + ARAUT=1.03e19/(NCW*SQRT(NCW)) + BRAUT=DTPH*1.1E10*BETA6/NCW +! +!--- QAUT0 is the *OLD* threshold cloud content for autoconversion to rain +! needed for droplets to reach a diameter of 20 microns (following +! Manton and Cotton, 1977; Banta and Hanson, 1987, JCAM). It's no longer +! used in this version, but the value is passed into radiation in case +! a ball park estimate is needed. +!--- QAUT0=1.2567, 0.8378, or 0.4189 g/m**3 for droplet number concentrations +! of 300, 200, and 100 cm**-3, respectively +! + QAUT0=PI*RHOL*NCW*(20.E-6)**3/6. !-- legacy +! +!--- For calculating cloud droplet radius in microns, Rcw +! + ARcw=1.E6*(0.75/(PI*NCW*RHOL))**C1 +! +!may20 - start +! +!- An explanation for the following settings assumed for "hail" or frozen drops (RF>10): +! RH_NgC=PI*500.*5.E3 +! RHOg=500 kg m^-3, Ng=5.e3 m^-3 => "hail" content >7.85 g m^-3 for INDEXS=MDImax +!- or - +! RH_NgC=PI*500.*1.E3 +! RHOg=500 kg m^-3, Ng=1.e3 m^-3 => "hail" content >1.57 g m^-3 for INDEXS=MDImax +! + RH_NgC=PI*500.*1.E3 !- RHOg=500 kg m^-3, Ng=1.e3 m^-3 + RQhail=RH_NgC*(1.E-3)**3 !- Threshold "hail" content ! becomes 1.57 g m^-3 + Bvhail=0.82*C1 !- Exponent for Thompson graupel + Avhail=1353.*(1./RH_NgC)**Bvhail !- 1353 ~ constant for Thompson graupel + RH_NgC=1.E6*(1./RH_NgC)**C1 !mar08 (convection, convert to microns) +! +!- An explanation for the following settings assumed for graupel (RF>5): +! RH_NgT=PI*300.*10.E3 +! RHOg=300 kg m^-3, Ng=10.e3 m^-3 => "graupel" content must exceed 9.43 g m^-3 for INDEXS=MDImax +!- or - +! RH_NgT=PI*300.*5.E3 +! RHOg=300 kg m^-3, Ng=5.e3 m^-3 => "graupel" content must exceed 4.71 g m^-3 for INDEXS=MDImax +! + RH_NgT=PI*300.*5.E3 !- RHOg=300 kg m^-3, Ng=5.e3 m^-3 + RH_NgT=1.E6*(1./RH_NgT)**C1 !mar08 (transition, convert to microns) +!may20 - end +! +!--- For calculating snow optical depths by considering bulk density of +! snow based on emails from Q. Fu (6/27-28/01), where optical +! depth (T) = 1.5*SWP/(Reff*DENS), SWP is snow water path, Reff +! is effective radius, and DENS is the bulk density of snow. +! +! SWP (kg/m**2)=(1.E-3 kg/g)*SWPrad, SWPrad in g/m**2 used in radiation +! T = 1.5*1.E3*SWPrad/(Reff*DENS) +! +! See derivation for MASSI(INDEXS), note equal to RHO*QSNOW/NSNOW +! +! SDENS=1.5e3/DENS, DENS=MASSI(INDEXS)/[PI*(1.E-6*INDEXS)**3] +! + DO I=MDImin,MDImax + SDENS(I)=PI*1.5E-15*FLOAT(I*I*I)/MASSI(I) + ENDDO +! + Thour_print=-DTPH/3600. +! + + RETURN +! +!----------------------------------------------------------------------- +! +9061 CONTINUE + WRITE(0,*)' module_mp_etanew: error opening ETAMPNEW_DATA.expanded_rain on unit ',etampnew_unit1 + STOP +! +!----------------------------------------------------------------------- + END SUBROUTINE FERRIER_INIT_hr +! +!>\ingroup hafs_famp + SUBROUTINE MY_GROWTH_RATES_NMM_hr (DTPH) +! +!--- Below are tabulated values for the predicted mass of ice crystals +! after 600 s of growth in water saturated conditions, based on +! calculations from Miller and Young (JAS, 1979). These values are +! crudely estimated from tabulated curves at 600 s from Fig. 6.9 of +! Young (1993). Values at temperatures colder than -27C were +! assumed to be invariant with temperature. +! +!--- Used to normalize Miller & Young (1979) calculations of ice growth +! over large time steps using their tabulated values at 600 s. +! Assumes 3D growth with time**1.5 following eq. (6.3) in Young (1993). +! + IMPLICIT NONE +! + REAL,INTENT(IN) :: DTPH +! + REAL DT_ICE + REAL,DIMENSION(35) :: MY_600 +!WRF +! +!----------------------------------------------------------------------- +!-- 20090714: These values are in g and need to be converted to kg below + DATA MY_600 / & + & 5.5e-8, 1.4E-7, 2.8E-7, 6.E-7, 3.3E-6, & + & 2.E-6, 9.E-7, 8.8E-7, 8.2E-7, 9.4e-7, & + & 1.2E-6, 1.85E-6, 5.5E-6, 1.5E-5, 1.7E-5, & + & 1.5E-5, 1.E-5, 3.4E-6, 1.85E-6, 1.35E-6, & + & 1.05E-6, 1.E-6, 9.5E-7, 9.0E-7, 9.5E-7, & + & 9.5E-7, 9.E-7, 9.E-7, 9.E-7, 9.E-7, & + & 9.E-7, 9.E-7, 9.E-7, 9.E-7, 9.E-7 / ! -31 to -35 deg C +! +!----------------------------------------------------------------------- +! + DT_ICE=(DTPH/600.)**1.5 + MY_GROWTH_NMM=DT_ICE*MY_600*1.E-3 !-- 20090714: Convert from g to kg +! +!----------------------------------------------------------------------- +! + END SUBROUTINE MY_GROWTH_RATES_NMM_hr +! +!----------------------------------------------------------------------- +!--------- Old GFS saturation vapor pressure lookup tables ----------- +!----------------------------------------------------------------------- +! +!>\ingroup hafs_famp + SUBROUTINE GPVS_hr +! ****************************************************************** +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! . . . +! SUBPROGRAM: GPVS_hr COMPUTE SATURATION VAPOR PRESSURE TABLE +! AUTHOR: N PHILLIPS W/NP2 DATE: 30 DEC 82 +! +! ABSTRACT: COMPUTE SATURATION VAPOR PRESSURE TABLE AS A FUNCTION OF +! TEMPERATURE FOR THE TABLE LOOKUP FUNCTION FPVS. +! EXACT SATURATION VAPOR PRESSURES ARE CALCULATED IN SUBPROGRAM FPVSX. +! THE CURRENT IMPLEMENTATION COMPUTES A TABLE WITH A LENGTH +! OF 7501 FOR TEMPERATURES RANGING FROM 180.0 TO 330.0 KELVIN. +! +! PROGRAM HISTORY LOG: +! 91-05-07 IREDELL +! 94-12-30 IREDELL EXPAND TABLE +! 96-02-19 HONG ICE EFFECT +! 01-11-29 JIN MODIFIED FOR WRF +! +! USAGE: CALL GPVS_hr +! +! SUBPROGRAMS CALLED: +! (FPVSX) - INLINABLE FUNCTION TO COMPUTE SATURATION VAPOR PRESSURE +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN 90 +! +!$$$ + IMPLICIT NONE + real :: X,XINC,T + integer :: JX +!---------------------------------------------------------------------- + XINC=(XMAX-XMIN)/(NX-1) + C1XPVS=1.-XMIN/XINC + C2XPVS=1./XINC + C1XPVS0=1.-XMIN/XINC + C2XPVS0=1./XINC +! + DO JX=1,NX + X=XMIN+(JX-1)*XINC + T=X + TBPVS(JX)=FPVSX(T) + TBPVS0(JX)=FPVSX0(T) + ENDDO +! + END SUBROUTINE GPVS_hr +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- + REAL FUNCTION FPVS(T) +!----------------------------------------------------------------------- +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! . . . +! SUBPROGRAM: FPVS COMPUTE SATURATION VAPOR PRESSURE +! AUTHOR: N PHILLIPS W/NP2 DATE: 30 DEC 82 +! +! ABSTRACT: COMPUTE SATURATION VAPOR PRESSURE FROM THE TEMPERATURE. +! A LINEAR INTERPOLATION IS DONE BETWEEN VALUES IN A LOOKUP TABLE +! COMPUTED IN GPVS. SEE DOCUMENTATION FOR FPVSX FOR DETAILS. +! INPUT VALUES OUTSIDE TABLE RANGE ARE RESET TO TABLE EXTREMA. +! THE INTERPOLATION ACCURACY IS ALMOST 6 DECIMAL PLACES. +! ON THE CRAY, FPVS IS ABOUT 4 TIMES FASTER THAN EXACT CALCULATION. +! THIS FUNCTION SHOULD BE EXPANDED INLINE IN THE CALLING ROUTINE. +! +! PROGRAM HISTORY LOG: +! 91-05-07 IREDELL MADE INTO INLINABLE FUNCTION +! 94-12-30 IREDELL EXPAND TABLE +! 96-02-19 HONG ICE EFFECT +! 01-11-29 JIN MODIFIED FOR WRF +! +! USAGE: PVS=FPVS(T) +! +! INPUT ARGUMENT LIST: +! T - REAL TEMPERATURE IN KELVIN +! +! OUTPUT ARGUMENT LIST: +! FPVS - REAL SATURATION VAPOR PRESSURE IN KILOPASCALS (CB) +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN 90 +!$$$ + IMPLICIT NONE + real,INTENT(IN) :: T + real XJ + integer :: JX +!----------------------------------------------------------------------- + IF (T>=XMIN .AND. T<=XMAX) THEN + XJ=MIN(MAX(C1XPVS+C2XPVS*T,1.),FLOAT(NX)) + JX=MIN(XJ,NX-1.) + FPVS=TBPVS(JX)+(XJ-JX)*(TBPVS(JX+1)-TBPVS(JX)) + ELSE IF (T>XMAX) THEN +!-- Magnus Tetens formula for water saturation (Murray, 1967) +! (saturation vapor pressure in kPa) + FPVS=0.61078*exp(17.2694*(T-273.16)/(T-35.86)) + ELSE +!-- Magnus Tetens formula for ice saturation(Murray, 1967) +! (saturation vapor pressure in kPa) + FPVS=0.61078*exp(21.8746*(T-273.16)/(T-7.66)) + ENDIF +! + END FUNCTION FPVS +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + REAL FUNCTION FPVS0(T) +!----------------------------------------------------------------------- + IMPLICIT NONE + real,INTENT(IN) :: T + real :: XJ1 + integer :: JX1 +!----------------------------------------------------------------------- + IF (T>=XMIN .AND. T<=XMAX) THEN + XJ1=MIN(MAX(C1XPVS0+C2XPVS0*T,1.),FLOAT(NX)) + JX1=MIN(XJ1,NX-1.) + FPVS0=TBPVS0(JX1)+(XJ1-JX1)*(TBPVS0(JX1+1)-TBPVS0(JX1)) + ELSE +!-- Magnus Tetens formula for water saturation (Murray, 1967) +! (saturation vapor pressure in kPa) + FPVS0=0.61078*exp(17.2694*(T-273.16)/(T-35.86)) + ENDIF +! + END FUNCTION FPVS0 +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- + REAL FUNCTION FPVSX(T) +!----------------------------------------------------------------------- +!$$$ SUBPROGRAM DOCUMENTATION BLOCK +! . . . +! SUBPROGRAM: FPVSX COMPUTE SATURATION VAPOR PRESSURE +! AUTHOR: N PHILLIPS W/NP2 DATE: 30 DEC 82 +! +! ABSTRACT: EXACTLY COMPUTE SATURATION VAPOR PRESSURE FROM TEMPERATURE. +! THE WATER MODEL ASSUMES A PERFECT GAS, CONSTANT SPECIFIC HEATS +! FOR GAS AND LIQUID, AND NEGLECTS THE VOLUME OF THE LIQUID. +! THE MODEL DOES ACCOUNT FOR THE VARIATION OF THE LATENT HEAT +! OF CONDENSATION WITH TEMPERATURE. THE ICE OPTION IS NOT INCLUDED. +! THE CLAUSIUS-CLAPEYRON EQUATION IS INTEGRATED FROM THE TRIPLE POINT +! TO GET THE FORMULA +! PVS=PSATK*(TR**XA)*EXP(XB*(1.-TR)) +! WHERE TR IS TTP/T AND OTHER VALUES ARE PHYSICAL CONSTANTS +! THIS FUNCTION SHOULD BE EXPANDED INLINE IN THE CALLING ROUTINE. +! +! PROGRAM HISTORY LOG: +! 91-05-07 IREDELL MADE INTO INLINABLE FUNCTION +! 94-12-30 IREDELL EXACT COMPUTATION +! 96-02-19 HONG ICE EFFECT +! 01-11-29 JIN MODIFIED FOR WRF +! +! USAGE: PVS=FPVSX(T) +! REFERENCE: EMANUEL(1994),116-117 +! +! INPUT ARGUMENT LIST: +! T - REAL TEMPERATURE IN KELVIN +! +! OUTPUT ARGUMENT LIST: +! FPVSX - REAL SATURATION VAPOR PRESSURE IN KILOPASCALS (CB) +! +! ATTRIBUTES: +! LANGUAGE: FORTRAN 90 +!$$$ + IMPLICIT NONE +!----------------------------------------------------------------------- + real, parameter :: TTP=2.7316E+2,HVAP=2.5000E+6,PSAT=6.1078E+2 & + , CLIQ=4.1855E+3,CVAP= 1.8460E+3 & + , CICE=2.1060E+3,HSUB=2.8340E+6 +! + real, parameter :: PSATK=PSAT*1.E-3 + real, parameter :: DLDT=CVAP-CLIQ,XA=-DLDT/RV,XB=XA+HVAP/(RV*TTP) + real, parameter :: DLDTI=CVAP-CICE & + , XAI=-DLDTI/RV,XBI=XAI+HSUB/(RV*TTP) + real T,TR +!----------------------------------------------------------------------- + TR=TTP/T +! + IF(T.GE.TTP)THEN + FPVSX=PSATK*(TR**XA)*EXP(XB*(1.-TR)) + ELSE + FPVSX=PSATK*(TR**XAI)*EXP(XBI*(1.-TR)) + ENDIF +! + END FUNCTION FPVSX +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- + REAL FUNCTION FPVSX0(T) +!----------------------------------------------------------------------- + IMPLICIT NONE + real,parameter :: TTP=2.7316E+2,HVAP=2.5000E+6,PSAT=6.1078E+2 & + , CLIQ=4.1855E+3,CVAP=1.8460E+3 & + , CICE=2.1060E+3,HSUB=2.8340E+6 + real,PARAMETER :: PSATK=PSAT*1.E-3 + real,PARAMETER :: DLDT=CVAP-CLIQ,XA=-DLDT/RV,XB=XA+HVAP/(RV*TTP) + real,PARAMETER :: DLDTI=CVAP-CICE & + , XAI=-DLDT/RV,XBI=XA+HSUB/(RV*TTP) + real :: T,TR +!----------------------------------------------------------------------- + TR=TTP/T + FPVSX0=PSATK*(TR**XA)*EXP(XB*(1.-TR)) +! + END FUNCTION FPVSX0 + +! + END MODULE module_mp_fer_hires diff --git a/physics/mp_fer_hires.F90 b/physics/mp_fer_hires.F90 new file mode 100644 index 000000000..9f265db22 --- /dev/null +++ b/physics/mp_fer_hires.F90 @@ -0,0 +1,401 @@ +!>\file mp_fer_hires.F90 +!! This file contains + +! +module mp_fer_hires + + use machine, only : kind_phys + + use module_mp_fer_hires, only : ferrier_init_hr, FER_HIRES + + implicit none + + public :: mp_fer_hires_init, mp_fer_hires_run, mp_fer_hires_finalize + + private + + logical :: is_initialized = .False. + + ! * T_ICE - temperature (C) threshold at which all remaining liquid water + ! is glaciated to ice + ! * T_ICE_init - maximum temperature (C) at which ice nucleation occurs + REAL, PUBLIC, PARAMETER :: T_ICE=-40., & + T0C=273.15, & + T_ICEK=T0C+T_ICE + + contains + +!> This subroutine initialize constants & lookup tables for Ferrier-Aligao MP +!! scheme. +!> \section arg_table_mp_fer_hires_init Argument Table +!! \htmlinclude mp_fer_hires_init.html +!! + subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & + imp_physics_fer_hires, & + restart, & + f_ice,f_rain,f_rimef, & + mpicomm, mpirank,mpiroot, & + threads, errmsg, errflg) + + USE machine, ONLY : kind_phys + USE MODULE_MP_FER_HIRES, ONLY : FERRIER_INIT_HR + implicit none + + integer, intent(in) :: ncol + integer, intent(in) :: nlev + real(kind_phys), intent(in) :: dtp + integer, intent(in) :: imp_physics + integer, intent(in) :: imp_physics_fer_hires + integer, intent(in) :: mpicomm + integer, intent(in) :: mpirank + integer, intent(in) :: mpiroot + integer, intent(in) :: threads + logical, intent(in) :: restart + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + real(kind_phys), intent(out), optional :: f_ice(1:ncol,1:nlev) + real(kind_phys), intent(out), optional :: f_rain(1:ncol,1:nlev) + real(kind_phys), intent(out), optional :: f_rimef(1:ncol,1:nlev) + + + ! Local variables + integer :: ims, ime, lm,i,k + !real(kind=kind_phys) :: DT_MICRO + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + ! Set internal dimensions + ims = 1 + ime = ncol + lm = nlev + + ! MZ* temporary + if (mpirank==mpiroot) then + write(0,*) ' -----------------------------------------------' + write(0,*) ' --- !!! WARNING !!! ---' + write(0,*) ' --- the CCPP Ferrier-Aligo MP scheme is ---' + write(0,*) ' --- currently under development, use at ---' + write(0,*) ' --- your own risk . ---' + write(0,*) ' -----------------------------------------------' + end if + ! MZ* temporary + + if (imp_physics /= imp_physics_fer_hires ) then + write(errmsg,'(*(a))') "Logic error: namelist choice of microphysics is different from Ferrier-Aligo MP" + errflg = 1 + return + end if + + !MZ: fer_hires_init() in HWRF + IF(.NOT.RESTART .AND. present(F_ICE)) THEN !HWRF + write(errmsg,'(*(a))') " WARNING: F_ICE,F_RAIN AND F_RIMEF IS REINITIALIZED " + DO K = 1,lm + DO I= ims,ime + F_ICE(i,k)=0. + F_RAIN(i,k)=0. + F_RIMEF(i,k)=1. + ENDDO + ENDDO + ENDIF + !MZ: fer_hires_init() in HWRF + + CALL FERRIER_INIT_HR(dtp,mpicomm,mpirank,mpiroot,threads) + + if (mpirank==mpiroot) write (0,*)'F-A: FERRIER_INIT_HR finished ...' + if (errflg /= 0 ) return + + is_initialized = .true. + + + end subroutine mp_fer_hires_init + +!>\defgroup hafs_famp HAFS Ferrier-Aligo Cloud Microphysics Scheme +!> This is the CCPP-compliant FER_HIRES driver module. +!> \section arg_table_mp_fer_hires_run Argument Table +!! \htmlinclude mp_fer_hires_run.html +!! + SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & + ,SLMSK & + ,PRSI,P_PHY & + ,T,Q,CWM & + ,TRAIN,SR & + ,F_ICE,F_RAIN,F_RIMEF & + ,QC,QR,QI,QG & ! wet mixing ratio + !,qc_m,qi_m,qr_m & + ,PREC &!,ACPREC -MZ:not used + ,mpirank, mpiroot, threads & + ,refl_10cm & + ,RHGRD,dx & + ,EPSQ,R_D,P608,CP,G & + ,errmsg,errflg) + +!----------------------------------------------------------------------- + USE MACHINE, ONLY: kind_phys +! + IMPLICIT NONE +! +!----------------------------------------------------------------------- +! + INTEGER,PARAMETER :: D_SS=1 +! +!------------------------ +!*** Argument Variables +!------------------------ + + integer, intent(in ) :: ncol + integer, intent(in ) :: nlev + real(kind_phys), intent(in ) :: dt + integer, intent(in ) :: threads + logical, intent(in ) :: spec_adv + integer, intent(in ) :: mpirank + integer, intent(in ) :: mpiroot + real(kind_phys), intent(in ) :: slmsk(1:ncol) + real(kind_phys), intent(in ) :: prsi(1:ncol,1:nlev+1) + real(kind_phys), intent(in ) :: p_phy(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: epsq,r_d,p608,cp,g + real(kind_phys), intent(inout) :: t(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: q(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: cwm(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: train(1:ncol,1:nlev) + real(kind_phys), intent(out ) :: sr(1:ncol) + real(kind_phys), intent(inout) :: f_ice(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: f_rain(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: f_rimef(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qc(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qr(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qi(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: qg(1:ncol,1:nlev) ! QRIMEF + + real(kind_phys), intent(inout) :: prec(1:ncol) +! real(kind_phys) :: acprec(1:ncol) !MZ: change to local + real(kind_phys), intent(inout) :: refl_10cm(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: rhgrd + real(kind_phys), intent(in ) :: dx(1:ncol) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +!--------------------- +!*** Local Variables +!--------------------- +! + integer :: I,J,K,N + integer :: lowlyr(1:ncol) + integer :: dx1 + !real(kind_phys) :: mprates(1:ncol,1:nlev,d_ss) + real(kind_phys) :: DTPHS,PCPCOL,RDTPHS,TNEW + real(kind_phys) :: ql(1:nlev),tl(1:nlev) + real(kind_phys) :: rainnc(1:ncol),rainncv(1:ncol) + real(kind_phys) :: snownc(1:ncol),snowncv(1:ncol) + real(kind_phys) :: graupelncv(1:ncol) + real(kind_phys) :: dz(1:ncol,1:nlev) + real(kind_phys) :: pi_phy(1:ncol,1:nlev) + real(kind_phys) :: rr(1:ncol,1:nlev) + real(kind_phys) :: th_phy(1:ncol,1:nlev) + real(kind_phys) :: R_G, CAPPA + +! Dimension + integer :: ims, ime, jms, jme, lm + +!----------------------------------------------------------------------- +!*********************************************************************** +!----------------------------------------------------------------------- + R_G=1./G + CAPPA=R_D/CP + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check initialization state + if (.not. is_initialized) then + write(errmsg, fmt='((a))') 'mp_fer_hires_run called before mp_fer_hires_init' + errflg = 1 + return + end if + + +!ZM NTSD=ITIMESTEP +!ZM presume nphs=1 DTPHS=NPHS*DT + DTPHS=DT + RDTPHS=1./DTPHS +!ZM AVRAIN=AVRAIN+1. + +! Set internal dimensions + ims = 1 + ime = ncol + jms = 1 + jme = 1 + lm = nlev + +! Use the dx of the 1st i point to set an integer value of dx to be used for +! determining where RHgrd should be set to 0.98 in the coarse domain when running HAFS. + DX1=NINT(DX(1)) + +!----------------------------------------------------------------------- +!*** NOTE: THE NMMB HAS IJK STORAGE WITH LAYER 1 AT THE TOP. +!*** THE WRF PHYSICS DRIVERS HAVE IKJ STORAGE WITH LAYER 1 +!*** AT THE BOTTOM. +!----------------------------------------------------------------------- +!....................................................................... + DO I=IMS,IME +! + LOWLYR(I)=1 +! +!----------------------------------------------------------------------- +!*** FILL RAINNC WITH ZERO (NORMALLY CONTAINS THE NONCONVECTIVE +!*** ACCUMULATED RAIN BUT NOT YET USED BY NMM) +!*** COULD BE OBTAINED FROM ACPREC AND CUPREC (ACPREC-CUPREC) +!----------------------------------------------------------------------- +!..The NC variables were designed to hold simulation total accumulations +!.. whereas the NCV variables hold timestep only values, so change below +!.. to zero out only the timestep amount preparing to go into each +!.. micro routine while allowing NC vars to accumulate continually. +!.. But, the fact is, the total accum variables are local, never saved +!.. nor written so they go nowhere at the moment. +! + RAINNC (I)=0. ! NOT YET USED BY NMM + RAINNCv(I)=0. + SNOWNCv(I)=0. + graupelncv(i) = 0.0 +! +!----------------------------------------------------------------------- +!*** FILL THE SINGLE-COLUMN INPUT +!----------------------------------------------------------------------- +! + DO K=LM,1,-1 ! We are moving down from the top in the flipped arrays + +! +! TL(K)=T(I,K) +! QL(K)=AMAX1(Q(I,K),EPSQ) +! + RR(I,K)=P_PHY(I,K)/(R_D*T(I,K)*(P608*AMAX1(Q(I,K),EPSQ)+1.)) + PI_PHY(I,K)=(P_PHY(I,K)*1.E-5)**CAPPA + TH_PHY(I,K)=T(I,K)/PI_PHY(I,K) + DZ(I,K)=(PRSI(I,K)-PRSI(I,K+1))*R_G/RR(I,K) + +! +!*** CALL MICROPHYSICS + +!MZ* in HWRF +!-- 6/11/2010: Update cwm, F_ice, F_rain and F_rimef arrays + cwm(I,K)=QC(I,K)+QR(I,K)+QI(I,K) + IF (QI(I,K) <= EPSQ) THEN + F_ICE(I,K)=0. + F_RIMEF(I,K)=1. + IF (T(I,K) < T_ICEK) F_ICE(I,K)=1. + ELSE + F_ICE(I,K)=MAX( 0., MIN(1., QI(I,K)/cwm(I,K) ) ) + F_RIMEF(I,K)=QG(I,K)/QI(I,K) + ENDIF + IF (QR(I,K) <= EPSQ) THEN + F_RAIN(I,K)=0. + ELSE + F_RAIN(I,K)=QR(I,K)/(QR(I,K)+QC(I,K)) + ENDIF + + end do + enddo + +!--------------------------------------------------------------------- +!*** Update the rime factor array after 3d advection +!--------------------------------------------------------------------- +!MZ* in namphysics +! DO K=1,LM +! DO I=IMS,IME +! IF (QG(I,K)>EPSQ .AND. QI(I,K)>EPSQ) THEN +! F_RIMEF(I,K)=MIN(50.,MAX(1.,QG(I,K)/QI(I,K))) +! ELSE +! F_RIMEF(I,K)=1. +! ENDIF +! ENDDO +! ENDDO + + +!--------------------------------------------------------------------- + + CALL FER_HIRES( & + DT=dtphs,RHgrd=RHGRD & + ,DZ8W=dz,RHO_PHY=rr,P_PHY=p_phy,PI_PHY=pi_phy & + ,TH_PHY=th_phy,T_PHY=t & + ,Q=Q,QT=cwm & + ,LOWLYR=LOWLYR,SR=SR & + ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN & + ,F_RIMEF_PHY=F_RIMEF & + ,QC=QC,QR=QR,QS=QI & + ,RAINNC=rainnc,RAINNCV=rainncv & + ,threads=threads & + ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,LM=LM & + ,D_SS=d_ss & + ,refl_10cm=refl_10cm,DX1=DX1) + + +!....................................................................... + +!MZ* +!Aligo Oct-23-2019 +! - Convert dry qc,qr,qi back to wet mixing ratio +! DO K = 1, LM +! DO I= IMS, IME +! qc_m(i,k) = qc(i,k)/(1.0_kind_phys+q(i,k)) +! qi_m(i,k) = qi(i,k)/(1.0_kind_phys+q(i,k)) +! qr_m(i,k) = qr(i,k)/(1.0_kind_phys+q(i,k)) +! ENDDO +! ENDDO + + + +!----------------------------------------------------------- + DO K=1,LM + DO I=IMS,IME + +!--------------------------------------------------------------------- +!*** Calculate graupel from total ice array and rime factor +!--------------------------------------------------------------------- + +!MZ + IF (SPEC_ADV) then + QG(I,K)=QI(I,K)*F_RIMEF(I,K) + ENDIF + +! +!----------------------------------------------------------------------- +!*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD WATER, AND HEATING. +!----------------------------------------------------------------------- +! + TNEW=TH_PHY(I,K)*PI_PHY(I,K) + TRAIN(I,K)=TRAIN(I,K)+(TNEW-T(I,K))*RDTPHS + T(I,K)=TNEW + ENDDO + ENDDO + +!....................................................................... + +! +!----------------------------------------------------------------------- +!*** UPDATE PRECIPITATION +!----------------------------------------------------------------------- +! + DO I=IMS,IME + PCPCOL=RAINNCV(I)*1.E-3 !MZ:unit:m + PREC(I)=PREC(I)+PCPCOL +!MZ ACPREC(I)=ACPREC(I)+PCPCOL !MZ: not used +! +! NOTE: RAINNC IS ACCUMULATED INSIDE MICROPHYSICS BUT NMM ZEROES IT OUT ABOVE +! SINCE IT IS ONLY A LOCAL ARRAY FOR NOW +! + ENDDO +!----------------------------------------------------------------------- +! + end subroutine mp_fer_hires_run + + +!> \section arg_table_mp_fer_hires_finalize Argument Table +!! + subroutine mp_fer_hires_finalize () + end subroutine mp_fer_hires_finalize + +end module mp_fer_hires diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta new file mode 100644 index 000000000..36b40a95c --- /dev/null +++ b/physics/mp_fer_hires.meta @@ -0,0 +1,426 @@ +[ccpp-arg-table] + name = mp_fer_hires_init + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + 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_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[f_ice] + standard_name = fraction_of_ice_water_cloud + long_name = fraction of ice water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = T +[f_rain] + standard_name = fraction_of_rain_water_cloud + long_name = fraction of rain water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = T +[f_rimef] + standard_name = rime_factor + long_name = rime factor + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = T +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[threads] + standard_name = omp_threads + long_name = number of OpenMP threads available to scheme + units = count + 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 = mp_fer_hires_finalize + type = scheme +######################################################################## +[ccpp-arg-table] + name = mp_fer_hires_run + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + 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 +[spec_adv] + standard_name = flag_for_individual_cloud_species_advected + long_name = flag for individual cloud species advected + units = flag + dimensions = () + type = logical + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind= kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_phy] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t] + 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 +[q] + 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 + optional = F +[cwm] + standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics + long_name = total cloud condensate mixing ratio (except water vapor) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[train] + standard_name = accumulated_change_of_air_temperature_due_to_FA_scheme + long_name = accumulated change of air temperature due to FA MP scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sr] + standard_name = ratio_of_snowfall_to_rainfall + long_name = snow ratio: ratio of snow to total precipitation (explicit only) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[f_ice] + standard_name = fraction_of_ice_water_cloud + long_name = fraction of ice water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[f_rain] + standard_name = fraction_of_rain_water_cloud + long_name = fraction of rain water cloud + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[f_rimef] + standard_name = rime_factor + long_name = rime factor + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + 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 + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + 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 + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + 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 + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qg] + standard_name = mass_weighted_rime_factor_updated_by_physics + long_name = mass weighted rime factor updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[prec] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation ( rain, ice, snow, graupel, ...) on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[threads] + standard_name = omp_threads + long_name = number of OpenMP threads available to scheme + units = count + dimensions = () + type = integer + intent = in + optional = F +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rhgrd] + standard_name = fa_threshold_relative_humidity_for_onset_of_condensation + long_name = relative humidity threshold parameter for condensation for FA scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dx] + standard_name = cell_size + long_name = relative dx for the grid cell + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[EPSQ] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[R_D] + 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 +[P608] + 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 +[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 +[G] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + 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 + 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/radiation_clouds.f b/physics/radiation_clouds.f index 1c5605ae3..49b394fe1 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -262,6 +262,7 @@ module module_radiation_clouds !!\n =8: Thompson microphysics !!\n =6: WSM6 microphysics !!\n =10: MG microphysics +!!\n =15: Ferrier-Aligo microphysics !!\param me print control flag !>\section gen_cld_init cld_init General Algorithm !! @{ @@ -350,6 +351,8 @@ subroutine cld_init & print *,' --- WSM6 cloud microphysics' elseif (imp_physics == 10) then print *,' --- MG cloud microphysics' + elseif (imp_physics == 15) then + print *,' --- Ferrier-Aligo cloud microphysics' else print *,' !!! ERROR in cloud microphysc specification!!!', & & ' imp_physics (NP3D) =',imp_physics From 73bbc9f1df683e4dab9c22d52d0319c8615ffab2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 26 Nov 2019 08:22:34 -0700 Subject: [PATCH 41/84] Merge gsd/develop into dtc/develop, squashed commit of the following: commit 7f530edd66132aa4d92e042a580c0aebf7e69662 Merge: e0d5f16 b492f2e Author: Dom Heinzeller Date: Thu Nov 21 15:40:20 2019 -0700 Merge pull request #356 from tanyasmirnova/ruc_land_ice_v1 Added the capability to use climatological LAI in RUC LSM commit b492f2efb2a33ce8fbc43518bf1fd6fee44574e2 Merge: bd32702 e0d5f16 Author: tanyasmirnova Date: Wed Nov 20 20:36:42 2019 +0000 Merge branch 'gsd/develop' of https://github.com/NCAR/ccpp-physics into ruc_land_ice_v1 commit bd32702bfd96f2d4bab4b25bfa408c4c7bd098cd Author: tanyasmirnova Date: Wed Nov 20 20:29:42 2019 +0000 Added the capability to use a Leaf Area Index (LAI) climatology in RUC LSM. Variables xlaixy and rdlai are added to the argument list of lsm_ruc_run. If rdlai=.true. in the physics namelist, then the LAI climatology will be passed into the RUC LSM and used instead of look-up table value for a given vegetation type. commit e0d5f16696a64333dc1920b060c43a8dde050c00 Merge: 660ede7 e4d291e Author: Dom Heinzeller Date: Sat Nov 2 05:47:40 2019 +0900 Merge pull request #349 from tanyasmirnova/ruc_land_ice_v1 This commit has a fix for a problem of cloud-radiation coupling with the use of MYNN PBL. commit e4d291e1b08ab68a7820f55921d0b5584d58944b Author: tanyasmirnova Date: Fri Nov 1 16:47:58 2019 +0000 This commit has a fix for a problem of cloud-radiation coupling with the use of MYNN PBL. The problem: the first call to the radiation happens before the first call to MYNN PBL, therefore CLDFRA_BL=0 in the first call to mynnrad_pre, and zero values are sent to array cldcov(:,:). When cloud cover is zero, the RRTMG radiation thinks that there are no clouds at all. The erroneous cloud-free LW and SW downward radiation fluxes affect the first hour of itegration, and cause siginificant cooling in the ploar regions, and too warm land surface temperature from cloud-free SW radiation. The fix: the fist call to mynnrad_pre should be skipped, so that cloud cover - cldcov(:,:) - is not overwritten by zero values of MYNN subgrid-clouds. In this case the initial cloud cover is computed in progcld5 from initial cloud water mixing ratio, relative humidity and specific humidity in the layer. Starting with the second call to the rrtmg radiation, the MYNN subgrid clouds are used. commit 660ede7a9f83a45f6141200cd951446fddf7f15e Merge: 4a17324 db9742d Author: Dom Heinzeller Date: Mon Oct 28 12:38:54 2019 +0900 Merge pull request #344 from tanyasmirnova/ruc_land_ice_v1 Sync RUC LSM code with the version used in RAP/HRRR commit db9742d5609912a7e3db99769665eded32668332 Author: tanyasmirnova Date: Thu Oct 24 22:14:13 2019 +0000 Sync the RUC LSM code with the version in RAPv5/HRRRv4. Some clean-up in sfc_drv_ruc.F90. commit 27eb0898682ca2dce1a8da32826fd7be561a5f68 Merge: fa3c1d3 4a17324 Author: tanyasmirnova Date: Thu Oct 24 22:03:14 2019 +0000 Merge branch 'gsd/develop' of https://github.com/NCAR/ccpp-physics into ruc_land_ice_v1 commit 4a17324ac9c7e9351da6527c541a2d110109f8a5 Merge: 543f640 3a28055 Author: Dom Heinzeller Date: Thu Oct 24 10:53:19 2019 +0900 Merge pull request #338 from haiqinli/gsd/develop-hli "to include GF updates in GSDv0beta4" commit 3a280556fd762f04cd5a2688c861546ce6c097ec Author: Haiqin.Li Date: Wed Oct 23 21:13:25 2019 +0000 "update to pass the ccpp_gsd_noah_repro regression test case" commit 0711b8288eb5825b77f20c4079b28235c03d4c86 Author: Haiqin.Li Date: Sun Oct 20 04:54:18 2019 +0000 "update to pass ccpp_gsd regression test" commit fa3c1d39aa8e5db07f571fff9f3348cd4c0a1423 Author: tanyasmirnova Date: Thu Oct 17 16:28:55 2019 +0000 1. Use fraction of frozen precipitation SR directly from Thompson MP. 2. Bug fix in liquid precipitation and frozen fraction - SRFLAG. This bug was producing 1.e-3 factor maller values of SRFLAG. 3. Modification to comment for precipitation in sfc_drv_ruc.F90 commit a59d416574e7c978da10d2d0f82920e46ec047e0 Author: Haiqin.Li Date: Sun Oct 13 20:40:44 2019 +0000 "clean the code" commit 4ca463ca07c1d381ccb8bd018761bc0adee0e526 Author: Haiqin.Li Date: Sun Oct 13 20:35:36 2019 +0000 "update input of imfdeepcnv following Dom's suggestions" commit 14c1c5bfedc69cb6466d7c8a3a98d0f34454f125 Author: Haiqin.Li Date: Fri Sep 27 18:04:33 2019 +0000 "to include GF updates in GSDv0beta4" --- physics/GFS_suite_interstitial.F90 | 7 +- physics/GFS_suite_interstitial.meta | 8 + physics/cu_gf_deep.F90 | 287 ++++++++++++- physics/cu_gf_driver.F90 | 600 +++++++++++++++------------- physics/cu_gf_driver.meta | 67 ++++ physics/module_MYNNrad_post.F90 | 7 + physics/module_MYNNrad_post.meta | 16 + physics/module_MYNNrad_pre.F90 | 8 +- physics/module_MYNNrad_pre.meta | 16 + physics/module_sf_ruclsm.F90 | 14 +- physics/sfc_drv_ruc.F90 | 40 +- physics/sfc_drv_ruc.meta | 14 + 12 files changed, 774 insertions(+), 310 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 1df53ff12..20f51f99c 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -659,7 +659,7 @@ end subroutine GFS_suite_interstitial_4_finalize !> \section arg_table_GFS_suite_interstitial_4_run Argument Table !! \htmlinclude GFS_suite_interstitial_4_run.html !! - subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, & + subroutine GFS_suite_interstitial_4_run (imfdeepcnv, 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) @@ -670,7 +670,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! interface variables - integer, intent(in) :: im, levs, tracers_total, ntrac, ntcw, ntiw, ntclamt, ntrw, & + integer, intent(in) :: imfdeepcnv, 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 @@ -736,7 +736,8 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to gq0(i,k,ntcw) = clw(i,k,2) ! water enddo enddo - if (imp_physics == imp_physics_thompson) then +! if (imp_physics == imp_physics_thompson) then + if (imp_physics == imp_physics_thompson .and. imfdeepcnv /= 3) then if (ltaerosol) then do k=1,levs do i=1,im diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 44696dcb0..2fa377c00 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1454,6 +1454,14 @@ [ccpp-arg-table] name = GFS_suite_interstitial_4_run type = scheme +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index 3e865c9ba..4afad80d1 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -14,7 +14,7 @@ module cu_gf_deep !> tuning constant for cloudwater/ice detrainment real(kind=kind_phys), parameter:: c1= 0.003 !.002 ! .0005 !> parameter to turn on or off evaporation of rainwater as done in sas - integer, parameter :: irainevap=0 + integer, parameter :: irainevap=1 !> max allowed fractional coverage (frh_thresh) real(kind=kind_phys), parameter::frh_thresh = .9 !> rh threshold. if fractional coverage ~ frh_thres, do not use cupa any further @@ -362,7 +362,7 @@ subroutine cu_gf_deep_run( & c1_max=c1 elocp=xlv/cp el2orc=xlv*xlv/(r_v*cp) - evfact=.2 + evfact=.4 ! .2 evfactl=.2 !evfact=.0 ! for 4F5f !evfactl=.4 @@ -1923,6 +1923,13 @@ subroutine cu_gf_deep_run( & ichoice,imid,ipr,itf,ktf, & its,ite, kts,kte, & dicycle,xf_dicycle ) + +!---------------evap below cloud base + + call rain_evap_below_cloudbase(itf,ktf,its,ite, & + kts,kte,ierr,kbcon,xmb,psur,xland,qo_cup, & + po_cup,qes_cup,pwavo,edto,pwevo,pre,outt,outq) !,outbuoy) + k=1 do i=its,itf if(ierr(i).eq.0 .and.pre(i).gt.0.) then @@ -1971,7 +1978,7 @@ subroutine cu_gf_deep_run( & do k = ktop(i), 1, -1 rain = pwo(i,k) + edto(i) * pwdo(i,k) rn(i) = rn(i) + rain * xmb(i) * .001 * dtime - !if(po(i,k).gt.700.)then + if(po(i,k).gt.400.)then if(flg(i))then q1=qo(i,k)+(outq(i,k))*dtime t1=tn(i,k)+(outt(i,k))*dtime @@ -1996,7 +2003,7 @@ subroutine cu_gf_deep_run( & pre(i)=max(pre(i),0.) delqev(i) = delqev(i) + .001*dp*qevap(i)/g endif - !endif ! 700mb + endif ! 400mb endif enddo ! pre(i)=1000.*rn(i)/dtime @@ -2035,6 +2042,271 @@ end subroutine cu_gf_deep_run !> @} !>\ingroup cu_gf_deep_group + + + subroutine fct1d3 (ktop,n,dt,z,tracr,massflx,trflx_in,dellac,g) + +! --- modify a 1-D array of tracer fluxes for the purpose of maintaining +! --- monotonicity (including positive-definiteness) in the tracer field +! --- during tracer transport. + +! --- the underlying transport equation is (d tracr/dt) = - (d trflx/dz) +! --- where dz = |z(k+1)-z(k)| (k=1,...,n) and trflx = massflx * tracr +! --- physical dimensions of tracr,trflx,dz are arbitrary to some extent +! --- but are subject to the constraint dim[trflx] = dim[tracr*(dz/dt)]. + +! --- note: tracr is carried in grid cells while z and fluxes are carried on +! --- interfaces. interface variables at index k are at grid location k-1/2. +! --- sign convention: mass fluxes are considered positive in +k direction. + +! --- massflx and trflx_in must be provided independently to allow the +! --- algorithm to generate an auxiliary low-order (diffusive) tracer flux +! --- as a stepping stone toward the final product trflx_out. + + implicit none + integer,intent(in) :: n,ktop ! number of grid cells + real(kind=kind_phys) ,intent(in) :: dt,g ! transport time step + real(kind=kind_phys) ,intent(in) :: z(n+0) ! location of cell interfaces + real(kind=kind_phys) ,intent(in) :: tracr(n) ! the transported variable + real(kind=kind_phys) ,intent(in) :: massflx(n+0) ! mass flux across interfaces + real(kind=kind_phys) ,intent(in) :: trflx_in(n+0) ! original tracer flux + real(kind=kind_phys) ,intent(out):: dellac(n+0) ! modified tracr flux + real(kind=kind_phys) :: trflx_out(n+0) ! modified tracr flux + integer k,km1,kp1 + logical :: NaN, error=.false., vrbos=.true. + real(kind=kind_phys) dtovdz(n),trmax(n),trmin(n),flx_lo(n+0),antifx(n+0),clipped(n+0), & + soln_hi(n),totlin(n),totlout(n),soln_lo(n),clipin(n),clipout(n),arg + real(kind=kind_phys),parameter :: epsil=1.e-22 ! prevent division by zero + real(kind=kind_phys),parameter :: damp=1. ! damper of antidff flux (1=no damping) + NaN(arg) = .not. (arg.ge.0. .or. arg.le.0.) ! NaN detector + dtovdz(:)=0. + soln_lo(:)=0. + antifx(:)=0. + clipin(:)=0. + totlin(:)=0. + totlout(:)=0. + clipout(:)=0. + flx_lo(:)=0. + trmin(:)=0. + trmax(:)=0. + clipped(:)=0. + trflx_out(:)=0. + do k=1,ktop + dtovdz(k)=.01*dt/abs(z(k+1)-z(k))*g ! time step / grid spacing + if (z(k).eq.z(k+1)) error=.true. + end do +! if (vrbos .or. error) print '(a/(8es10.3))','(fct1d) dtovdz =',dtovdz + + do k=2,ktop + if (massflx(k).ge.0.) then + flx_lo(k)=massflx(k)*tracr(k-1) ! low-order flux, upstream + else + flx_lo(k)=massflx(k)*tracr(k) ! low-order flux, upstream + end if + antifx(k)=trflx_in(k)-flx_lo(k) ! antidiffusive flux + end do + flx_lo( 1)=trflx_in( 1) + flx_lo(ktop+1)=trflx_in(ktop+1) + antifx( 1)=0. + antifx(ktop+1)=0. +! --- clip low-ord fluxes to make sure they don't violate positive-definiteness + do k=1,ktop + totlout(k)=max(0.,flx_lo(k+1))-min(0.,flx_lo(k )) ! total flux out + clipout(k)=min(1.,tracr(k)/max(epsil,totlout(k))/ (1.0001*dtovdz(k))) + end do + + do k=2,ktop + if (massflx(k).ge.0.) then + flx_lo(k)=flx_lo(k)*clipout(k-1) + else + flx_lo(k)=flx_lo(k)*clipout(k) + end if + end do + if (massflx( 1).lt.0.) flx_lo( 1)=flx_lo( 1)*clipout(1) + if (massflx(ktop+1).gt.0.)flx_lo(ktop+1)=flx_lo(ktop+1)*clipout(ktop) + +! --- a positive-definite low-order (diffusive) solution can now be constructed + + do k=1,ktop + soln_lo(k)=tracr(k)-(flx_lo(k+1)-flx_lo(k))*dtovdz(k) ! low-ord solutn + dellac(k)=-(flx_lo(k+1)-flx_lo(k))*dtovdz(k)/dt + !dellac(k)=soln_lo(k) + end do + return + do k=1,ktop + km1=max(1,k-1) + kp1=min(ktop,k+1) + trmax(k)= max(soln_lo(km1),soln_lo(k),soln_lo(kp1), & + tracr (km1),tracr (k),tracr (kp1)) ! upper bound + trmin(k)=max(0.,min(soln_lo(km1),soln_lo(k),soln_lo(kp1), & + tracr (km1),tracr (k),tracr (kp1))) ! lower bound + end do + + do k=1,ktop + totlin (k)=max(0.,antifx(k ))-min(0.,antifx(k+1)) ! total flux in + totlout(k)=max(0.,antifx(k+1))-min(0.,antifx(k )) ! total flux out + + clipin (k)=min(damp,(trmax(k)-soln_lo(k))/max(epsil,totlin (k)) & + / (1.0001*dtovdz(k))) + clipout(k)=min(damp,(soln_lo(k)-trmin(k))/max(epsil,totlout(k)) & + / (1.0001*dtovdz(k))) + + if (NaN(clipin(k))) print *,'(fct1d) error: clipin is NaN, k=',k + if (NaN(clipout(k))) print *,'(fct1d) error: clipout is NaN, k=',k + + if (clipin(k).lt.0.) then +! print 100,'(fct1d) error: clipin < 0 at k =',k, & +! 'clipin',clipin(k),'trmax',trmax(k),'soln_lo',soln_lo(k), & +! 'totlin',totlin(k),'dt/dz',dtovdz(k) + error=.true. + end if + if (clipout(k).lt.0.) then +! print 100,'(fct1d) error: clipout < 0 at k =',k, & +! 'clipout',clipout(k),'trmin',trmin(k),'soln_lo',soln_lo(k), & +! 'totlout',totlout(k),'dt/dz',dtovdz(k) + error=.true. + end if +! 100 format (a,i3/(4(a10,"=",es9.2))) + end do + + do k=2,ktop + if (antifx(k).gt.0.) then + clipped(k)=antifx(k)*min(clipout(k-1),clipin(k)) + else + clipped(k)=antifx(k)*min(clipout(k),clipin(k-1)) + end if + trflx_out(k)=flx_lo(k)+clipped(k) + if (NaN(trflx_out(k))) then + print *,'(fct1d) error: trflx_out is NaN, k=',k + error=.true. + end if + end do + trflx_out( 1)=trflx_in( 1) + trflx_out(ktop+1)=trflx_in(ktop+1) + do k=1,ktop + soln_hi(k)=tracr(k)-(trflx_out(k+1)-trflx_out(k))*dtovdz(k) + dellac(k)=-g*(trflx_out(k+1)-trflx_out(k))*dtovdz(k)/dt + !dellac(k)=soln_hi(k) + end do + + if (vrbos .or. error) then +! do k=2,ktop +! write(32,99)k, & +! 'tracr(k)', tracr(k), & +! 'flx_in(k)', trflx_in(k), & +! 'flx_in(k+1)', trflx_in(k+1), & +! 'flx_lo(k)', flx_lo(k), & +! 'flx_lo(k+1)', flx_lo(k+1), & +! 'soln_lo(k)', soln_lo(k), & +! 'trmin(k)', trmin(k), & +! 'trmax(k)', trmax(k), & +! 'totlin(k)', totlin(k), & +! 'totlout(k)', totlout(k), & +! 'clipin(k-1)', clipin(k-1), & +! 'clipin(k)', clipin(k), & +! 'clipout(k-1)', clipout(k-1), & +! 'clipout(k)', clipout(k), & +! 'antifx(k)', antifx(k), & +! 'antifx(k+1)', antifx(k+1), & +! 'clipped(k)', clipped(k), & +! 'clipped(k+1)', clipped(k+1), & +! 'flx_out(k)', trflx_out(k), & +! 'flx_out(k+1)', trflx_out(k+1), & +! 'dt/dz(k)', dtovdz(k), & +! 'final', tracr(k)-(trflx_out(k+1)-trflx_out(k))*dtovdz(k) +! 99 format ('(trc1d) k =',i4/(3(a13,'=',es13.6))) +! end do + if (error) stop '(fct1d error)' + end if + + return + end subroutine fct1d3 + + subroutine rain_evap_below_cloudbase(itf,ktf, its,ite, kts,kte,ierr, & + kbcon,xmb,psur,xland,qo_cup, & + po_cup,qes_cup,pwavo,edto,pwevo,pre,outt,outq) !,outbuoy) + + implicit none + real(kind=kind_phys), parameter :: alp1=5.44e-4 & !1/sec + ,alp2=5.09e-3 & !unitless + ,alp3=0.5777 & !unitless + ,c_conv=0.05 !conv fraction area, unitless + + + integer ,intent(in) :: itf,ktf, its,ite, kts,kte + integer, dimension(its:ite) ,intent(in) :: ierr,kbcon + real(kind=kind_phys), dimension(its:ite) ,intent(in) ::psur,xland,pwavo,edto,pwevo,xmb + real(kind=kind_phys), dimension(its:ite,kts:kte),intent(in) :: po_cup,qo_cup,qes_cup + real(kind=kind_phys), dimension(its:ite) ,intent(inout) :: pre + real(kind=kind_phys), dimension(its:ite,kts:kte),intent(inout) :: outt,outq !,outbuoy + + !real, dimension(its:ite) ,intent(out) :: tot_evap_bcb + !real, dimension(its:ite,kts:kte),intent(out) :: evap_bcb,net_prec_bcb + + !-- locals + integer :: i,k + real(kind=kind_phys) :: RH_cr , del_t,del_q,dp,q_deficit + real(kind=kind_phys), dimension(its:ite,kts:kte) :: evap_bcb,net_prec_bcb + real(kind=kind_phys), dimension(its:ite) :: tot_evap_bcb + + do i=its,itf + evap_bcb (i,:)= 0.0 + net_prec_bcb(i,:)= 0.0 + tot_evap_bcb(i) = 0.0 + if(ierr(i) /= 0) cycle + + !-- critical rel humidity + RH_cr=0.9*xland(i)+0.7*(1-xland(i)) + !RH_cr=1. + + !-- net precipitation (after downdraft evap) at cloud base, available to + !evap + k=kbcon(i) + !net_prec_bcb(i,k) = xmb(i)*(pwavo(i)+edto(i)*pwevo(i)) !-- pwevo<0. + net_prec_bcb(i,k) = pre(i) + + do k=kbcon(i)-1, kts, -1 + + q_deficit = max(0.,(RH_cr*qes_cup(i,k) -qo_cup(i,k))) + + if(q_deficit < 1.e-6) then + net_prec_bcb(i,k)= net_prec_bcb(i,k+1) + cycle + endif + + dp = 100.*(po_cup(i,k)-po_cup(i,k+1)) + + !--units here: kg[water]/kg[air}/sec + evap_bcb(i,k) = c_conv * alp1 * q_deficit * & + ( sqrt(po_cup(i,k)/psur(i))/alp2 *net_prec_bcb(i,k+1)/c_conv )**alp3 + + !--units here: kg[water]/kg[air}/sec * kg[air]/m3 * m = kg[water]/m2/sec + evap_bcb(i,k)= evap_bcb(i,k)*dp/g + + if((net_prec_bcb(i,k+1) - evap_bcb(i,k)).lt.0.) cycle + if((pre(i) - evap_bcb(i,k)).lt.0.) cycle + net_prec_bcb(i,k)= net_prec_bcb(i,k+1) - evap_bcb(i,k) + + tot_evap_bcb(i) = tot_evap_bcb(i)+evap_bcb(i,k) + + !-- feedback + del_q = evap_bcb(i,k)*g/dp ! > 0., units: kg[water]/kg[air}/sec + del_t = -evap_bcb(i,k)*g/dp*(xlv/cp) ! < 0., units: K/sec + +! print*,"ebcb2",k,del_q*86400,del_t*86400 + + outq (i,k) = outq (i,k) + del_q + outt (i,k) = outt (i,k) + del_t + !outbuoy(i,k) = outbuoy(i,k) + cp*del_t+xlv*del_q + + pre(i) = pre(i) - evap_bcb(i,k) + enddo + enddo + + end subroutine rain_evap_below_cloudbase + + + subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & pw,ccn,pwev,edtmax,edtmin,edtc,psum2,psumh, & rho,aeroevap,itf,ktf, & @@ -2747,9 +3019,8 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 xff_ens3(12)=0. xff_ens3(13)= 0. xff_ens3(16)= 0. -! closure_n(i)=12. -! hli 05/01/2018 closure_n(i)=12. -! xff_dicycle = 0. +! closure_n(i)=12. +! xff_dicycle = 0. endif !xff0 endif ! ichoice @@ -3682,7 +3953,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & prop_b(kts:kte)=0 iall=0 c0=.002 - clwdet=100. + clwdet=50. bdsp=bdispm ! !--- no precip for small clouds diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 58a30749a..53e26fb46 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -7,8 +7,9 @@ module cu_gf_driver ! DH* TODO: replace constants with arguments to cu_gf_driver_run use physcons , g => con_g, cp => con_cp, xlv => con_hvap, r_v => con_rv use machine , only: kind_phys - use cu_gf_deep, only: cu_gf_deep_run,neg_check,autoconv,aeroevap + use cu_gf_deep, only: cu_gf_deep_run,neg_check,autoconv,aeroevap,fct1d3 use cu_gf_sh , only: cu_gf_sh_run + use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber implicit none @@ -68,11 +69,12 @@ end subroutine cu_gf_driver_finalize !! !>\section gen_gf_driver GSD GF Cumulus Scheme General Algorithm !> @{ - subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & - forcet,forceqv_spechum,phil,raincv,qv_spechum,t,cld1d, & - us,vs,t2di,w,qv2di_spechum,p2di,psuri, & - hbot,htop,kcnv,xland,hfx2,qfx2,cliw,clcw, & - pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv, & + subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & + forcet,forceqv_spechum,phil,raincv,qv_spechum,t,cld1d, & + us,vs,t2di,w,qv2di_spechum,p2di,psuri, & + hbot,htop,kcnv,xland,hfx2,qfx2,cliw,clcw, & + pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv, & + nwfa,con_rd,gq0,ntinc,ntlnc,imp_physics,imp_physics_thompson, & errmsg,errflg) !------------------------------------------------------------- implicit none @@ -94,7 +96,7 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte - integer, intent(in ) :: im,ix,km + integer, intent(in ) :: im,ix,km,ntracer real(kind=kind_phys), dimension( ix , km ), intent(in ) :: forcet,forceqv_spechum,w,phil real(kind=kind_phys), dimension( ix , km ), intent(inout ) :: t,us,vs @@ -104,16 +106,16 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & real(kind=kind_phys), dimension( ix , km ), intent(out ) :: cnvw_moist,cnvc real(kind=kind_phys), dimension( ix , km ), intent(inout ) :: cliw, clcw -!hj change from ix to im +! change from ix to im integer, dimension (im), intent(inout) :: hbot,htop,kcnv integer, dimension (im), intent(in) :: xland real(kind=kind_phys), dimension (im), intent(in) :: pbl integer, dimension (ix) :: tropics -! ruc variable +! ruc variable real(kind=kind_phys), dimension (im) :: hfx2,qfx2,psuri real(kind=kind_phys), dimension (im,km) :: ud_mf,dd_mf,dt_mf real(kind=kind_phys), dimension (im), intent(inout) :: raincv,cld1d -!hj end change ix to im +! end change ix to im real(kind=kind_phys), dimension (ix,km) :: t2di,p2di ! Specific humidity from FV3 real(kind=kind_phys), dimension (ix,km), intent(in) :: qv2di_spechum @@ -123,80 +125,76 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & ! real(kind=kind_phys), dimension( im ),intent(in) :: garea real(kind=kind_phys), intent(in ) :: dt + +! additional variables for number concentrations + real(kind=kind_phys), intent(in) :: nwfa(1:im,1:km) + real(kind=kind_phys), intent(in) :: con_rd + real(kind=kind_phys), dimension(im,km,ntracer), intent(inout) :: gq0 + integer, intent(in) :: imp_physics,imp_physics_thompson,ntlnc,ntinc + integer, intent(in ) :: imfshalcnv character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg -!hj define locally for now. - integer, dimension(im),intent(inout) :: cactiv ! hli for gf -!hj change from ix to im +! define locally for now. + integer, dimension(im),intent(inout) :: cactiv integer, dimension(im) :: k22_shallow,kbcon_shallow,ktop_shallow real(kind=kind_phys), dimension(im) :: ht -!hj change -! -!+lxz -!hj real(kind=kind_phys) :: dx real(kind=kind_phys), dimension(im) :: dx -! local vars -!hj change ix to im - real(kind=kind_phys), dimension (im,km) :: outt,outq,outqc,phh,subm,cupclw,cupclws - real(kind=kind_phys), dimension (im,km) :: dhdt,zu,zus,zd,phf,zum,zdm,outum,outvm - real(kind=kind_phys), dimension (im,km) :: outts,outqs,outqcs,outu,outv,outus,outvs - real(kind=kind_phys), dimension (im,km) :: outtm,outqm,outqcm,submm,cupclwm - real(kind=kind_phys), dimension (im,km) :: cnvwt,cnvwts,cnvwtm - real(kind=kind_phys), dimension (im,km) :: hco,hcdo,zdo,zdd,hcom,hcdom,zdom - real(kind=kind_phys), dimension (km) :: zh - real(kind=kind_phys), dimension (im) :: tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi - real(kind=kind_phys), dimension (im) :: pret,prets,pretm,hexec - real(kind=kind_phys), dimension (im,10) :: forcing,forcing2 -!+lxz - integer, dimension (im) :: kbcon, ktop,ierr,ierrs,ierrm,kpbli - integer, dimension (im) :: k22s,kbcons,ktops,k22,jmin,jminm - integer, dimension (im) :: kbconm,ktopm,k22m -!hj end change ix to im -!.lxz - integer :: iens,ibeg,iend,jbeg,jend,n - integer :: ibegh,iendh,jbegh,jendh - integer :: ibegc,iendc,jbegc,jendc,kstop - real(kind=kind_phys) :: rho_dryar,temp - real(kind=kind_phys) :: pten,pqen,paph,zrho,pahfs,pqhfl,zkhvfl,pgeoh -!hj 10/11/2016: ipn is an input in fim. set it to zero here. - integer, parameter :: ipn = 0 + real(kind=kind_phys), dimension (im,km) :: outt,outq,outqc,phh,subm,cupclw,cupclws + real(kind=kind_phys), dimension (im,km) :: dhdt,zu,zus,zd,phf,zum,zdm,outum,outvm + real(kind=kind_phys), dimension (im,km) :: outts,outqs,outqcs,outu,outv,outus,outvs + real(kind=kind_phys), dimension (im,km) :: outtm,outqm,outqcm,submm,cupclwm + real(kind=kind_phys), dimension (im,km) :: cnvwt,cnvwts,cnvwtm + real(kind=kind_phys), dimension (im,km) :: hco,hcdo,zdo,zdd,hcom,hcdom,zdom + real(kind=kind_phys), dimension (km) :: zh + real(kind=kind_phys), dimension (im) :: tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi + real(kind=kind_phys), dimension (im) :: pret,prets,pretm,hexec + real(kind=kind_phys), dimension (im,10) :: forcing,forcing2 + + integer, dimension (im) :: kbcon, ktop,ierr,ierrs,ierrm,kpbli + integer, dimension (im) :: k22s,kbcons,ktops,k22,jmin,jminm + integer, dimension (im) :: kbconm,ktopm,k22m + + integer :: iens,ibeg,iend,jbeg,jend,n + integer :: ibegh,iendh,jbegh,jendh + integer :: ibegc,iendc,jbegc,jendc,kstop + real(kind=kind_phys), dimension(im,km) :: rho_dryar + real(kind=kind_phys) :: pten,pqen,paph,zrho,pahfs,pqhfl,zkhvfl,pgeoh + integer, parameter :: ipn = 0 ! ! basic environmental input includes moisture convergence (mconv) ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off ! convection for this call only and at that particular gridpoint ! -!hj 10/11/2016: change ix to im. - real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi - real(kind=kind_phys), dimension (im,km) :: tn,qo,tshall,qshall,dz8w,omeg - real(kind=kind_phys), dimension (im) :: ccn,z1,psur,cuten,cutens,cutenm - real(kind=kind_phys), dimension (im) :: umean,vmean,pmean - real(kind=kind_phys), dimension (im) :: xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv -!hj end change ix to im - - integer :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep - integer :: itf,jtf,ktf,iss,jss,nbegin,nend - integer :: high_resolution - real(kind=kind_phys) :: clwtot,clwtot1,excess,tcrit,tscl_kf,dp,dq,sub_spread,subcenter - real(kind=kind_phys) :: dsubclw,dsubclws,dsubclwm,ztm,ztq,hfm,qfm,rkbcon,rktop !-lxz -!hj change ix to im - real(kind=kind_phys), dimension (im) :: flux_tun,tun_rad_mid,tun_rad_shall,tun_rad_deep - character*50 :: ierrc(im),ierrcm(im) - character*50 :: ierrcs(im) -!hj end change ix to im -! ruc variable -!hj hfx2 -- sensible heat flux (k m/s), positive upward from sfc -!hj qfx2 -- latent heat flux (kg/kg m/s), positive upward from sfc -!hj gf needs them in w/m2. define hfx and qfx after simple unit conversion - real(kind=kind_phys), dimension (im) :: hfx,qfx - real(kind=kind_phys) tem,tem1,tf,tcr,tcrf - - parameter (tf=243.16, tcr=270.16, tcrf=1.0/(tcr-tf)) - !parameter (tf=263.16, tcr=273.16, tcrf=1.0/(tcr-tf)) - !parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) - !parameter (tf=258.16, tcr=273.16, tcrf=1.0/(tcr-tf)) ! as fim - ! initialize ccpp error handling variables + real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi + real(kind=kind_phys), dimension (im,km) :: tn,qo,tshall,qshall,dz8w,omeg + real(kind=kind_phys), dimension (im) :: ccn,z1,psur,cuten,cutens,cutenm + real(kind=kind_phys), dimension (im) :: umean,vmean,pmean + real(kind=kind_phys), dimension (im) :: xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv + + integer :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep + integer :: itf,jtf,ktf,iss,jss,nbegin,nend + integer :: high_resolution + real(kind=kind_phys) :: clwtot,clwtot1,excess,tcrit,tscl_kf,dp,dq,sub_spread,subcenter + real(kind=kind_phys) :: dsubclw,dsubclws,dsubclwm,dtime_max,ztm,ztq,hfm,qfm,rkbcon,rktop + real(kind=kind_phys), dimension(km) :: massflx,trcflx_in1,clw_in1,clw_ten1,po_cup +! real(kind=kind_phys), dimension(km) :: trcflx_in2,clw_in2,clw_ten2 + real(kind=kind_phys), dimension (im) :: flux_tun,tun_rad_mid,tun_rad_shall,tun_rad_deep + character*50 :: ierrc(im),ierrcm(im) + character*50 :: ierrcs(im) +! ruc variable +! hfx2 -- sensible heat flux (k m/s), positive upward from sfc +! qfx2 -- latent heat flux (kg/kg m/s), positive upward from sfc +! gf needs them in w/m2. define hfx and qfx after simple unit conversion + real(kind=kind_phys), dimension (im) :: hfx,qfx + real(kind=kind_phys) tem,tem1,tf,tcr,tcrf + + parameter (tf=243.16, tcr=270.16, tcrf=1.0/(tcr-tf)) + !parameter (tf=263.16, tcr=273.16, tcrf=1.0/(tcr-tf)) + !parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) + !parameter (tf=258.16, tcr=273.16, tcrf=1.0/(tcr-tf)) ! as fim + ! initialize ccpp error handling variables errmsg = '' errflg = 0 ! @@ -212,8 +210,7 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & ! ! these should be coming in from outside ! -! print*,'hli in gf cactiv',cactiv -! cactiv(:) = 0 +! cactiv(:) = 0 rand_mom(:) = 0. rand_vmas(:) = 0. rand_clos(:,:) = 0. @@ -232,112 +229,113 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & ! !> - Set tuning constants for radiation coupling ! - tun_rad_shall(:)=.02 - tun_rad_mid(:)=.15 - tun_rad_deep(:)=.13 - edt(:)=0. - edtm(:)=0. - edtd(:)=0. - zdd(:,:)=0. - flux_tun(:)=5. -!hj 10/11/2016 dx and tscl_kf are replaced with input dx(i), is dlength. - ! dx for scale awareness -!hj dx=40075000./float(lonf) -!hj tscl_kf=dx/25000. - ccn(its:ite)=150. - ! - if (imfshalcnv == 3) then - ishallow_g3 = 1 - else - ishallow_g3 = 0 - end if - high_resolution=0 - subcenter=0. - iens=1 + tun_rad_shall(:)=.02 + tun_rad_mid(:)=.15 + tun_rad_deep(:)=.13 + edt(:)=0. + edtm(:)=0. + edtd(:)=0. + zdd(:,:)=0. + flux_tun(:)=5. +! 10/11/2016 dx and tscl_kf are replaced with input dx(i), is dlength. +! dx for scale awareness +! dx=40075000./float(lonf) +! tscl_kf=dx/25000. + ccn(its:ite)=150. + + if (imfshalcnv == 3) then + ishallow_g3 = 1 + else + ishallow_g3 = 0 + end if + high_resolution=0 + subcenter=0. + iens=1 ! ! these can be set for debugging ! - ipr=0 - jpr=0 - ipr_deep=0 - jpr_deep= 0 !53322 ! 528196 !0 ! 1136 !0 !421755 !3536 + ipr=0 + jpr=0 + ipr_deep=0 + jpr_deep= 0 !53322 ! 528196 !0 ! 1136 !0 !421755 !3536 ! ! - ibeg=its - iend=ite - tcrit=258. - - ztm=0. - ztq=0. - hfm=0. - qfm=0. - ud_mf =0. - dd_mf =0. - dt_mf =0. - tau_ecmwf(:)=0. + ibeg=its + iend=ite + tcrit=258. + + ztm=0. + ztq=0. + hfm=0. + qfm=0. + ud_mf =0. + dd_mf =0. + dt_mf =0. + tau_ecmwf(:)=0. ! - j=1 - ht(:)=phil(:,1)/g - do i=its,ite - cld1d(i)=0. - zo(i,:)=phil(i,:)/g - dz8w(i,1)=zo(i,2)-zo(i,1) - zh(1)=0. - kpbli(i)=2 - do k=kts+1,ktf - dz8w(i,k)=zo(i,k+1)-zo(i,k) - enddo - do k=kts+1,ktf - zh(k)=zh(k-1)+dz8w(i,k-1) - if(zh(k).gt.pbl(i))then - kpbli(i)=max(2,k) - exit - endif - enddo - enddo - do i= its,itf - forcing(i,:)=0. - forcing2(i,:)=0. - ccn(i)=100. - hbot(i) =kte - htop(i) =kts - raincv(i)=0. - xlandi(i)=real(xland(i)) -! if(abs(xlandi(i)-1.).le.1.e-3) tun_rad_shall(i)=.15 -! if(abs(xlandi(i)-1.).le.1.e-3) flux_tun(i)=1.5 + j=1 + ht(:)=phil(:,1)/g + do i=its,ite + cld1d(i)=0. + zo(i,:)=phil(i,:)/g + dz8w(i,1)=zo(i,2)-zo(i,1) + zh(1)=0. + kpbli(i)=2 + do k=kts+1,ktf + dz8w(i,k)=zo(i,k+1)-zo(i,k) + enddo + do k=kts+1,ktf + zh(k)=zh(k-1)+dz8w(i,k-1) + if(zh(k).gt.pbl(i))then + kpbli(i)=max(2,k) + exit + endif + enddo enddo + do i= its,itf - mconv(i)=0. + forcing(i,:)=0. + forcing2(i,:)=0. + ccn(i)=100. + hbot(i) =kte + htop(i) =kts + raincv(i)=0. + xlandi(i)=real(xland(i)) +! if(abs(xlandi(i)-1.).le.1.e-3) tun_rad_shall(i)=.15 +! if(abs(xlandi(i)-1.).le.1.e-3) flux_tun(i)=1.5 enddo - do k=kts,kte do i= its,itf - omeg(i,k)=0. - zu(i,k)=0. - zum(i,k)=0. - zus(i,k)=0. - zd(i,k)=0. - zdm(i,k)=0. + mconv(i)=0. enddo + do k=kts,kte + do i= its,itf + omeg(i,k)=0. + zu(i,k)=0. + zum(i,k)=0. + zus(i,k)=0. + zd(i,k)=0. + zdm(i,k)=0. + enddo enddo psur(:)=0.01*psuri(:) do i=its,itf - ter11(i)=max(0.,ht(i)) + ter11(i)=max(0.,ht(i)) enddo do k=kts,kte - do i=its,ite - cnvw(i,k)=0. - cnvc(i,k)=0. - gdc(i,k,1)=0. - gdc(i,k,2)=0. - gdc(i,k,3)=0. - gdc(i,k,4)=0. - gdc(i,k,7)=0. - gdc(i,k,8)=0. - gdc(i,k,9)=0. - gdc(i,k,10)=0. - gdc2(i,k,1)=0. - enddo + do i=its,ite + cnvw(i,k)=0. + cnvc(i,k)=0. + gdc(i,k,1)=0. + gdc(i,k,2)=0. + gdc(i,k,3)=0. + gdc(i,k,4)=0. + gdc(i,k,7)=0. + gdc(i,k,8)=0. + gdc(i,k,9)=0. + gdc(i,k,10)=0. + gdc2(i,k,1)=0. + enddo enddo ierr(:)=0 ierrm(:)=0 @@ -410,88 +408,80 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & subm(:,:)=0. dhdt(:,:)=0. - !print*,'hli t2di',t2di - !print*,'hli forcet',forcet do k=kts,ktf - do i=its,itf - p2d(i,k)=0.01*p2di(i,k) - po(i,k)=p2d(i,k) !*.01 - rhoi(i,k) = 100.*p2d(i,k)/(287.04*(t2di(i,k)*(1.+0.608*qv2di(i,k)))) - qcheck(i,k)=qv(i,k) - tn(i,k)=t(i,k)!+forcet(i,k)*dt - qo(i,k)=max(1.e-16,qv(i,k))!+forceqv(i,k)*dt - t2d(i,k)=t2di(i,k)-forcet(i,k)*dt - !print*,'hli t2di(i,k),forcet(i,k),dt,t2d(i,k)',t2di(i,k),forcet(i,k),dt,t2d(i,k) - q2d(i,k)=max(1.e-16,qv2di(i,k)-forceqv(i,k)*dt) - if(qo(i,k).lt.1.e-16)qo(i,k)=1.e-16 - tshall(i,k)=t2d(i,k) - qshall(i,k)=q2d(i,k) -!hj if(ipn.eq.jpr_deep)then -!hj write(12,123)k,dt,p2d(i,k),t2d(i,k),tn(i,k),q2d(i,k),qo(i,k),forcet(i,k) -!hj endif - enddo + do i=its,itf + p2d(i,k)=0.01*p2di(i,k) + po(i,k)=p2d(i,k) !*.01 + rhoi(i,k) = 100.*p2d(i,k)/(287.04*(t2di(i,k)*(1.+0.608*qv2di(i,k)))) + qcheck(i,k)=qv(i,k) + tn(i,k)=t(i,k)!+forcet(i,k)*dt + qo(i,k)=max(1.e-16,qv(i,k))!+forceqv(i,k)*dt + t2d(i,k)=t2di(i,k)-forcet(i,k)*dt + q2d(i,k)=max(1.e-16,qv2di(i,k)-forceqv(i,k)*dt) + if(qo(i,k).lt.1.e-16)qo(i,k)=1.e-16 + tshall(i,k)=t2d(i,k) + qshall(i,k)=q2d(i,k) + enddo enddo 123 format(1x,i2,1x,2(1x,f8.0),1x,2(1x,f8.3),3(1x,e13.5)) do i=its,itf - do k=kts,kpbli(i) + do k=kts,kpbli(i) tshall(i,k)=t(i,k) qshall(i,k)=max(1.e-16,qv(i,k)) - enddo + enddo enddo ! -!hj converting hfx2 and qfx2 to w/m2 -!hj hfx=cp*rho*hfx2 -!hj qfx=xlv*qfx2 +! converting hfx2 and qfx2 to w/m2 +! hfx=cp*rho*hfx2 +! qfx=xlv*qfx2 do i=its,itf - hfx(i)=hfx2(i)*cp*rhoi(i,1) - qfx(i)=qfx2(i)*xlv*rhoi(i,1) - dx(i) = sqrt(garea(i)) - !print*,'hli dx', dx(i) + hfx(i)=hfx2(i)*cp*rhoi(i,1) + qfx(i)=qfx2(i)*xlv*rhoi(i,1) + dx(i) = sqrt(garea(i)) enddo -!hj write(0,*),'hfx',hfx(3),qfx(3),rhoi(3,1) -!hj + do i=its,itf - do k=kts,kpbli(i) - tn(i,k)=t(i,k) - qo(i,k)=max(1.e-16,qv(i,k)) - enddo + do k=kts,kpbli(i) + tn(i,k)=t(i,k) + qo(i,k)=max(1.e-16,qv(i,k)) + enddo enddo nbegin=0 nend=0 - do i=its,itf - do k=kts,kpbli(i) - dhdt(i,k)=cp*(forcet(i,k)+(t(i,k)-t2di(i,k))/dt) + & - xlv*(forceqv(i,k)+(qv(i,k)-qv2di(i,k))/dt) -! tshall(i,k)=t(i,k) -! qshall(i,k)=qv(i,k) - enddo - enddo - do k= kts+1,ktf-1 - do i = its,itf - if((p2d(i,1)-p2d(i,k)).gt.150.and.p2d(i,k).gt.300)then - dp=-.5*(p2d(i,k+1)-p2d(i,k-1)) - umean(i)=umean(i)+us(i,k)*dp - vmean(i)=vmean(i)+vs(i,k)*dp - pmean(i)=pmean(i)+dp - endif - enddo + do i=its,itf + do k=kts,kpbli(i) + dhdt(i,k)=cp*(forcet(i,k)+(t(i,k)-t2di(i,k))/dt) + & + xlv*(forceqv(i,k)+(qv(i,k)-qv2di(i,k))/dt) +! tshall(i,k)=t(i,k) +! qshall(i,k)=qv(i,k) enddo - do k=kts,ktf-1 + enddo + do k= kts+1,ktf-1 do i = its,itf - omeg(i,k)= w(i,k) !-g*rhoi(i,k)*w(i,k) -! dq=(q2d(i,k+1)-q2d(i,k)) -! mconv(i)=mconv(i)+omeg(i,k)*dq/g - enddo + if((p2d(i,1)-p2d(i,k)).gt.150.and.p2d(i,k).gt.300)then + dp=-.5*(p2d(i,k+1)-p2d(i,k-1)) + umean(i)=umean(i)+us(i,k)*dp + vmean(i)=vmean(i)+vs(i,k)*dp + pmean(i)=pmean(i)+dp + endif enddo + enddo + do k=kts,ktf-1 do i = its,itf - if(mconv(i).lt.0.)mconv(i)=0. + omeg(i,k)= w(i,k) !-g*rhoi(i,k)*w(i,k) +! dq=(q2d(i,k+1)-q2d(i,k)) +! mconv(i)=mconv(i)+omeg(i,k)*dq/g enddo + enddo + do i = its,itf + if(mconv(i).lt.0.)mconv(i)=0. + enddo ! !---- call cumulus parameterization ! if(ishallow_g3.eq.1)then -! + do i=its,ite ierrs(i)=0 ierrm(i)=0 @@ -499,14 +489,13 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & ! !> - Call shallow: cu_gf_sh_run() ! - ! print*,'hli bf shallow t2d',t2d call cu_gf_sh_run (us,vs, & ! input variables, must be supplied zo,t2d,q2d,ter11,tshall,qshall,p2d,psur,dhdt,kpbli, & - rhoi,hfx,qfx,xlandi,ichoice_s,tcrit,dt, & + rhoi,hfx,qfx,xlandi,ichoice_s,tcrit,dt, & ! input variables. ierr should be initialized to zero or larger than zero for ! turning off shallow convection for grid points - zus,xmbs,kbcons,ktops,k22s,ierrs,ierrcs, & + zus,xmbs,kbcons,ktops,k22s,ierrs,ierrcs, & ! output tendencies outts,outqs,outqcs,outus,outvs,cnvwt,prets,cupclws, & ! dimesnional variables @@ -524,8 +513,8 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & ipr=0 jpr_deep=0 !340765 !> - Call cu_gf_deep_run() for middle GF convection - if(imid_gf == 1)then - call cu_gf_deep_run( & + if(imid_gf == 1)then + call cu_gf_deep_run( & itf,ktf,its,ite, kts,kte & ,dicycle_m & ,ichoicem & @@ -594,16 +583,16 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & ,jminm,tropics) do i=its,itf - do k=kts,ktf + do k=kts,ktf qcheck(i,k)=qv(i,k) +outqs(i,k)*dt - enddo + enddo enddo !> - Call neg_check() for middle GF convection call neg_check('mid',ipn,dt,qcheck,outqm,outtm,outum,outvm, & outqcm,pretm,its,ite,kts,kte,itf,ktf,ktopm) - endif + endif !> - Call cu_gf_deep_run() for deep GF convection - if(ideep.eq.1)then + if(ideep.eq.1)then call cu_gf_deep_run( & itf,ktf,its,ite, kts,kte & @@ -673,15 +662,15 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & #endif ,k22 & ,jmin,tropics) - jpr=0 - ipr=0 - do i=its,itf - do k=kts,ktf - qcheck(i,k)=qv(i,k) +(outqs(i,k)+outqm(i,k))*dt - enddo - enddo + jpr=0 + ipr=0 + do i=its,itf + do k=kts,ktf + qcheck(i,k)=qv(i,k) +(outqs(i,k)+outqm(i,k))*dt + enddo + enddo !> - Call neg_check() for deep GF convection - call neg_check('deep',ipn,dt,qcheck,outq,outt,outu,outv, & + call neg_check('deep',ipn,dt,qcheck,outq,outt,outu,outv, & outqc,pret,its,ite,kts,kte,itf,ktf,ktop) ! endif @@ -730,6 +719,11 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & enddo ! do i=its,itf + massflx(:)=0. + trcflx_in1(:)=0. + clw_in1(:)=0. + clw_ten1(:)=0. + po_cup(:)=0. kstop=kts if(ktopm(i).gt.kts .or. ktop(i).gt.kts)kstop=max(ktopm(i),ktop(i)) if(ktops(i).gt.kts)kstop=max(kstop,ktops(i)) @@ -738,7 +732,8 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & if(kbcon(i).gt.2 .or. kbconm(i).gt.2)then hbot(i)=max(kbconm(i),kbcon(i)) !jmin(i) endif -!kbcon(i) + + dtime_max=dt do k=kts,kstop cnvc(i,k) = 0.04 * log(1. + 675. * zu(i,k) * xmb(i)) + & 0.04 * log(1. + 675. * zum(i,k) * xmbm(i)) + & @@ -754,66 +749,117 @@ subroutine cu_gf_driver_run(garea,im,ix,km,dt,cactiv, & us(i,k)=us(i,k)+outu(i,k)*cuten(i)*dt +outum(i,k)*cutenm(i)*dt +outus(i,k)*cutens(i)*dt vs(i,k)=vs(i,k)+outv(i,k)*cuten(i)*dt +outvm(i,k)*cutenm(i)*dt +outvs(i,k)*cutens(i)*dt -!hj 10/11/2016: don't need gdc and gdc2 yet for gsm. -!hli 08/18/2017: couple gdc to radiation - gdc(i,k,1)= max(0.,tun_rad_shall(i)*cupclws(i,k)*cutens(i)) ! my mod + gdc(i,k,1)= max(0.,tun_rad_shall(i)*cupclws(i,k)*cutens(i)) ! my mod gdc2(i,k,1)=max(0.,tun_rad_deep(i)*(cupclwm(i,k)*cutenm(i)+cupclw(i,k)*cuten(i))) gdc(i,k,2)=(outt(i,k))*86400. gdc(i,k,3)=(outtm(i,k))*86400. gdc(i,k,4)=(outts(i,k))*86400. gdc(i,k,7)=-(gdc(i,k,7)-sqrt(us(i,k)**2 +vs(i,k)**2))/dt - !gdc(i,k,8)=(outq(i,k))*86400.*xlv/cp + !gdc(i,k,8)=(outq(i,k))*86400.*xlv/cp gdc(i,k,8)=(outqm(i,k)+outqs(i,k)+outq(i,k))*86400.*xlv/cp gdc(i,k,9)=gdc(i,k,2)+gdc(i,k,3)+gdc(i,k,4) - if((gdc(i,k,1).ge.0.5).or.(gdc2(i,k,1).ge.0.5))then - print*,'hli gdc(i,k,1),gdc2(i,k,1)',gdc(i,k,1),gdc2(i,k,1) - endif ! !> - Calculate subsidence effect on clw ! - dsubclw=0. - dsubclwm=0. - dsubclws=0. +! dsubclw=0. +! dsubclwm=0. +! dsubclws=0. +! dp=100.*(p2d(i,k)-p2d(i,k+1)) +! if (clcw(i,k) .gt. -999.0 .and. clcw(i,k+1) .gt. -999.0 )then +! clwtot = cliw(i,k) + clcw(i,k) +! clwtot1= cliw(i,k+1) + clcw(i,k+1) +! dsubclw=((-edt(i)*zd(i,k+1)+zu(i,k+1))*clwtot1 & +! -(-edt(i)*zd(i,k) +zu(i,k)) *clwtot )*g/dp +! dsubclwm=((-edtm(i)*zdm(i,k+1)+zum(i,k+1))*clwtot1 & +! -(-edtm(i)*zdm(i,k) +zum(i,k)) *clwtot )*g/dp +! dsubclws=(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp +! dsubclw=dsubclw+(zu(i,k+1)*clwtot1-zu(i,k)*clwtot)*g/dp +! dsubclwm=dsubclwm+(zum(i,k+1)*clwtot1-zum(i,k)*clwtot)*g/dp +! dsubclws=dsubclws+(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp +! endif +! tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) & +! +outqcm(i,k)*cutenm(i) & +! +dsubclw*xmb(i)+dsubclws*xmbs(i)+dsubclwm*xmbm(i) & +! ) +! tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf)) +! if (clcw(i,k) .gt. -999.0) then +! cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice +! clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water +! else +! cliw(i,k) = max(0.,cliw(i,k) + tem) +! endif +! +! enddo + +!> - FCT treats subsidence effect to cloud ice/water (begin) dp=100.*(p2d(i,k)-p2d(i,k+1)) + dtime_max=min(dtime_max,.5*dp) + po_cup(k)=.5*(p2d(i,k)+p2d(i,k+1)) if (clcw(i,k) .gt. -999.0 .and. clcw(i,k+1) .gt. -999.0 )then clwtot = cliw(i,k) + clcw(i,k) + if(clwtot.lt.1.e-32)clwtot=0. clwtot1= cliw(i,k+1) + clcw(i,k+1) - dsubclw=((-edt(i)*zd(i,k+1)+zu(i,k+1))*clwtot1 & - -(-edt(i)*zd(i,k) +zu(i,k)) *clwtot )*g/dp - dsubclwm=((-edtm(i)*zdm(i,k+1)+zum(i,k+1))*clwtot1 & - -(-edtm(i)*zdm(i,k) +zum(i,k)) *clwtot )*g/dp - dsubclws=(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp - dsubclw=dsubclw+(zu(i,k+1)*clwtot1-zu(i,k)*clwtot)*g/dp - dsubclwm=dsubclwm+(zum(i,k+1)*clwtot1-zum(i,k)*clwtot)*g/dp - dsubclws=dsubclws+(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp + if(clwtot1.lt.1.e-32)clwtot1=0. + clw_in1(k)=clwtot + massflx(k)=-(xmb(i) *( zu(i,k)- edt(i)* zd(i,k))) & + -(xmbm(i)*(zdm(i,k)-edtm(i)*zdm(i,k))) & + -(xmbs(i)*zus(i,k)) + trcflx_in1(k)=massflx(k)*.5*(clwtot+clwtot1) endif - tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) & + enddo + + massflx (1)=0. + trcflx_in1(1)=0. + call fct1d3 (kstop,kte,dtime_max,po_cup, & + clw_in1,massflx,trcflx_in1,clw_ten1,g) + + do k=1,kstop + tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) & +outqcm(i,k)*cutenm(i) & -! +dsubclw*xmb(i)+dsubclws*xmbs(i)+dsubclwm*xmbm(i) & - ) + +clw_ten1(k) & + ) tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf)) if (clcw(i,k) .gt. -999.0) then cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water - else + else cliw(i,k) = max(0.,cliw(i,k) + tem) - endif + endif - enddo - gdc(i,1,10)=forcing(i,1) - gdc(i,2,10)=forcing(i,2) - gdc(i,3,10)=forcing(i,3) - gdc(i,4,10)=forcing(i,4) - gdc(i,5,10)=forcing(i,5) - gdc(i,6,10)=forcing(i,6) - gdc(i,7,10)=forcing(i,7) - gdc(i,8,10)=forcing(i,8) - gdc(i,10,10)=xmb(i) - gdc(i,11,10)=xmbm(i) - gdc(i,12,10)=xmbs(i) - gdc(i,13,10)=hfx(i) - gdc(i,15,10)=qfx(i) - gdc(i,16,10)=pret(i)*3600. +! +!> calculate cloud water and cloud ice number concentrations +! + rho_dryar(i,k) = p2di(i,k)/(con_rd*t(i,k)) ! Density of dry air in kg m-3 + if (imp_physics == imp_physics_thompson) then + if ((tem*tem1)>1.e-5) then + gq0(i,k,ntinc) = max(0., gq0(i,k,ntinc) + & + make_IceNumber(tem*tem1*rho_dryar(i,k), t(i,k)) * & + (1/rho_dryar(i,k))) + end if + if ((tem*(1-tem1))>1.e-5) then + gq0(i,k,ntlnc) = max(0., gq0(i,k,ntlnc) + & + make_DropletNumber(tem*(1-tem1)*rho_dryar(i,k), nwfa(i,k)) & + * (1/rho_dryar(i,k))) + end if + end if + + enddo + + + gdc(i,1,10)=forcing(i,1) + gdc(i,2,10)=forcing(i,2) + gdc(i,3,10)=forcing(i,3) + gdc(i,4,10)=forcing(i,4) + gdc(i,5,10)=forcing(i,5) + gdc(i,6,10)=forcing(i,6) + gdc(i,7,10)=forcing(i,7) + gdc(i,8,10)=forcing(i,8) + gdc(i,10,10)=xmb(i) + gdc(i,11,10)=xmbm(i) + gdc(i,12,10)=xmbs(i) + gdc(i,13,10)=hfx(i) + gdc(i,15,10)=qfx(i) + gdc(i,16,10)=pret(i)*3600. if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i)) endif enddo diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 1969f9464..d3687a352 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -44,6 +44,14 @@ [ccpp-arg-table] name = cu_gf_driver_run type = scheme +[ntracer] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F [garea] standard_name = cell_area long_name = grid cell area @@ -350,6 +358,65 @@ type = integer intent = in optional = F +[nwfa] + standard_name = water_friendly_aerosol_number_concentration + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + 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 +[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 = inout + 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 +[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 +[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_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + 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/module_MYNNrad_post.F90 b/physics/module_MYNNrad_post.F90 index 7acd2e406..1364db62e 100644 --- a/physics/module_MYNNrad_post.F90 +++ b/physics/module_MYNNrad_post.F90 @@ -22,6 +22,7 @@ end subroutine mynnrad_post_finalize #endif SUBROUTINE mynnrad_post_run( & & ix,im,levs, & + & flag_init,flag_restart, & & qc,qi, & & qc_save, qi_save, & & errmsg, errflg ) @@ -34,6 +35,7 @@ SUBROUTINE mynnrad_post_run( & !------------------------------------------------------------------- integer, intent(in) :: ix, im, levs + logical, intent(in) :: flag_init, flag_restart real(kind=kind_phys), dimension(im,levs), intent(out) :: qc, qi real(kind=kind_phys), dimension(im,levs), intent(in) :: qc_save, qi_save character(len=*), intent(out) :: errmsg @@ -48,6 +50,11 @@ SUBROUTINE mynnrad_post_run( & !write(0,*)"==============================================" !write(0,*)"in mynn rad post" + if (flag_init .and. (.not. flag_restart)) then + !write (0,*) 'Skip MYNNrad_post flag_init = ', flag_init + return + endif + ! Add subgrid cloud information: do k = 1, levs do i = 1, im diff --git a/physics/module_MYNNrad_post.meta b/physics/module_MYNNrad_post.meta index b09abe01e..881a19fff 100644 --- a/physics/module_MYNNrad_post.meta +++ b/physics/module_MYNNrad_post.meta @@ -25,6 +25,22 @@ type = integer intent = in optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) diff --git a/physics/module_MYNNrad_pre.F90 b/physics/module_MYNNrad_pre.F90 index 858abebee..95dc95445 100644 --- a/physics/module_MYNNrad_pre.F90 +++ b/physics/module_MYNNrad_pre.F90 @@ -32,6 +32,7 @@ end subroutine mynnrad_pre_finalize !###=================================================================== SUBROUTINE mynnrad_pre_run( & & ix,im,levs, & + & flag_init,flag_restart, & & qc, qi, T3D, & & qc_save, qi_save, & & qc_bl,cldfra_bl, & @@ -50,6 +51,7 @@ SUBROUTINE mynnrad_pre_run( & ! Interface variables real (kind=kind_phys), parameter :: gfac=1.0e5/con_g integer, intent(in) :: ix, im, levs + logical, intent(in) :: flag_init, flag_restart real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc, qi real(kind=kind_phys), dimension(im,levs), intent(in) :: T3D,delp real(kind=kind_phys), dimension(im,levs), intent(inout) :: & @@ -71,13 +73,17 @@ SUBROUTINE mynnrad_pre_run( & !write(0,*)"==============================================" !write(0,*)"in mynn rad pre" + if (flag_init .and. (.not. flag_restart)) then + !write (0,*) 'Skip MYNNrad_pre flag_init = ', flag_init + return + endif ! Add subgrid cloud information: do k = 1, levs do i = 1, im qc_save(i,k) = qc(i,k) qi_save(i,k) = qi(i,k) - clouds1(i,k)=CLDFRA_BL(i,k) + clouds1(i,k) = CLDFRA_BL(i,k) IF (qc(i,k) < 1.E-6 .AND. qi(i,k) < 1.E-8 .AND. CLDFRA_BL(i,k)>0.001) THEN !Partition the BL clouds into water & ice according to a linear diff --git a/physics/module_MYNNrad_pre.meta b/physics/module_MYNNrad_pre.meta index 617ee3f31..3b5943c66 100644 --- a/physics/module_MYNNrad_pre.meta +++ b/physics/module_MYNNrad_pre.meta @@ -25,6 +25,22 @@ type = integer intent = in optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index ea5800736..7345f2667 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -67,7 +67,7 @@ SUBROUTINE LSMRUC( & Z3D,P8W,T3D,QV3D,QC3D,RHO3D, & GLW,GSW,EMISS,CHKLOWQ, CHS, & FLQC,FLHC,MAVAIL,CANWAT,VEGFRA,ALB,ZNT, & - Z0,SNOALB,ALBBCK, & !Z0,SNOALB,ALBBCK,LAI, & + Z0,SNOALB,ALBBCK,LAI, & landusef, nlcat, & ! mosaic_lu, mosaic_soil, & soilctop, nscat, & QSFC,QSG,QVG,QCG,DEW,SOILT1,TSNAV, & @@ -218,6 +218,7 @@ SUBROUTINE LSMRUC( & CANWAT, & ! new SNOALB, & ALB, & + LAI, & EMISS, & MAVAIL, & SFCEXC, & @@ -269,7 +270,6 @@ SUBROUTINE LSMRUC( & PC, & SFCRUNOFF, & UDRUNOFF, & - LAI, & EMISSL, & ZNTL, & LMAVAIL, & @@ -431,8 +431,8 @@ SUBROUTINE LSMRUC( & !! or ~100 mm of snow height ! ! snowc(i,j) = min(1.,snow(i,j)/32.) - soilt1(i,j)=soilt(i,j) - if(snow(i,j).le.32.) soilt1(i,j)=tso(i,1,j) +! soilt1(i,j)=soilt(i,j) +! if(snow(i,j).le.32.) soilt1(i,j)=tso(i,1,j) !> - Initializing inside snow temp if it is not defined IF((soilt1(i,j) .LT. 170.) .or. (soilt1(i,j) .GT.400.)) THEN IF(snow(i,j).gt.32.) THEN @@ -450,7 +450,9 @@ SUBROUTINE LSMRUC( & patmb=P8w(i,kms,j)*1.e-2 QSG (i,j) = QSN(SOILT(i,j),TBQ)/PATMB IF((qvg(i,j) .LE. 0.) .or. (qvg(i,j) .GT.0.1)) THEN - qvg (i,j) = QSG(i,j)*mavail(i,j) + !17sept19 - bad approximation with very low mavail. + !qvg(i,j) = QSG(i,j)*mavail(i,j) + qvg (i,j) = qv3d(i,1,j) IF (debug_print ) THEN print *, & 'QVG is initialized in RUCLSM ', qvg(i,j),mavail(i,j),qsg(i,j),i,j @@ -751,7 +753,7 @@ SUBROUTINE LSMRUC( & meltfactor = 0.85 do k=2,nzs - if(zsmain(k).ge.1.0) then + if(zsmain(k).ge.1.1) then NROOT=K goto 111 endif diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index fe12b5e17..02061079e 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -139,11 +139,11 @@ end subroutine lsm_ruc_finalize ! DH* TODO - make order of arguments the same as in the metadata table subroutine lsm_ruc_run & ! inputs & ( iter, me, master, kdt, im, nlev, lsoil_ruc, lsoil, zs, & - & t1, q1, qc, soiltyp, vegtype, sigmaf, & + & t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, & & sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & & prsl1, zf, wind, shdmin, shdmax, alvwf, alnwf, & & snoalb, sfalb, flag_iter, flag_guess, isot, ivegsrc, fice, & - & smc, stc, slc, lsm_ruc, lsm, land, islimsk, & + & smc, stc, slc, lsm_ruc, lsm, land, islimsk, rdlai, & & imp_physics, imp_physics_gfdl, imp_physics_thompson, & & smcwlt2, smcref2, do_mynnsfclay, & & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, con_fvirt,& ! constants @@ -178,6 +178,8 @@ subroutine lsm_ruc_run & ! inputs & ch, prsl1, wind, shdmin, shdmax, & & snoalb, alvwf, alnwf, zf, qc, q1 + real (kind=kind_phys), dimension(:), intent(in) :: laixy + real (kind=kind_phys), intent(in) :: delt real (kind=kind_phys), intent(in) :: con_cp, con_rv, con_g, & con_pi, con_rd, & @@ -187,6 +189,8 @@ subroutine lsm_ruc_run & ! inputs integer, dimension(im), intent(in) :: islimsk ! sea/land/ice mask (=0/1/2) logical, intent(in) :: do_mynnsfclay + logical, intent(in) :: rdlai + ! --- in/out: integer, dimension(im), intent(inout) :: soiltyp, vegtype real (kind=kind_phys), dimension(lsoil_ruc) :: dzs @@ -317,6 +321,8 @@ subroutine lsm_ruc_run & ! inputs zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out me, master, errmsg, errflg) + xlai = 0. + endif ! flag_init=.true.,iter=1 !-- end of initialization @@ -508,10 +514,10 @@ subroutine lsm_ruc_run & ! inputs ffrozp(i,j) = real(nint(srflag(i)),kind_phys) endif - !tgs - for now set rdlai2d to .false., WRF has LAI maps, and RUC LSM - ! uses rdlai2d = .true. - rdlai2d = .false. - !if( .not. rdlai2d) xlai = lai_data(vtype) + !tgs - rdlai is .false. when the LAI data is not available in the + ! - INPUT/sfc_data.nc + + rdlai2d = rdlai conflx2(i,1,j) = zf(i) * 2. ! factor 2. is needed to get the height of ! atm. forcing inside RUC LSM (inherited @@ -552,13 +558,15 @@ subroutine lsm_ruc_run & ! inputs !prcp(i,j) = rhoh2o * tprcp(i) ! tprcp in [m] - convective plus explicit !raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip !rainncv(i,j) = rhoh2o * max(rain(i)-rainc(i),0.0) ! total time-step explicit precip - !graupelncv(i,j) = rhoh2o * graupel(i) - !snowncv(i,j) = rhoh2o * snow(i) - prcp(i,j) = rhoh2o * (rainc(i)+rainnc(i)) ! tprcp in [m] - convective plus explicit - raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip - rainncv(i,j) = rhoh2o * rainnc(i) ! total time-step explicit precip + prcp(i,j) = rhoh2o * (rainc(i)+rainnc(i)) ! [mm] - convective plus explicit + raincv(i,j) = rhoh2o * rainc(i) ! [mm] - total time-step convective precip + rainncv(i,j) = rhoh2o * rainnc(i) ! [mm] - total time-step explicit precip graupelncv(i,j) = rhoh2o * graupel(i) snowncv(i,j) = rhoh2o * snow(i) + !if(prcp(i,j) > 0. .and. i==21) then + !print *,'prcp(i,j),rainncv(i,j),graupelncv(i,j),snowncv(i,j),ffrozp(i,j)',i,j, & + ! prcp(i,j),rainncv(i,j),graupelncv(i,j),snowncv(i,j),ffrozp(i,j) + !endif ! ice not used ! precipfr(i,j) = rainncv(i,j) * ffrozp(i,j) @@ -601,6 +609,8 @@ subroutine lsm_ruc_run & ! inputs albbck(i,j) = max(0.01, 0.5 * (alvwf(i) + alnwf(i))) alb(i,j) = sfalb(i) + if(rdlai2d) xlai(i,j) = laixy(i) + tbot(i,j) = tg3(i) !> - 4. history (state) variables (h): @@ -686,7 +696,7 @@ subroutine lsm_ruc_run & ! inputs znt(i,j) = zorl(i)/100. if(debug_print) then - !if(me==0 .and. i==ipr) then + if(me==0 .and. i==ipr) then write (0,*)'before RUC smsoil = ',smsoil(i,:,j), i,j write (0,*)'stsoil = ',stsoil(i,:,j), i,j write (0,*)'soilt = ',soilt(i,j), i,j @@ -780,7 +790,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'shdmin1d(i,j) =',i,j,shdmin1d(i,j) write (0,*)'shdmax1d(i,j) =',i,j,shdmax1d(i,j) write (0,*)'rdlai2d =',rdlai2d - !endif + endif endif !> - Call RUC LSM lsmruc(). @@ -796,8 +806,7 @@ subroutine lsm_ruc_run & ! inputs & chs(i,j), flqc(i,j), flhc(i,j), & ! --- input/outputs: & wet(i,j), cmc(i,j), shdfac(i,j), alb(i,j), znt(i,j), & - & z0(i,j), snoalb1d(i,j), albbck(i,j), & -! & z0, snoalb1d, alb, xlai, & + & z0(i,j), snoalb1d(i,j), albbck(i,j), xlai(i,j), & & landusef(i,:,j), nlcat, & ! --- mosaic_lu and mosaic_soil are moved to the namelist ! & mosaic_lu, mosaic_soil, & @@ -820,6 +829,7 @@ subroutine lsm_ruc_run & ! inputs & its,ite, jts,jte, kts,kte ) if(debug_print) then + !if(me==0 .and. i==ipr) then write (0,*)'after sneqv(i,j) =',i,j,sneqv(i,j) write (0,*)'after snowh(i,j) =',i,j,snowh(i,j) write (0,*)'after sncovr(i,j) =',i,j,sncovr(i,j) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index dac459405..3ae9a57a3 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -198,6 +198,12 @@ type = integer intent = in optional = F +[rdlai] + standard_name = flag_for_reading_leaf_area_index_from_input + long_name = flag for reading leaf area index from initial conditions for RUC LSM + units = flag + dimensions = () + type = logical [zs] standard_name = depth_of_soil_levels_for_land_surface_model long_name = depth of soil levels for land surface model @@ -529,6 +535,14 @@ kind = kind_phys intent = in optional = F +[laixy] + standard_name = leaf_area_index + long_name = leaf area index + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + optional = F [sfalb] standard_name = surface_diffused_shortwave_albedo long_name = mean surface diffused sw albedo From 988e95a37bd4ea3fa1b420107bcf02c3ed397bd3 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 26 Nov 2019 11:52:21 -0700 Subject: [PATCH 42/84] physics/GFS_suite_interstitial.*: use new imfdeepcnv_gf parameter instead of hard-coded number 3 --- physics/GFS_suite_interstitial.F90 | 10 +++++----- physics/GFS_suite_interstitial.meta | 24 ++++++++++++++++-------- 2 files changed, 21 insertions(+), 13 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 20f51f99c..1e8545e98 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -659,10 +659,10 @@ end subroutine GFS_suite_interstitial_4_finalize !> \section arg_table_GFS_suite_interstitial_4_run Argument Table !! \htmlinclude GFS_suite_interstitial_4_run.html !! - subroutine GFS_suite_interstitial_4_run (imfdeepcnv, im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, & + 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, imfdeepcnv, imfdeepcnv_gf, errmsg, errflg) use machine, only: kind_phys @@ -670,9 +670,9 @@ subroutine GFS_suite_interstitial_4_run (imfdeepcnv, im, levs, ltaerosol, cplchm ! interface variables - integer, intent(in) :: imfdeepcnv, im, levs, tracers_total, ntrac, ntcw, ntiw, ntclamt, ntrw, & + 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, imfdeepcnv, imfdeepcnv_gf logical, intent(in) :: ltaerosol, cplchm @@ -737,7 +737,7 @@ subroutine GFS_suite_interstitial_4_run (imfdeepcnv, im, levs, ltaerosol, cplchm enddo enddo ! if (imp_physics == imp_physics_thompson) then - if (imp_physics == imp_physics_thompson .and. imfdeepcnv /= 3) then + if (imp_physics == imp_physics_thompson .and. imfdeepcnv /= imfdeepcnv_gf) then if (ltaerosol) then do k=1,levs do i=1,im diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 2fa377c00..e6e349a2a 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1454,14 +1454,6 @@ [ccpp-arg-table] name = GFS_suite_interstitial_4_run type = scheme -[imfdeepcnv] - standard_name = flag_for_mass_flux_deep_convection_scheme - long_name = flag for mass-flux deep convection scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -1709,6 +1701,22 @@ kind = kind_phys intent = inout optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_gf] + standard_name = flag_for_gf_deep_convection_scheme + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 17f585a070cf266859622d18a04cd0106384bf12 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 26 Nov 2019 11:53:00 -0700 Subject: [PATCH 43/84] physics/drag_suite.F90: bugfix, initialize rstoch to zero (since SPP is not used) --- physics/drag_suite.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index c3da28334..269bf0b3a 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -596,6 +596,7 @@ subroutine drag_suite_run( & olss(i) = 0.0 ulow (i) = 0.0 dtfac(i) = 1.0 + rstoch(i) = 0.0 ldrag(i) = .false. icrilv(i) = .false. flag(i) = .true. From 80edd7812cfa70db0c589026a0a65f2cba1b81a9 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 26 Nov 2019 11:53:27 -0700 Subject: [PATCH 44/84] physics/sfc_drv_ruc.F90: remove comment line that was left mistakenly --- physics/sfc_drv_ruc.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 02061079e..3b4b8a118 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -829,7 +829,6 @@ subroutine lsm_ruc_run & ! inputs & its,ite, jts,jte, kts,kte ) if(debug_print) then - !if(me==0 .and. i==ipr) then write (0,*)'after sneqv(i,j) =',i,j,sneqv(i,j) write (0,*)'after snowh(i,j) =',i,j,snowh(i,j) write (0,*)'after sncovr(i,j) =',i,j,sncovr(i,j) From c11b6e8bf60f3d23be761b9aa4665d6611b9d7e0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 Nov 2019 14:33:06 -0700 Subject: [PATCH 45/84] Update of physics/satmedmfvdifq.F to reflect changes in IPD version --- physics/satmedmfvdifq.F | 53 +++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index c3d061a9c..546cefca6 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -196,7 +196,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & rlmn, rlmn1, rlmx, elmx, & ttend, utend, vtend, qtend, & zfac, zfmin, vk, spdk2, - & tkmin, xkzinv, xkgdx, + & tkmin, tkminx, xkzinv, xkgdx, & zlup, zldn, bsum, & tem, tem1, tem2, & ptem, ptem0, ptem1, ptem2 @@ -215,11 +215,11 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & parameter(prmin=0.25,prmax=4.0) parameter(pr0=1.0,prtke=1.0,prscu=0.67) parameter(f0=1.e-4,crbmin=0.15,crbmax=0.35) - parameter(tkmin=1.e-9,dspmax=10.0) + parameter(tkmin=1.e-9,tkminx=0.2,dspmax=10.0) parameter(qmin=1.e-8,qlmin=1.e-12,zfmin=1.e-8) parameter(aphi5=5.,aphi16=16.) parameter(elmfac=1.0,elefac=1.0,cql=100.) - parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=25000.) + parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=5000.) parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.1) parameter(h1=0.33333333) parameter(ck0=0.4,ck1=0.15,ch0=0.4,ch1=0.15) @@ -326,20 +326,20 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & xkzo(i,k) = 0.0 xkzmo(i,k) = 0.0 if (k < kinver(i)) then -! vertical background diffusivity - ptem = prsi(i,k+1) * tx1(i) - tem1 = 1.0 - ptem - tem2 = tem1 * tem1 * 10.0 - tem2 = min(1.0, exp(-tem2)) - xkzo(i,k) = xkzm_hx(i) * tem2 -! +! minimum turbulent mixing length ptem = prsl(i,k) * tx1(i) tem1 = 1.0 - ptem tem2 = tem1 * tem1 * 2.5 tem2 = min(1.0, exp(-tem2)) rlmnz(i,k)= rlmn * tem2 rlmnz(i,k)= max(rlmnz(i,k), rlmn1) -! vertical background diffusivity for momentum +! vertical background diffusivity + ptem = prsi(i,k+1) * tx1(i) + tem1 = 1.0 - ptem + tem2 = tem1 * tem1 * 10.0 + tem2 = min(1.0, exp(-tem2)) + xkzo(i,k) = xkzm_hx(i) * tem2 +! vertical background diffusivity for momentum if (ptem >= xkzm_s) then xkzmo(i,k) = xkzm_mx(i) kx1(i) = k + 1 @@ -727,20 +727,20 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! ! background diffusivity decreasing with increasing surface layer stability ! - do i = 1, im - if(.not.sfcflg(i)) then - tem = (1. + 5. * rbsoil(i))**2. -! tem = (1. + 5. * zol(i))**2. - frik(i) = 0.1 + 0.9 / tem - endif - enddo -! - do k = 1,km1 - do i=1,im - xkzo(i,k) = frik(i) * xkzo(i,k) - xkzmo(i,k)= frik(i) * xkzmo(i,k) - enddo - enddo +! do i = 1, im +! if(.not.sfcflg(i)) then +! tem = (1. + 5. * rbsoil(i))**2. +!! tem = (1. + 5. * zol(i))**2. +! frik(i) = 0.1 + 0.9 / tem +! endif +! enddo +! +! do k = 1,km1 +! do i=1,im +! xkzo(i,k) = frik(i) * xkzo(i,k) +! xkzmo(i,k)= frik(i) * xkzmo(i,k) +! enddo +! enddo ! ! The background vertical diffusivities in the inversion layers are limited ! to be less than or equal to xkzminv @@ -920,13 +920,14 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & do i = 1, im if(k == 1) then tem = ckz(i,1) - tem1 = xkzmo(i,1) + tem1 = 0.5 * xkzmo(i,1) else tem = 0.5 * (ckz(i,k-1) + ckz(i,k)) tem1 = 0.5 * (xkzmo(i,k-1) + xkzmo(i,k)) endif ptem = tem1 / (tem * elm(i,k)) tkmnz(i,k) = ptem * ptem + tkmnz(i,k) = min(tkmnz(i,k), tkminx) tkmnz(i,k) = max(tkmnz(i,k), tkmin) enddo enddo From efec724d00f92f81d7297cdc89a0b5ec5eacd18d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 29 Nov 2019 17:03:04 -0700 Subject: [PATCH 46/84] physics/drag_suite.F90: bugfix to prevent use of uninitialized variable zl, comment out unused variables --- physics/drag_suite.F90 | 44 +++++++++++++++--------------------------- 1 file changed, 16 insertions(+), 28 deletions(-) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 269bf0b3a..080bee156 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -332,11 +332,11 @@ subroutine drag_suite_run( & & hpbl(im), & & slmsk(im) real(kind=kind_phys), dimension(im) :: govrth,xland - real(kind=kind_phys), dimension(im,km) :: dz2 + !real(kind=kind_phys), dimension(im,km) :: dz2 real(kind=kind_phys) :: tauwavex0,tauwavey0, & & XNBV,density,tvcon,hpbl2 integer :: kpbl2,kvar - real(kind=kind_phys), dimension(im,km+1) :: zq ! = PHII/g + !real(kind=kind_phys), dimension(im,km+1) :: zq ! = PHII/g real(kind=kind_phys), dimension(im,km) :: zl ! = PHIL/g !SPP @@ -413,10 +413,10 @@ subroutine drag_suite_run( & ! local variables ! integer :: i,j,k,lcap,lcapp1,nwd,idir, & - klcap,kp1,ikount,kk + klcap,kp1 ! - real(kind=kind_phys) :: rcs,rclcs,csg,fdir,cleff,cleff_ss,cs, & - rcsks,wdir,ti,rdz,temp,tem2,dw2,shr2, & + real(kind=kind_phys) :: rcs,csg,fdir,cleff,cleff_ss,cs, & + rcsks,wdir,ti,rdz,tem2,dw2,shr2, & bvf2,rdelks,wtkbj,tem,gfobnv,hd,fro, & rim,temc,tem1,efact,temv,dtaux,dtauy, & dtauxb,dtauyb,eng0,eng1 @@ -442,7 +442,6 @@ subroutine drag_suite_run( & coefm(im),coefm_ss(im) ! integer :: kbl(im),klowtop(im) - logical :: iope integer,parameter :: mdir=8 !integer :: nwdir(mdir) !data nwdir/6,7,5,8,2,3,1,4/ @@ -661,6 +660,17 @@ subroutine drag_suite_run( & enddo enddo ! +! calculate mid-layer height (zl), interface height (zq), and layer depth (dz2). +! + !zq=0. + do k = kts,km + do i = its,im + !zq(i,k+1) = PHII(i,k+1)*g_inv + !dz2(i,k) = (PHII(i,k+1)-PHII(i,k))*g_inv + zl(i,k) = PHIL(i,k)*g_inv + enddo + enddo +! ! determine reference level: maximum of 2*var and pbl heights ! do i = its,im @@ -895,7 +905,6 @@ subroutine drag_suite_run( & density=1.2 utendwave=0. vtendwave=0. - zq=0. ! IF ( (gwd_opt_ss .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN if (me==master) print *,"in Drag Suite: Running small-scale gravity wave drag" @@ -914,14 +923,6 @@ subroutine drag_suite_run( & thvx(i,k) = thx(i,k)*tvcon enddo enddo - ! Calculate mid-layer height (zl), interface height (zq), and layer depth (dz2). - do k = kts,km - do i = its,im - zq(i,k+1) = PHII(i,k+1)*g_inv - dz2(i,k) = (PHII(i,k+1)-PHII(i,k))*g_inv - zl(i,k) = PHIL(i,k)*g_inv - enddo - enddo do i=its,im hpbl2 = hpbl(i)+10. @@ -1027,19 +1028,6 @@ subroutine drag_suite_run( & utendform=0. vtendform=0. - zq=0. - - IF ( (gwd_opt_ss .NE. 1).and.(ss_taper.GT.1.E-02) ) THEN - ! Defining mid-layer height (zl), interface height (zq), and layer depth (dz2). - ! This is already done above if the small-scale GWD is activated. - do k = kts,km - do i = its,im - zq(i,k+1) = PHII(i,k+1)*g_inv - dz2(i,k) = (PHII(i,k+1)-PHII(i,k))*g_inv - zl(i,k) = PHIL(i,k)*g_inv - enddo - enddo - ENDIF DO i=its,im IF ((xland(i)-1.5) .le. 0.) then From 308a1974745b673ff6095b528bd3e35aebe5448c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 2 Dec 2019 10:31:26 -0700 Subject: [PATCH 47/84] Thompson MP: improve diagnostic messages for negative qv/qr/qs/... and tendency limiter, bugfix for calculating number concentrations --- physics/module_mp_thompson.F90 | 16 ++++++++-------- ...e_mp_thompson_make_number_concentrations.F90 | 17 ++++++++++++++++- physics/mp_thompson_post.F90 | 10 ++++++---- physics/mp_thompson_post.meta | 8 ++++++++ 4 files changed, 38 insertions(+), 13 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 27552d9aa..b1ca6ba07 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1302,7 +1302,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qc = k qc_max = qc1d(k) elseif (qc1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qc ', qc1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qc ', qc1d(k), & ' at i,j,k=', i,j,k endif if (qr1d(k) .gt. qr_max) then @@ -1311,7 +1311,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qr = k qr_max = qr1d(k) elseif (qr1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qr ', qr1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qr ', qr1d(k), & ' at i,j,k=', i,j,k endif if (nr1d(k) .gt. nr_max) then @@ -1320,7 +1320,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_nr = k nr_max = nr1d(k) elseif (nr1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative nr ', nr1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative nr ', nr1d(k), & ' at i,j,k=', i,j,k endif if (qs1d(k) .gt. qs_max) then @@ -1329,7 +1329,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qs = k qs_max = qs1d(k) elseif (qs1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qs ', qs1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qs ', qs1d(k), & ' at i,j,k=', i,j,k endif if (qi1d(k) .gt. qi_max) then @@ -1338,7 +1338,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qi = k qi_max = qi1d(k) elseif (qi1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qi ', qi1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qi ', qi1d(k), & ' at i,j,k=', i,j,k endif if (qg1d(k) .gt. qg_max) then @@ -1347,7 +1347,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qg = k qg_max = qg1d(k) elseif (qg1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qg ', qg1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qg ', qg1d(k), & ' at i,j,k=', i,j,k endif if (ni1d(k) .gt. ni_max) then @@ -1356,11 +1356,11 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_ni = k ni_max = ni1d(k) elseif (ni1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative ni ', ni1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative ni ', ni1d(k), & ' at i,j,k=', i,j,k endif if (qv1d(k) .lt. 0.0) then - write(*,*) 'WARNING, negative qv ', qv1d(k), & + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qv ', qv1d(k), & ' at i,j,k=', i,j,k if (k.lt.kte-2 .and. k.gt.kts+1) then write(*,*) ' below and above are: ', qv(i,k-1,j), qv(i,k+1,j) diff --git a/physics/module_mp_thompson_make_number_concentrations.F90 b/physics/module_mp_thompson_make_number_concentrations.F90 index ef6779a67..b31753aa2 100644 --- a/physics/module_mp_thompson_make_number_concentrations.F90 +++ b/physics/module_mp_thompson_make_number_concentrations.F90 @@ -79,6 +79,11 @@ elemental real function make_IceNumber (Q_ice, temp) 161.503, 168.262, 175.248, 182.473, 189.952, 197.699, & 205.728, 214.055, 222.694, 231.661, 240.971, 250.639 /) + if (Q_ice == 0) then + make_IceNumber = 0 + return + end if + !+---+-----------------------------------------------------------------+ !..From the model 3D temperature field, subtract 179K for which !.. index value of retab as a start. Value of corr is for @@ -133,6 +138,11 @@ elemental real function make_DropletNumber (Q_cloud, qnwfa) real:: q_nwfa, x1, xDc integer:: nu_c + if (Q_cloud == 0) then + make_DropletNumber = 0 + return + end if + !+---+ q_nwfa = MAX(99.E6, MIN(qnwfa,5.E10)) @@ -160,6 +170,11 @@ elemental real function make_RainNumber (Q_rain, temp) !real, parameter:: PI = 3.1415926536 real, parameter:: am_r = PI*1000./6. + if (Q_rain == 0) then + make_RainNumber = 0 + return + end if + !+---+-----------------------------------------------------------------+ !.. Not thrilled with it, but set Y-intercept parameter to Marshal-Palmer value !.. that basically assumes melting snow becomes typical rain. However, for @@ -172,7 +187,7 @@ elemental real function make_RainNumber (Q_rain, temp) N0 = 8.E6 if (temp .le. 271.15) then - N0 = 8.E8 + N0 = 8.E8 elseif (temp .gt. 271.15 .and. temp.lt.273.15) then N0 = 8. * 10**(279.15-temp) endif diff --git a/physics/mp_thompson_post.F90 b/physics/mp_thompson_post.F90 index a21f668ec..feb031a3e 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/mp_thompson_post.F90 @@ -67,7 +67,7 @@ end subroutine mp_thompson_post_init !! #endif subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & - mpicomm, mpirank, mpiroot, errmsg, errflg) + kdt, mpicomm, mpirank, mpiroot, errmsg, errflg) implicit none @@ -78,6 +78,7 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & real(kind_phys), dimension(1:ncol,1:nlev), intent(inout) :: tgrs real(kind_phys), dimension(1:ncol,1:nlev), intent(in) :: prslk real(kind_phys), intent(in) :: dtp + integer, intent(in) :: kdt ! MPI information integer, intent(in ) :: mpicomm integer, intent(in ) :: mpirank @@ -115,8 +116,8 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then #ifdef DEBUG - write(0,*) "mp_thompson_post_run mp_tend limiter: i, k, t_old, t_new, t_lim:", & - & i, k, tgrs_save(i,k), tgrs(i,k), tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) + write(0,'(a,3i6,3e16.7)') "mp_thompson_post_run mp_tend limiter: kdt, i, k, t_old, t_new, t_lim:", & + & kdt, i, k, tgrs_save(i,k), tgrs(i,k), tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) #endif events = events + 1 end if @@ -125,7 +126,8 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & end do if (events > 0) then - write(0,'(a,i0,a,i0,a)') "mp_thompson_post_run: mp_tend_lim applied ", events, "/", nlev*ncol, " times" + write(0,'(a,i0,a,i0,a,i0)') "mp_thompson_post_run: mp_tend_lim applied ", events, "/", nlev*ncol, & + & " times at timestep ", kdt end if end subroutine mp_thompson_post_run diff --git a/physics/mp_thompson_post.meta b/physics/mp_thompson_post.meta index f1df2dd35..0f3cc6189 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/mp_thompson_post.meta @@ -92,6 +92,14 @@ kind = kind_phys 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 [mpicomm] standard_name = mpi_comm long_name = MPI communicator From e3131e42bd9d1acf20a926c86f560d9c9b166321 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Mon, 2 Dec 2019 15:56:34 -0700 Subject: [PATCH 48/84] add preprocessor directive around MPI_BCAST statements for non-MPI compilation --- physics/module_MP_FER_HIRES.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/module_MP_FER_HIRES.F90 index 67d446044..a736c640f 100644 --- a/physics/module_MP_FER_HIRES.F90 +++ b/physics/module_MP_FER_HIRES.F90 @@ -2489,7 +2489,9 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS) write(0,*)'FERRIER_INIT_hr: Can not find unused fortran ' & ,'unit to read in lookup tables' write(0,*)' ABORTING!' +#ifdef MPI call MPI_ABORT(MPI_COMM_COMP, rc, IRTN) +#endif ENDIF ENDIF ! @@ -2512,6 +2514,7 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS) CLOSE (etampnew_unit1) ENDIF ! +#ifdef MPI CALL MPI_BCAST(VENTR1,SIZE(VENTR1),MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VENTR2,SIZE(VENTR2),MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(ACCRR,SIZE(ACCRR) ,MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) @@ -2524,6 +2527,7 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS) CALL MPI_BCAST(MASSI,SIZE(MASSI) ,MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VSNOWI,SIZE(VSNOWI),MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VEL_RF,SIZE(VEL_RF),MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) +#endif ! !--- Calculates coefficients for growth rates of ice nucleated in water ! saturated conditions, scaled by physics time step (lookup table) From e989adcc99a3029b2d56a86996a66d682ada9d0a Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 3 Dec 2019 11:36:30 -0700 Subject: [PATCH 49/84] replace MPI_ABORT in physics/module_MP_FER_HIRES.F90 with setting CCPP errmsg and errflg --- physics/module_MP_FER_HIRES.F90 | 26 ++++++++++++++------------ physics/mp_fer_hires.F90 | 2 +- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/module_MP_FER_HIRES.F90 index a736c640f..23a2de7d7 100644 --- a/physics/module_MP_FER_HIRES.F90 +++ b/physics/module_MP_FER_HIRES.F90 @@ -2395,7 +2395,8 @@ END SUBROUTINE EGCP01COLUMN_hr !----------------------------------------------------------------------- !>\ingroup hafs_famp - SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS) + SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS, & + errmsg,errflg) !----------------------------------------------------------------------- !------------------------------------------------------------------------------- !--- SUBPROGRAM DOCUMENTATION BLOCK @@ -2448,11 +2449,13 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS) INTEGER, PARAMETER :: MDR1=XMR1, MDR2=XMR2, MDR3=XMR3 ! ! VARIABLES PASSED IN - real,INTENT(IN) :: GSMDT - INTEGER, INTENT(IN) :: MYPE - INTEGER, INTENT(IN) :: MPIROOT - INTEGER, INTENT(IN) :: MPI_COMM_COMP - INTEGER, INTENT(IN) :: THREADS + REAL, INTENT(IN) :: GSMDT + INTEGER, INTENT(IN) :: MYPE + INTEGER, INTENT(IN) :: MPIROOT + INTEGER, INTENT(IN) :: MPI_COMM_COMP + INTEGER, INTENT(IN) :: THREADS + CHARACTER(LEN=*), INTENT(OUT) :: errmsg + INTEGER, INTENT(OUT) :: errflg ! !----------------------------------------------------------------------- ! LOCAL VARIABLES @@ -2486,12 +2489,11 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS) ENDIF ENDDO IF (etampnew_unit1<0) THEN - write(0,*)'FERRIER_INIT_hr: Can not find unused fortran ' & - ,'unit to read in lookup tables' - write(0,*)' ABORTING!' -#ifdef MPI - call MPI_ABORT(MPI_COMM_COMP, rc, IRTN) -#endif + errmsg = 'FERRIER_INIT_hr: Can not find unused fortran & + &unit to read in lookup tables' + errmsg = trim(errmsg)//NEW_LINE('A')//' ABORTING!' + errflg = 1 + RETURN ENDIF ENDIF ! diff --git a/physics/mp_fer_hires.F90 b/physics/mp_fer_hires.F90 index 9f265db22..95e521141 100644 --- a/physics/mp_fer_hires.F90 +++ b/physics/mp_fer_hires.F90 @@ -103,7 +103,7 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & ENDIF !MZ: fer_hires_init() in HWRF - CALL FERRIER_INIT_HR(dtp,mpicomm,mpirank,mpiroot,threads) + CALL FERRIER_INIT_HR(dtp,mpicomm,mpirank,mpiroot,threads,errmsg,errflg) if (mpirank==mpiroot) write (0,*)'F-A: FERRIER_INIT_HR finished ...' if (errflg /= 0 ) return From 7d9cf52af84ea3b3949d1c6977e2dced57b3ec21 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 5 Dec 2019 11:33:47 -0700 Subject: [PATCH 50/84] move calculation of precipitation rates needed by NoahMP LSM to GFS_MP_generic_post_run from sfc_noahmp_pre; sfc_noahmp_pre no longer needed --- physics/GFS_MP_generic.F90 | 30 +++++-- physics/GFS_MP_generic.meta | 53 ++++++++++++ physics/sfc_noahmp_pre.F90 | 65 -------------- physics/sfc_noahmp_pre.meta | 167 ------------------------------------ 4 files changed, 75 insertions(+), 240 deletions(-) delete mode 100755 physics/sfc_noahmp_pre.F90 delete mode 100644 physics/sfc_noahmp_pre.meta diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index a7afa2ee0..e0f2873d4 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -85,8 +85,8 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_qv, rain0, ice0, snow0, & 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) + do_sppt, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & + graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, errmsg, errflg) ! use machine, only: kind_phys @@ -120,13 +120,18 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt real(kind=kind_phys), dimension(im), intent(inout) :: drain_cpl real(kind=kind_phys), dimension(im), intent(inout) :: dsnow_cpl - ! Rainfall variables previous time step (update for RUC LSM) - integer, intent(in) :: lsm, lsm_ruc + ! Rainfall variables previous time step + integer, intent(in) :: lsm, lsm_ruc, lsm_noahmp real(kind=kind_phys), dimension(im), intent(inout) :: raincprv real(kind=kind_phys), dimension(im), intent(inout) :: rainncprv real(kind=kind_phys), dimension(im), intent(inout) :: iceprv real(kind=kind_phys), dimension(im), intent(inout) :: snowprv real(kind=kind_phys), dimension(im), intent(inout) :: graupelprv + real(kind=kind_phys), dimension(im), intent(inout) :: draincprv + real(kind=kind_phys), dimension(im), intent(inout) :: drainncprv + real(kind=kind_phys), dimension(im), intent(inout) :: diceprv + real(kind=kind_phys), dimension(im), intent(inout) :: dsnowprv + real(kind=kind_phys), dimension(im), intent(inout) :: dgraupelprv real(kind=kind_phys), intent(in) :: dtp @@ -152,7 +157,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt errflg = 0 onebg = one/con_g - + do i = 1, im rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit enddo @@ -184,14 +189,23 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt tprcp = max (0.,rain) ! time-step convective and explicit precip ice = frain*rain1*sr ! time-step ice end if - - if (lsm==lsm_ruc) then - if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson) then + + if (lsm==lsm_ruc .or. lsm==lsm_noahmp) then raincprv(:) = rainc(:) rainncprv(:) = frain * rain1(:) iceprv(:) = ice(:) snowprv(:) = snow(:) graupelprv(:) = graupel(:) + !for NoahMP, calculate precipitation rates from liquid water equivalent thickness for use in next time step + !Note (GJF): Precipitation LWE thicknesses are multiplied by the frain factor, and are thus on the dynamics time step, but the conversion as written + ! (with dtp in the denominator) assumes the rate is calculated on the physics time step. This only works as expected when dtf=dtp (i.e. when frain=1). + if (lsm == lsm_noahmp) then + tem = 1.0 / (dtp*con_p001) !GJF: This conversion was taken from GFS_physics_driver.F90, but should denominator also have the frain factor? + draincprv(:) = tem * raincprv(:) + drainncprv(:) = tem * rainncprv(:) + dsnowprv(:) = tem * snowprv(:) + dgraupelprv(:) = tem * graupelprv(:) + diceprv(:) = tem * iceprv(:) end if end if diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 3a11a9983..ddf8cb813 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -774,6 +774,14 @@ type = integer intent = in optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [raincprv] standard_name = lwe_thickness_of_convective_precipitation_amount_from_previous_timestep long_name = convective_precipitation_amount from previous timestep @@ -819,6 +827,51 @@ kind = kind_phys intent = inout optional = F +[draincprv] + standard_name = convective_precipitation_rate_from_previous_timestep + long_name = convective precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[drainncprv] + standard_name = explicit_rainfall_rate_from_previous_timestep + long_name = explicit rainfall rate previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[diceprv] + standard_name = ice_precipitation_rate_from_previous_timestep + long_name = ice precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dsnowprv] + standard_name = snow_precipitation_rate_from_previous_timestep + long_name = snow precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dgraupelprv] + standard_name = graupel_precipitation_rate_from_previous_timestep + long_name = graupel precipitation rate from previous timestep + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [dtp] standard_name = time_step_for_physics long_name = physics timestep diff --git a/physics/sfc_noahmp_pre.F90 b/physics/sfc_noahmp_pre.F90 deleted file mode 100755 index fff3562d6..000000000 --- a/physics/sfc_noahmp_pre.F90 +++ /dev/null @@ -1,65 +0,0 @@ -!> \file sfc_noahmp_pre.F90 -!! This file contains data preparation for the NoahMP LSM for use in the GFS physics suite. - -!> This module contains the CCPP-compliant data preparation for NoahMP LSM. - module sfc_noahmp_pre - - implicit none - - private - - public :: sfc_noahmp_pre_init, sfc_noahmp_pre_run, sfc_noahmp_pre_finalize - - contains - - subroutine sfc_noahmp_pre_init() - end subroutine sfc_noahmp_pre_init - - subroutine sfc_noahmp_pre_finalize - end subroutine sfc_noahmp_pre_finalize - -!> \section arg_table_sfc_noahmp_pre_run Argument Table -!! \htmlinclude sfc_noahmp_pre_run.html -!! -!----------------------------------- - subroutine sfc_noahmp_pre_run (im, lsm, lsm_noahmp, imp_physics, & - imp_physics_gfdl, imp_physics_mg, dtp, rain, rainc, ice, snow, & - graupel, rainn_mp, rainc_mp, ice_mp, snow_mp, graupel_mp, & - errmsg, errflg) - - use machine , only : kind_phys - - implicit none - - integer, intent(in) :: im, lsm, lsm_noahmp, & - imp_physics, imp_physics_gfdl, imp_physics_mg - real (kind=kind_phys), intent(in) :: dtp - real (kind=kind_phys), dimension(im), intent(in) :: rain, rainc,& - ice, snow, graupel - real (kind=kind_phys), dimension(:), intent(inout) :: rainn_mp, & - rainc_mp, ice_mp, snow_mp, graupel_mp - - ! error messages - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! --- locals: - integer :: i - real(kind=kind_phys) :: tem - real(kind=kind_phys), parameter :: con_p001= 0.001d0 - - !--- get the amount of different precip type for Noah MP - ! --- convert from m/dtp to mm/s - if (lsm == lsm_noahmp .and. (imp_physics == imp_physics_mg .or. imp_physics == imp_physics_gfdl)) then - tem = 1.0 / (dtp*con_p001) - do i=1,im - rainn_mp(i) = tem * (rain(i)-rainc(i)) - rainc_mp(i) = tem * rainc(i) - snow_mp(i) = tem * snow(i) - graupel_mp(i) = tem * graupel(i) - ice_mp(i) = tem * ice(i) - enddo - endif - - end subroutine sfc_noahmp_pre_run - end module sfc_noahmp_pre diff --git a/physics/sfc_noahmp_pre.meta b/physics/sfc_noahmp_pre.meta deleted file mode 100644 index 4cf834728..000000000 --- a/physics/sfc_noahmp_pre.meta +++ /dev/null @@ -1,167 +0,0 @@ -[ccpp-arg-table] - name = sfc_noahmp_pre_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[lsm] - standard_name = flag_for_land_surface_scheme - long_name = flag for land surface model - units = flag - dimensions = () - type = integer - intent = in - optional = F -[lsm_noahmp] - standard_name = flag_for_noahmp_land_surface_scheme - long_name = flag for NOAH MP land surface model - units = flag - dimensions = () - type = integer - 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_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 -[dtp] - standard_name = time_step_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[rain] - standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep - long_name = total rain at this time step - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[rainc] - standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep - long_name = convective rain at this time step - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ice] - standard_name = lwe_thickness_of_ice_amount_on_dynamics_timestep - long_name = ice fall at this time step - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[snow] - standard_name = lwe_thickness_of_snow_amount_on_dynamics_timestep - long_name = snow fall at this time step - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[graupel] - standard_name = lwe_thickness_of_graupel_amount_on_dynamics_timestep - long_name = graupel fall at this time step - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[rainn_mp] - standard_name = explicit_rainfall_rate_from_previous_timestep - long_name = explicit rainfall rate previous timestep - units = mm s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[rainc_mp] - standard_name = convective_precipitation_rate_from_previous_timestep - long_name = convective precipitation rate from previous timestep - units = mm s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ice_mp] - standard_name = ice_precipitation_rate_from_previous_timestep - long_name = ice precipitation rate from previous timestep - units = mm s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[snow_mp] - standard_name = snow_precipitation_rate_from_previous_timestep - long_name = snow precipitation rate from previous timestep - units = mm s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[graupel_mp] - standard_name = graupel_precipitation_rate_from_previous_timestep - long_name = graupel precipitation rate from previous timestep - units = mm s-1 - dimensions = (horizontal_dimension) - 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 From e0e91d81fb0fdc73e26784c76731d997903d45ef Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 5 Dec 2019 21:03:45 -0700 Subject: [PATCH 51/84] update the NoahMP mainpage to reflect info from Helin Wei --- physics/docs/pdftxt/NoahMP.txt | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/physics/docs/pdftxt/NoahMP.txt b/physics/docs/pdftxt/NoahMP.txt index 3f6bf52bd..f42aaaa00 100644 --- a/physics/docs/pdftxt/NoahMP.txt +++ b/physics/docs/pdftxt/NoahMP.txt @@ -2,7 +2,10 @@ \page NoahMP GFS NoahMP Land Surface Model \section des_noahmp Description -This implementation of the NoahMP Land Surface Model (LSM) is a Fortran 90 port of version 1.6 with additions by NOAA EMC staff to work with the UFS Atmosphere model. Authoritative documentation of the NoahMP scheme can be accessed at the following link: +This implementation of the NoahMP Land Surface Model (LSM) is adapted from the version implemented in WRF v3.7 with additions by NOAA EMC staff to work with the UFS Atmosphere model. Authoritative documentation of the NoahMP scheme can be accessed at the following links: + +[University of Texas at Austin NoahMP Documentation](http://www.jsg.utexas.edu/noah-mp "University of Texas at Austin NoahMP Documentation") + [NCAR Research Application Laboratory NoahMP Documentation](https://ral.ucar.edu/solutions/products/noah-multiparameterization-land-surface-model-noah-mp-lsm "NCAR RAL NoahMP Documentation") A primary reference for the NoahMP LSM is Niu et al. (2011) \cite niu_et_al_2011. From 812f8b6bb55a32df1246888b0a5ef701a255653a Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 6 Dec 2019 10:27:41 -0700 Subject: [PATCH 52/84] fix array dimensions for phii, prsi in ugwp_driver_v0.F --- physics/ugwp_driver_v0.F | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 7f5490d24..6ce02ad78 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) :: + & phii, prsi ! real(kind=kind_phys), intent(in) :: oro_stat(im,nmtvr) real(kind=kind_phys), intent(in), dimension(im) :: hprime, oc From b7a35311940736efe39de9c62f22e3a28b024f4e Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 13 Dec 2019 11:44:17 -0700 Subject: [PATCH 53/84] add preliminary satmedmfvdifq documentation --- physics/docs/ccpp_doxyfile | 6 + physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt | 35 ++++ physics/docs/pdftxt/all_shemes_list.txt | 1 + physics/mfpbltq.f | 2 +- physics/mfscuq.f | 2 +- physics/satmedmfvdifq.F | 239 +++++++++++++++------- physics/tridi.f | 3 + 7 files changed, 213 insertions(+), 75 deletions(-) create mode 100644 physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt diff --git a/physics/docs/ccpp_doxyfile b/physics/docs/ccpp_doxyfile index e4b2e0501..339ddb3f8 100644 --- a/physics/docs/ccpp_doxyfile +++ b/physics/docs/ccpp_doxyfile @@ -113,6 +113,7 @@ INPUT = pdftxt/mainpage.txt \ pdftxt/GFS_SFCSICE.txt \ pdftxt/GFS_HEDMF.txt \ pdftxt/GFS_SATMEDMF.txt \ + pdftxt/GFS_SATMEDMFVDIFQ.txt \ pdftxt/GFS_GWDPS.txt \ pdftxt/GFS_OZPHYS.txt \ pdftxt/GFS_H2OPHYS.txt \ @@ -189,6 +190,11 @@ INPUT = pdftxt/mainpage.txt \ ../mfpblt.f \ ../mfscu.f \ ../tridi.f \ +### satmedmfvdifq + ../satmedmfvdifq.F \ + ../mfpbltq.f \ + ../mfscuq.f \ + ../tridi.f \ ### Orographic Gravity Wave ../gwdps.f \ ### Rayleigh Dampling diff --git a/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt b/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt new file mode 100644 index 000000000..de543fe6c --- /dev/null +++ b/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt @@ -0,0 +1,35 @@ +/** +\page GFS_SATMEDMFVDIFQ GFS Scale-aware TKE-based Moist Eddy-Diffusion Mass-Flux (EDMF) PBL and Free Atmospheric Turbulence Scheme +\section des_satmedmfvdifq Description + +The current operational \ref GFS_HEDMF uses a hybrid EDMF parameterization for the convective PBL (Han et al. 2016 \cite Han_2016; +Han et al. 2017 \cite han_et_al_2017), where the EDMF scheme is applied only for the strongly unstable PBL, while the eddy-diffusivity +counter-gradient(EDCG) scheme is used for the weakly unstable PBL. The new TKE-EDMF is an extended version of \ref GFS_HEDMF with below enhancement: + +-# Eddy diffusivity (K) is now a function of TKE which is prognostically predicted + +-# EDMF approach is applied for all the unstable PBL + +-# EDMF approach is also applied to the stratocumulus-top-driven turbulence mixing + +-# It includes a moist-adiabatic process when updraft thermal becomes saturated + +-# Scale-aware capability + +-# It includes interaction between TKE and cumulus convection + +The CCPP-compliant subroutine satmedmfvdifq_run() computes subgrid vertical turbulence mixing using scale-aware +TKE-based moist eddy-diffusion mass-flux paramterization (Han et al. 2019 \cite Han_2019) +- For the convective boundary layer, the scheme adopts EDMF parameterization (Siebesma et al. (2007)\cite Siebesma_2007) +to take into account nonlocal transport by large eddies(mfpbltq.f) +- A new mass-flux paramterization for stratocumulus-top-induced turbulence mixing has been introduced (mfscuq.f; previously, +it was an eddy diffusion form) +- For local turbulence mixing, a TKE closure model is used. + +\section intra_satmedmfvdifq Intraphysics Communication +\ref arg_table_satmedmfvdifq_run + +\section gen_pbl_satmedmfvdifq General Algorithm +\ref gen_satmedmfvdifq + +*/ diff --git a/physics/docs/pdftxt/all_shemes_list.txt b/physics/docs/pdftxt/all_shemes_list.txt index 3f2290d7b..7e5e3298e 100644 --- a/physics/docs/pdftxt/all_shemes_list.txt +++ b/physics/docs/pdftxt/all_shemes_list.txt @@ -14,6 +14,7 @@ parameterizations in suites. - \b PBL \b and \b Turbulence - \subpage GFS_HEDMF - \subpage GFS_SATMEDMF + - \subpage GFS_SATMEDMFVDIFQ - \subpage GSD_MYNNEDMF - \b Land \b Surface \b Model diff --git a/physics/mfpbltq.f b/physics/mfpbltq.f index 0f4004444..a6fc22cef 100644 --- a/physics/mfpbltq.f +++ b/physics/mfpbltq.f @@ -3,7 +3,7 @@ !! updraft parcel properties for thermals driven by surface heating !! for use in the TKE-EDMF PBL scheme (updated version). -!>\ingroup satmedmfq +!>\ingroup satmedmfvdifq !! This subroutine computes mass flux and updraft parcel properties for !! thermals driven by surface heating. !!\section mfpbltq_gen GFS mfpblt General Algorithm diff --git a/physics/mfscuq.f b/physics/mfscuq.f index c6f66b74b..3390c3e58 100644 --- a/physics/mfscuq.f +++ b/physics/mfscuq.f @@ -2,7 +2,7 @@ !! This file contains the mass flux and downdraft parcel preperties !! parameterization for stratocumulus-top-driven turbulence (updated version). -!>\ingroup satmedmfq +!>\ingroup satmedmfvdifq !! This subroutine computes mass flux and downdraft parcel properties !! for stratocumulus-top-driven turbulence. !! \section mfscuq GFS mfscu General Algorithm diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 546cefca6..8a93cc5fa 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -7,6 +7,15 @@ module satmedmfvdifq contains +!> \defgroup satmedmfvdifq GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF, updated version) Scheme Module +!! @{ +!! \brief This subroutine contains all of the logic for the +!! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF, updated version) scheme. +!! For local turbulence mixing, a TKE closure model is used. +!! Updated version of satmedmfvdif.f (May 2019) to have better low level +!! inversion, to reduce the cold bias in lower troposphere, +!! and to reduce the negative wind speed bias in upper troposphere + !> \section arg_table_satmedmfvdifq_init Argument Table !! \htmlinclude satmedmfvdifq_init.html !! @@ -33,30 +42,21 @@ end subroutine satmedmfvdifq_init subroutine satmedmfvdifq_finalize () end subroutine satmedmfvdifq_finalize -!> \defgroup satmedmfq GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF, updated version) Scheme Module -!! @{ -!! \brief This subroutine contains all of the logic for the -!! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF, updated version) scheme. -!! !> \section arg_table_satmedmfvdifq_run Argument Table !! \htmlinclude satmedmfvdifq_run.html !! -!!\section gen_satmedmfvdif GFS satmedmfvdif General Algorithm -!! satmedmfvdif_run() computes subgrid vertical turbulence mixing +!!\section gen_satmedmfvdifq GFS satmedmfvdifq General Algorithm +!! satmedmfvdifq_run() computes subgrid vertical turbulence mixing !! using the scale-aware TKE-based moist eddy-diffusion mass-flux (EDMF) parameterization of !! Han and Bretherton (2019) \cite Han_2019 . !! -# The local turbulent mixing is represented by an eddy-diffusivity scheme which !! is a function of a prognostic TKE. !! -# For the convective boundary layer, nonlocal transport by large eddies -!! (mfpblt.f), is represented using a mass flux approach (Siebesma et al.(2007) \cite Siebesma_2007 ). +!! (mfpbltq.f), is represented using a mass flux approach (Siebesma et al.(2007) \cite Siebesma_2007 ). !! -# A mass-flux approach is also used to represent the stratocumulus-top-induced turbulence -!! (mfscu.f). -!! For local turbulence mixing, a TKE closure model is used. -!! Updated version of satmedmfvdif.f (May 2019) to have better low level -!! inversion, to reduce the cold bias in lower troposphere, -!! and to reduce the negative wind speed bias in upper troposphere +!! (mfscuq.f). !! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm -!> @{ +!! @{ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & @@ -241,6 +241,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & errmsg = '' errflg = 0 +!> ## Compute preliminary variables from input arguments dt2 = delt rdt = 1. / dt2 ! @@ -251,7 +252,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & km1 = km - 1 kmpbl = km / 2 kmscu = km / 2 -! +!> - Compute physical height of the layer centers and interfaces from +!! the geopotential height (\p zi and \p zl) do k=1,km do i=1,im zi(i,k) = phii(i,k) * gravi @@ -276,11 +278,12 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & zm(i,k) = zi(i,k+1) enddo enddo -! horizontal grid size +!> - Compute horizontal grid size (\p gdx) do i=1,im gdx(i) = sqrt(garea(i)) enddo -! +!> - Initialize tke value at vertical layer centers and interfaces +!! from tracer (\p tke and \p tkeh) do k=1,km do i=1,im tke(i,k) = max(q1(i,k,ntke), tkmin) @@ -291,7 +294,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & tkeh(i,k) = 0.5 * (tke(i,k) + tke(i,k+1)) enddo enddo -! +!> - Compute reciprocal of \f$ \Delta z \f$ (rdzt) do k = 1,km1 do i=1,im rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) @@ -299,12 +302,18 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo ! -! set background diffusivities as a function of -! horizontal grid size with xkzm_h & xkzm_m for gdx >= 25km -! and 0.01 for gdx=5m, i.e., -! xkzm_hx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) -! xkzm_mx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) -! +!> - Compute reciprocal of pressure (tx1, tx2) + +!> - Compute minimum turbulent mixing length (rlmnz) + +!> - Compute background vertical diffusivities for scalars and momentum (xkzo and xkzmo) + +!> - set background diffusivities as a function of +!! horizontal grid size with xkzm_h & xkzm_m for gdx >= 25km +!! and 0.01 for gdx=5m, i.e., +!! \n xkzm_hx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) +!! \n xkzm_mx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) + do i=1,im kx1(i) = 1 tx1(i) = 1.0 / prsi(i,1) @@ -352,7 +361,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif enddo enddo -! + +!> - Some output variables and logical flags are initialized do i = 1,im z0(i) = 0.01 * zorl(i) dusfc(i) = 0. @@ -376,7 +386,9 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & kcld(i) = km1 endif enddo -! + +!> - Compute \f$\theta\f$(theta), and \f$q_l\f$(qlx), \f$\theta_e\f$(thetae), +!! \f$\theta_v\f$(thvx),\f$\theta_{l,v}\f$ (thlvx) including ice water do k=1,km do i=1,im pix(i,k) = psk(i) / prslk(i,k) @@ -403,10 +415,9 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & gotvx(i,k) = g / tvx(i,k) enddo enddo -! -! compute an empirical cloud fraction based on -! Xu & Randall's (1996,JAS) study -! + +!> - Compute an empirical cloud fraction based on +!! Xu and Randall (1996) \cite xu_and_randall_1996 do k = 1, km do i = 1, im plyr(i,k) = 0.01 * prsl(i,k) ! pa to mb (hpa) @@ -433,7 +444,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo ! -! compute buoyancy modified by clouds +!> - Compute buoyancy modified by clouds ! do k = 1, km1 do i = 1, im @@ -456,6 +467,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! +!> - Initialize diffusion coefficients to 0 and calculate the total +!! radiative heating rate (dku, dkt, radx) do k=1,km1 do i=1,im dku(i,k) = 0. @@ -467,14 +480,31 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) enddo enddo -! +!> - Compute stable/unstable PBL flag (pblflg) based on the total +!! surface energy flux (\e false if the total surface energy flux +!! is into the surface) 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. enddo ! -! compute critical bulk richardson number -! +!> ## Calculate the PBL height +!! The calculation of the boundary layer height follows Troen and Mahrt (1986) \cite troen_and_mahrt_1986 section 3. The approach is to find the level in the column where a modified bulk Richardson number exceeds a critical value. +!! - Compute critical bulk Richardson number (\f$Rb_{cr}\f$) (crb) +!! - For the unstable PBL, crb is a constant (0.25) +!! - For the stable boundary layer (SBL), \f$Rb_{cr}\f$ varies +!! with the surface Rossby number, \f$R_{0}\f$, as given by +!! Vickers and Mahrt (2004) \cite Vickers_2004 +!! \f[ +!! Rb_{cr}=0.16(10^{-7}R_{0})^{-0.18} +!! \f] +!! \f[ +!! R_{0}=\frac{U_{10}}{f_{0}z_{0}} +!! \f] +!! where \f$U_{10}\f$ is the wind speed at 10m above the ground surface, +!! \f$f_0\f$ the Coriolis parameter, and \f$z_{0}\f$ the surface roughness +!! length. To avoid too much variation, we restrict \f$Rb_{cr}\f$ to vary +!! within the range of 0.15~0.35 do i = 1,im if(pblflg(i)) then ! thermal(i) = thvx(i,1) @@ -490,7 +520,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & crb(i) = max(min(crb(i), crbmax), crbmin) endif enddo -! +!> - Compute \f$\frac{\Delta t}{\Delta z}\f$ , \f$u_*\f$ do i=1,im dtdz1(i) = dt2 / (zi(i,2)-zi(i,1)) enddo @@ -499,7 +529,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ustar(i) = sqrt(stress(i)) enddo ! -! compute buoyancy (bf) and winshear square +!> - Compute buoyancy \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) +!! and the wind shear squared (shr2) ! do k = 1, km1 do i = 1, im @@ -511,14 +542,18 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo ! -! find pbl height based on bulk richardson number (mrf pbl scheme) +! Find pbl height based on bulk richardson number (mrf pbl scheme) ! and also for diagnostic purpose ! do i=1,im flg(i) = .false. rbup(i) = rbsoil(i) enddo -! +!> - Given the thermal's properties and the critical Richardson number, +!! a loop is executed to find the first level above the surface (kpblx) where +!! the modified Richardson number is greater than the critical Richardson +!! number, using equation 10a from Troen and Mahrt (1996) \cite troen_and_mahrt_1986 +!! (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): do k = 1, kmpbl do i = 1, im if(.not.flg(i)) then @@ -533,6 +568,9 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif enddo enddo +!> - Once the level is found, some linear interpolation is performed to find +!! the exact height of the boundary layer top (where \f$R_{i} > Rb_{cr}\f$) +!! and the PBL height (hpbl and kpbl) and the PBL top index are saved. do i = 1,im if(kpblx(i) > 1) then k = kpblx(i) @@ -554,8 +592,15 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & if(kpbl(i) <= 1) pblflg(i)=.false. enddo ! -! compute similarity parameters -! +!> ## Compute Monin-Obukhov similarity parameters +!! - Calculate the Monin-Obukhov nondimensional stability paramter, commonly +!! referred to as \f$\zeta\f$ using the following equation from Businger et al.(1971) \cite businger_et_al_1971 +!! (eqn 28): +!! \f[ +!! \zeta = Ri_{sfc}\frac{F_m^2}{F_h} = \frac{z}{L} +!! \f] +!! where \f$F_m\f$ and \f$F_h\f$ are surface Monin-Obukhov stability functions calculated in sfc_diff.f and +!! \f$L\f$ is the Obukhov length. do i=1,im zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) if(sfcflg(i)) then @@ -563,7 +608,17 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & else zol(i) = max(zol(i),zfmin) endif -! +!> - Calculate the nondimensional gradients of momentum and temperature (\f$\phi_m\f$ (phim) and \f$\phi_h\f$(phih)) are calculated using +!! eqns 5 and 6 from Hong and Pan (1996) \cite hong_and_pan_1996 depending on the surface layer stability: +!! - For the unstable and neutral conditions: +!! \f[ +!! \phi_m=(1-16\frac{0.1h}{L})^{-1/4} +!! \phi_h=(1-16\frac{0.1h}{L})^{-1/2} +!! \f] +!! - For the stable regime +!! \f[ +!! \phi_m=\phi_t=(1+5\frac{0.1h}{L}) +!! \f] zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) if(sfcflg(i)) then tem = 1.0 / (1. - aphi16*zol1) @@ -575,6 +630,21 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif enddo ! +!> - The \f$z/L\f$ (zol) is used as the stability criterion for the PBL.Currently, +!! strong unstable (convective) PBL for \f$z/L < -0.02\f$ and weakly and moderately +!! unstable PBL for \f$0>z/L>-0.02\f$ +!> - Compute the velocity scale \f$w_s\f$ (wscale) (eqn 22 of Han et al. 2019). It +!! is represented by the value scaled at the top of the surface layer: +!! \f[ +!! w_s=(u_*^3+7\alpha\kappa w_*^3)^{1/3} +!! \f] +!! where \f$u_*\f$ (ustar) is the surface friction velocity,\f$\alpha\f$ is the ratio +!! of the surface layer height to the PBL height (specified as sfcfrac =0.1), +!! \f$\kappa =0.4\f$ is the von Karman constant, and \f$w_*\f$ is the convective velocity +!! scale defined as eqn23 of Han et al.(2019): +!! \f[ +!! w_{*}=[(g/T)\overline{(w'\theta_v^{'})}_0h]^{1/3} +!! \f] do i=1,im if(pblflg(i)) then if(zol(i) < zolcru) then @@ -589,7 +659,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif enddo ! -! compute a thermal excess +!> ## The counter-gradient terms for temperature and humidity are calculated. +!! - Equation 4 of Hong and Pan (1996) \cite hong_and_pan_1996 and are used to calculate the "scaled virtual temperature excess near the surface" (equation 9 in Hong and Pan (1996) \cite hong_and_pan_1996) for use in the mass-flux algorithm. ! do i = 1,im if(pcnvflg(i)) then @@ -603,7 +674,10 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! look for stratocumulus -! +!> ## Determine whether stratocumulus layers exist and compute quantities +!! - Starting at the PBL top and going downward, if the level is less than 2.5 km +!! and \f$q_l\geq q_{lcr}\f$ then set kcld = k (find the cloud top index in the PBL. +!! If no cloud water above the threshold is hound, \e scuflg is set to F. do i=1,im flg(i) = scuflg(i) enddo @@ -631,7 +705,11 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & do i = 1, im if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. enddo -! +!> - Starting at the PBL top and going downward, if the level is less +!! than the cloud top, find the level of the minimum radiative heating +!! rate wihin the cloud. If the level of the minimum is the lowest model +!! level or the minimum radiative heating rate is positive, then set +!! scuflg to F. do i = 1, im flg(i)=scuflg(i) enddo @@ -655,9 +733,10 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute components for mass flux mixing by large thermals +!> ## Compute components for mass flux mixing by large thermals !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! +!> - If the PBL is convective, the updraft properties are initialized +!! to be the same as the state variables. do k = 1, km do i = 1, im if(pcnvflg(i)) then @@ -684,12 +763,14 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo enddo -! +!> - Call mfpbltq(), which is an EDMF parameterization (Siebesma et al.(2007) \cite Siebesma_2007) +!! to take into account nonlocal transport by large eddies. For details of the mfpbltq subroutine, step into its documentation ::mfpbltq call mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,dt2, & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, & gdx,hpbl,kpbl,vpert,buou,xmf, & tcko,qcko,ucko,vcko,xlamue,bl_upfr) -! +!> - Call mfscuq(), which is a new mass-flux parameterization for +!! stratocumulus-top-induced turbulence mixing. For details of the mfscuq subroutine, step into its documentation ::mfscuq call mfscuq(im,ix,km,kmscu,ntcw,ntrac1,dt2, & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, & thlx,thvx,thlvx,gdx,thetae, @@ -697,8 +778,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & tcdo,qcdo,ucdo,vcdo,xlamde,bl_dnfr) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute prandtl number and exchange coefficient varying with height -! + +!> ## Compute Prandtl number \f$P_r\f$ (prn) and exchange coefficient varying with height do k = 1, kmpbl do i = 1, im if(k < kpbl(i)) then @@ -742,8 +823,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! enddo ! enddo ! -! The background vertical diffusivities in the inversion layers are limited -! to be less than or equal to xkzminv +!> ## The background vertical diffusivities in the inversion layers are limited +!! to be less than or equal to xkzinv ! do k = 1,km1 do i=1,im @@ -758,7 +839,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute an asymtotic mixing length +!> ## Compute an asymtotic mixing length ! do k = 1, km1 do i = 1, im @@ -818,7 +899,18 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! tem = 0.5 * (zi(i,k+1)-zi(i,k)) tem1 = min(tem, rlmnz(i,k)) -! +!> - Following Bougeault and Lacarrere(1989), the characteristic length +!! scale (\f$l_2\f$) (eqn 10 in Han et al.(2019) \cite Han_2019) is given by: +!!\f[ +!! l_2=min(l_{up},l_{down}) +!!\f] +!! and dissipation length scale \f$l_d\f$ is given by: +!!\f[ +!! l_d=(l_{up}l_{down})^{1/2} +!!\f] +!! where \f$l_{up}\f$ and \f$l_{down}\f$ are the distances that a parcel +!! having an initial TKE can travel upward and downward before being stopped +!! by buoyancy effects. ptem2 = min(zlup,zldn) rlam(i,k) = elmfac * ptem2 rlam(i,k) = max(rlam(i,k), tem1) @@ -831,7 +923,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! enddo enddo -! +!> - Compute the surface layer length scale (\f$l_1\f$) following +!! Nakanishi (2001) \cite Nakanish_2001 (eqn 9 of Han et al.(2019) \cite Han_2019) do k = 1, km1 do i = 1, im tem = vk * zl(i,k) @@ -860,7 +953,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute eddy diffusivities +!> ## Compute eddy diffusivities !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! do k = 1, km1 @@ -913,8 +1006,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! enddo enddo -! -! compute a minimum TKE deduced from background diffusivity for momentum. +!> ## Compute TKE. +!! - Compute a minimum TKE deduced from background diffusivity for momentum. ! do k = 1, km1 do i = 1, im @@ -933,7 +1026,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute buoyancy and shear productions of tke +!> - Compute buoyancy and shear productions of TKE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! do k = 1, km1 @@ -1057,7 +1150,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !---------------------------------------------------------------------- -! first predict tke due to tke production & dissipation(diss) +!> - First predict tke due to tke production & dissipation(diss) ! dtn = dt2 / float(ndt) do n = 1, ndt @@ -1075,7 +1168,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo ! -! compute updraft & downdraft properties for tke +!> - Compute updraft & downdraft properties for TKE ! do k = 1, km do i = 1, im @@ -1113,7 +1206,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !---------------------------------------------------------------------- -! compute tridiagonal matrix elements for turbulent kinetic energy +!> - Compute tridiagonal matrix elements for turbulent kinetic energy ! do i=1,im ad(i,1) = 1.0 @@ -1161,11 +1254,11 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo c -c solve tridiagonal problem for tke +!> - Call tridit() to solve tridiagonal problem for TKE c call tridit(im,km,1,al,ad,au,f1,au,f1) c -c recover tendency of tke +!> - Recover the tendency of tke c do k = 1,km do i = 1,im @@ -1175,7 +1268,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo c -c compute tridiagonal matrix elements for heat and moisture +!> ## Compute tridiagonal matrix elements for heat and moisture c do i=1,im ad(i,1) = 1. @@ -1284,11 +1377,11 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo endif c -c solve tridiagonal problem for heat and moisture +!> - Call tridin() to solve tridiagonal problem for heat and moisture c call tridin(im,km,ntrac1,al,ad,au,f1,f2,au,f1,f2) c -c recover tendencies of heat and moisture +!> - Recover the tendencies of heat and moisture c do k = 1,km do i = 1,im @@ -1313,7 +1406,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo endif ! -! add tke dissipative heating to temperature tendency +!> ## Add TKE dissipative heating to temperature tendency ! if(dspheat) then do k = 1,km1 @@ -1326,7 +1419,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo endif c -c compute tridiagonal matrix elements for momentum +!> ## Compute tridiagonal matrix elements for momentum c do i=1,im ad(i,1) = 1.0 + dtdz1(i) * stress(i) / spd1(i) @@ -1384,11 +1477,11 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo c -c solve tridiagonal problem for momentum +!> - Call tridi2() to solve tridiagonal problem for momentum c call tridi2(im,km,al,ad,au,f1,f2,au,f1,f2) c -c recover tendencies of momentum +!> - Recover the tendencies of momentum c do k = 1,km do i = 1,im @@ -1402,7 +1495,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! pbl height for diagnostic purpose +!> ## Save PBL height for diagnostic purpose ! do i = 1, im hpbl(i) = hpblx(i) @@ -1413,5 +1506,5 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & return end subroutine satmedmfvdifq_run !> @} - +!! @} end module satmedmfvdifq diff --git a/physics/tridi.f b/physics/tridi.f index 22a35ea9c..bd44bcc86 100644 --- a/physics/tridi.f +++ b/physics/tridi.f @@ -42,6 +42,7 @@ end subroutine tridi1 c----------------------------------------------------------------------- !>\ingroup satmedmf +!>\ingroup satmedmfvdifq !> This subroutine .. subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) cc @@ -84,6 +85,7 @@ end subroutine tridi2 c----------------------------------------------------------------------- !>\ingroup satmedmf +!>\ingroup satmedmfvdifq !> Routine to solve the tridiagonal system to calculate u- and !! v-momentum at \f$ t + \Delta t \f$; part of two-part process to !! calculate time tendencies due to vertical diffusion. @@ -154,6 +156,7 @@ end subroutine tridin c----------------------------------------------------------------------- !>\ingroup satmedmf +!>\ingroup satmedmfvdifq !! This subroutine solves tridiagonal problem for TKE. subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) !----------------------------------------------------------------------- From 947d7c99411f6b9b025380dd2465baa258c26062 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 16 Dec 2019 13:02:36 +0000 Subject: [PATCH 54/84] 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 ee1065bae62e21319ff55375af1221bebc9dcfca Mon Sep 17 00:00:00 2001 From: "Bin.Liu" Date: Wed, 18 Dec 2019 02:59:06 +0000 Subject: [PATCH 55/84] Connect HAFS version of GFS EDMF PBL scheme with CCPP (Qingfu, Bin, Chunxi, and Weiguo). --- physics/moninedmf_hafs.f | 1555 +++++++++++++++++++++++++++++++++++ physics/moninedmf_hafs.meta | 526 ++++++++++++ 2 files changed, 2081 insertions(+) create mode 100644 physics/moninedmf_hafs.f create mode 100644 physics/moninedmf_hafs.meta diff --git a/physics/moninedmf_hafs.f b/physics/moninedmf_hafs.f new file mode 100644 index 000000000..5c6ff85a8 --- /dev/null +++ b/physics/moninedmf_hafs.f @@ -0,0 +1,1555 @@ +!> \file moninedmf_hafs.f +!! Contains most of the hybrid eddy-diffusivity mass-flux scheme except for the +!! subroutine that calculates the mass flux and updraft properties. + +!> This module contains the CCPP-compliant hybrid eddy-diffusivity mass-flux +!! scheme. + module hedmf_hafs + + contains + +!> \section arg_table_hedmf_hafs_init Argument Table +!! \htmlinclude hedmf_hafs_init.html +!! + subroutine hedmf_hafs_init (moninq_fac,errmsg,errflg) + use machine, only : kind_phys + implicit none + real(kind=kind_phys), intent(in ) :: moninq_fac + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (moninq_fac == 0) then + errflg = 1 + write(errmsg,'(*(a))') 'Logic error: moninq_fac == 0', & + & ' is incompatible with moninedmf_hafs' + end if + end subroutine hedmf_hafs_init + + subroutine hedmf_hafs_finalize () + end subroutine hedmf_hafs_finalize + + +!> \defgroup HEDMF GFS Hybrid Eddy-Diffusivity Mass-Flux (HEDMF) Scheme Module +!! @{ +!! \brief This subroutine contains all of logic for the +!! Hybrid EDMF PBL scheme except for the calculation of +!! the updraft properties and mass flux. +!! +!> \section arg_table_hedmf_hafs_run Argument Table +!! \htmlinclude hedmf_hafs_run.html +!! +!! \section general_edmf GFS Hybrid EDMF General Algorithm +!! -# Compute preliminary variables from input arguments. +!! -# Calculate the first estimate of the PBL height ("Predictor step"). +!! -# Calculate Monin-Obukhov similarity parameters. +!! -# Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). +!! -# Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion. +!! -# Calculate the inverse Prandtl number. +!! -# Compute diffusion coefficients below the PBL top. +!! -# Compute diffusion coefficients above the PBL top. +!! -# If the PBL is convective, call the mass flux scheme to replace the countergradient terms. +!! -# Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs. +!! -# Solve for the temperature and moisture tendencies due to vertical mixing. +!! -# Calculate heating due to TKE dissipation and add to the tendency for temperature. +!! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. +!! \section detailed_hedmf GFS Hybrid HEDMF Detailed Algorithm +!! @{ + subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & + & u1,v1,t1,q1,swh,hlw,xmu, & + & psk,rbsoil,zorl,u10m,v10m,fm,fh, & + & tsea,heat,evap,stress,spd1,kpbl, & + & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & + & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & + & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & + & xkzminv,moninq_fac,islimsk,errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs + use physcons, grav => con_g, rd => con_rd, cp => con_cp & + &, hvap => con_hvap, fv => con_fvirt + implicit none +! +! arguments +! + logical, intent(in) :: lprnt + integer, intent(in) :: ipr + integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) + integer, intent(in) :: islimsk(1:im) + integer, intent(out) :: kpbl(im) + +! + real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s + real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac + real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & + & tau(im,km), rtg(im,km,ntrac) + real(kind=kind_phys), intent(in) :: & + & u1(ix,km), v1(ix,km), & + & t1(ix,km), q1(ix,km,ntrac), & + & swh(ix,km), hlw(ix,km), & + & xmu(im), psk(im), & + & rbsoil(im), zorl(im), & + & u10m(im), v10m(im), & + & fm(im), fh(im), & + & tsea(im), & + & heat(im), evap(im), & + & stress(im), spd1(im) + real(kind=kind_phys), intent(in) :: & + & prsi(ix,km+1), del(ix,km), & + & prsl(ix,km), prslk(ix,km), & + & phii(ix,km+1), phil(ix,km) + real(kind=kind_phys), intent(out) :: & + & dusfc(im), dvsfc(im), & + & dtsfc(im), dqsfc(im), & + & hpbl(im), dkt(im,km-1) + + real(kind=kind_phys), intent(inout) :: & + & hgamt(im), hgamq(im) +! + logical, intent(in) :: dspheat +! flag for tke dissipative heating + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! +! locals +! + integer i,iprt,is,iun,k,kk,km1,kmpbl,latd,lond + integer lcld(im),icld(im),kcld(im),krad(im) + integer kx1(im), kpblx(im) +! +! real(kind=kind_phys) betaq(im), betat(im), betaw(im), + real(kind=kind_phys) phih(im), phim(im), hpblx(im), & + & rbdn(im), rbup(im), & + & beta(im), sflux(im), & + & z0(im), crb(im), wstar(im), & + & zol(im), ustmin(im), ustar(im), & + & thermal(im),wscale(im), wscaleu(im) +! + real(kind=kind_phys) theta(im,km),thvx(im,km), thlvx(im,km), & + & qlx(im,km), thetae(im,km), & + & qtx(im,km), bf(im,km-1), diss(im,km), & + & radx(im,km-1), & + & govrth(im), hrad(im), & +! & hradm(im), radmin(im), vrad(im), & + & radmin(im), vrad(im), & + & zd(im), zdd(im), thlvx1(im) +! + real(kind=kind_phys) rdzt(im,km-1),dktx(im,km-1), & + & zi(im,km+1), zl(im,km), xkzo(im,km-1), & + & dku(im,km-1), xkzmo(im,km-1), & + & cku(im,km-1), ckt(im,km-1), & + & ti(im,km-1), shr2(im,km-1), & + & al(im,km-1), ad(im,km), & + & au(im,km-1), a1(im,km), & + & a2(im,km*ntrac) +! + real(kind=kind_phys) tcko(im,km), qcko(im,km,ntrac), & + & ucko(im,km), vcko(im,km), xmf(im,km) +! + real(kind=kind_phys) prinv(im), rent(im) +! + logical pblflg(im), sfcflg(im), scuflg(im), flg(im) + logical ublflg(im), pcnvflg(im) +! +! pcnvflg: true for convective(strongly unstable) pbl +! ublflg: true for unstable but not convective(strongly unstable) pbl +! + real(kind=kind_phys) aphi16, aphi5, bvf2, wfac, + & cfac, conq, cont, conw, + & dk, dkmax, dkmin, + & dq1, dsdz2, dsdzq, dsdzt, + & dsdzu, dsdzv, + & dsig, dt2, dthe1, dtodsd, + & dtodsu, dw2, dw2min, g, + & gamcrq, gamcrt, gocp, + & gravi, f0, + & prnum, prmax, prmin, pfac, crbcon, + & qmin, tdzmin, qtend, crbmin,crbmax, + & rbint, rdt, rdz, qlmin, + & ri, rimin, rl2, rlam, rlamun, + & rone, rzero, sfcfrac, + & spdk2, sri, zol1, zolcr, zolcru, + & robn, ttend, + & utend, vk, vk2, + & ust3, wst3, + & vtend, zfac, vpert, cteit, + & rentf1, rentf2, radfac, + & zfmin, zk, tem, tem1, tem2, + & xkzm, xkzmu, + & ptem, ptem1, ptem2, tx1(im), tx2(im) +! + real(kind=kind_phys) zstblmax,h1, h2, qlcr, actei, + & cldtime + +!! for aplha + real(kind=kind_phys) WSPM(IM,KM-1) + integer kLOC ! RGF + real :: xDKU, ALPHA ! RGF + + integer :: useshape + real :: smax,ashape,sz2h, sksfc,skmax,ashape1,skminusk0, hmax + + +!cc + parameter(gravi=1.0/grav) + parameter(g=grav) + parameter(gocp=g/cp) + parameter(cont=cp/g,conq=hvap/g,conw=1.0/g) ! for del in pa +! parameter(cont=1000.*cp/g,conq=1000.*hvap/g,conw=1000./g) ! for del in kpa + parameter(rlam=30.0,vk=0.4,vk2=vk*vk) + parameter(prmin=0.25,prmax=4.,zolcr=0.2,zolcru=-0.5) + parameter(dw2min=0.0001,dkmin=0.0,dkmax=1000.,rimin=-100.) + parameter(crbcon=0.25,crbmin=0.15,crbmax=0.35) + parameter(wfac=7.0,cfac=6.5,pfac=2.0,sfcfrac=0.1) +! parameter(qmin=1.e-8,xkzm=1.0,zfmin=1.e-8,aphi5=5.,aphi16=16.) + parameter(qmin=1.e-8, zfmin=1.e-8,aphi5=5.,aphi16=16.) + parameter(tdzmin=1.e-3,qlmin=1.e-12,f0=1.e-4) + parameter(h1=0.33333333,h2=0.66666667) +! parameter(cldtime=500.,xkzminv=0.3) + parameter(cldtime=500.) +! parameter(cldtime=500.,xkzmu=3.0,xkzminv=0.3) +! parameter(gamcrt=3.,gamcrq=2.e-3,rlamun=150.0) + parameter(gamcrt=3.,gamcrq=0.,rlamun=150.0) + parameter(rentf1=0.2,rentf2=1.0,radfac=0.85) + parameter(iun=84) +! +! parameter (zstblmax = 2500., qlcr=1.0e-5) +! parameter (zstblmax = 2500., qlcr=3.0e-5) +! parameter (zstblmax = 2500., qlcr=3.5e-5) +! parameter (zstblmax = 2500., qlcr=1.0e-4) + parameter (zstblmax = 2500., qlcr=3.5e-5) +! parameter (actei = 0.23) + parameter (actei = 0.7) + +! HAFS PBL: height-dependent ALPHA + useshape=2 !0-- no change, origincal ALPHA adjustment,1-- shape1, 2-- shape2(adjust above sfc) + alpha=moninq_fac + + ! write(0,*)'in PBL,alpha=',alpha + + ! write(0,*)'islimsk=',(islimsk(i),i=1,im) + +c +c----------------------------------------------------------------------- +c + 601 format(1x,' moninp lat lon step hour ',3i6,f6.1) + 602 format(1x,' k',' z',' t',' th', + 1 ' tvh',' q',' u',' v', + 2 ' sp') + 603 format(1x,i5,8f9.1) + 604 format(1x,' sfc',9x,f9.1,18x,f9.1) + 605 format(1x,' k zl spd2 thekv the1v' + 1 ,' thermal rbup') + 606 format(1x,i5,6f8.2) + 607 format(1x,' kpbl hpbl fm fh hgamt', + 1 ' hgamq ws ustar cd ch') + 608 format(1x,i5,9f8.2) + 609 format(1x,' k pr dkt dku ',i5,3f8.2) + 610 format(1x,' k pr dkt dku ',i5,3f8.2,' l2 ri t2', + 1 ' sr2 ',2f8.2,2e10.2) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!> ## Compute preliminary variables from input arguments + +! compute preliminary variables +! + if (ix .lt. im) stop +! +! iprt = 0 +! if(iprt.eq.1) then +!cc latd = 0 +! lond = 0 +! else +!cc latd = 0 +! lond = 0 +! endif +! + dt2 = delt + rdt = 1. / dt2 + km1 = km - 1 + kmpbl = km / 2 +!> - Compute physical height of the layer centers and interfaces from the geopotential height (zi and zl) + do k=1,km + do i=1,im + zi(i,k) = phii(i,k) * gravi + zl(i,k) = phil(i,k) * gravi + enddo + enddo + do i=1,im + zi(i,km+1) = phii(i,km+1) * gravi + enddo +!> - Compute reciprocal of \f$ \Delta z \f$ (rdzt) + do k = 1,km1 + do i=1,im + rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) + enddo + enddo +!> - Compute reciprocal of pressure (tx1, tx2) + do i=1,im + kx1(i) = 1 + tx1(i) = 1.0 / prsi(i,1) + tx2(i) = tx1(i) + enddo +!> - Compute background vertical diffusivities for scalars and momentum (xkzo and xkzmo) + do k = 1,km1 + do i=1,im + xkzo(i,k) = 0.0 + xkzmo(i,k) = 0.0 + if (k < kinver(i)) then +! vertical background diffusivity + ptem = prsi(i,k+1) * tx1(i) + tem1 = 1.0 - ptem + tem1 = tem1 * tem1 * 10.0 + xkzo(i,k) = xkzm_h * min(1.0, exp(-tem1)) + +! vertical background diffusivity for momentum + if (ptem >= xkzm_s) then + xkzmo(i,k) = xkzm_m + kx1(i) = k + 1 + else + if (k == kx1(i) .and. k > 1) tx2(i) = 1.0 / prsi(i,k) + tem1 = 1.0 - prsi(i,k+1) * tx2(i) + tem1 = tem1 * tem1 * 5.0 + xkzmo(i,k) = xkzm_m * min(1.0, exp(-tem1)) + endif + endif + enddo + enddo + +! if (lprnt) then +! print *,' xkzo=',(xkzo(ipr,k),k=1,km1) +! print *,' xkzmo=',(xkzmo(ipr,k),k=1,km1) +! endif +! +! diffusivity in the inversion layer is set to be xkzminv (m^2/s) +!> - The background scalar vertical diffusivity is limited to be less than or equal to xkzminv + do k = 1,kmpbl + do i=1,im +! if(zi(i,k+1) > 200..and.zi(i,k+1) < zstblmax) then + if(zi(i,k+1) > 250.) then + tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) + if(tem1 > 1.e-5) then + xkzo(i,k) = min(xkzo(i,k),xkzminv) + endif + endif + enddo + enddo +!> - Some output variables and logical flags are initialized + do i = 1,im + z0(i) = 0.01 * zorl(i) + dusfc(i) = 0. + dvsfc(i) = 0. + dtsfc(i) = 0. + dqsfc(i) = 0. + wscale(i)= 0. + wscaleu(i)= 0. + kpbl(i) = 1 + hpbl(i) = zi(i,1) + hpblx(i) = zi(i,1) + pblflg(i)= .true. + sfcflg(i)= .true. + if(rbsoil(i) > 0.) sfcflg(i) = .false. + ublflg(i)= .false. + pcnvflg(i)= .false. + scuflg(i)= .true. + if(scuflg(i)) then + radmin(i)= 0. + rent(i) = rentf1 + hrad(i) = zi(i,1) +! hradm(i) = zi(i,1) + krad(i) = 1 + icld(i) = 0 + lcld(i) = km1 + kcld(i) = km1 + zd(i) = 0. + endif + enddo +!> - Compute \f$\theta\f$ (theta), \f$q_l\f$ (qlx), \f$q_t\f$ (qtx), \f$\theta_e\f$ (thetae), \f$\theta_v\f$ (thvx), \f$\theta_{l,v}\f$ (thlvx) + do k = 1,km + do i = 1,im + theta(i,k) = t1(i,k) * psk(i) / prslk(i,k) + qlx(i,k) = max(q1(i,k,ntcw),qlmin) + qtx(i,k) = max(q1(i,k,1),qmin)+qlx(i,k) + ptem = qlx(i,k) + ptem1 = hvap*max(q1(i,k,1),qmin)/(cp*t1(i,k)) + thetae(i,k)= theta(i,k)*(1.+ptem1) + thvx(i,k) = theta(i,k)*(1.+fv*max(q1(i,k,1),qmin)-ptem) + ptem2 = theta(i,k)-(hvap/cp)*ptem + thlvx(i,k) = ptem2*(1.+fv*qtx(i,k)) + enddo + enddo +!> - Initialize diffusion coefficients to 0 and calculate the total radiative heating rate (dku, dkt, radx) + do k = 1,km1 + do i = 1,im + dku(i,k) = 0. + dkt(i,k) = 0. + dktx(i,k) = 0. + cku(i,k) = 0. + ckt(i,k) = 0. + tem = zi(i,k+1)-zi(i,k) + radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) + enddo + enddo +!> - Set lcld to first index above 2.5km + do i=1,im + flg(i) = scuflg(i) + enddo + do k = 1, km1 + do i=1,im + if(flg(i).and.zl(i,k) >= zstblmax) then + lcld(i)=k + flg(i)=.false. + endif + enddo + enddo +! +! compute virtual potential temp gradient (bf) and winshear square +!> - Compute \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) and the wind shear squared (shr2) + do k = 1, km1 + do i = 1, im + rdz = rdzt(i,k) + bf(i,k) = (thvx(i,k+1)-thvx(i,k))*rdz + ti(i,k) = 2./(t1(i,k)+t1(i,k+1)) + dw2 = (u1(i,k)-u1(i,k+1))**2 + & + (v1(i,k)-v1(i,k+1))**2 + shr2(i,k) = max(dw2,dw2min)*rdz*rdz + enddo + enddo +!> - Calculate \f$\frac{g}{\theta}\f$ (govrth), \f$\beta = \frac{\Delta t}{\Delta z}\f$ (beta), \f$u_*\f$ (ustar), total surface flux (sflux), and set pblflag to false if the total surface energy flux is into the surface + do i = 1,im + govrth(i) = g/theta(i,1) + enddo +! + do i=1,im + beta(i) = dt2 / (zi(i,2)-zi(i,1)) + enddo +! + do i=1,im + ustar(i) = sqrt(stress(i)) + enddo +! + 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. + enddo +!> ## Calculate the first estimate of the PBL height (``Predictor step") +!! The calculation of the boundary layer height follows Troen and Mahrt (1986) \cite troen_and_mahrt_1986 section 3. The approach is to find the level in the column where a modified bulk Richardson number exceeds a critical value. +!! +!! The temperature of the thermal is of primary importance. For the initial estimate of the PBL height, the thermal is assumed to have one of two temperatures. If the boundary layer is stable, the thermal is assumed to have a temperature equal to the surface virtual temperature. Otherwise, the thermal is assumed to have the same virtual potential temperature as the lowest model level. For the stable case, the critical bulk Richardson number becomes a function of the wind speed and roughness length, otherwise it is set to a tunable constant. +! compute the pbl height +! + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) + + IF ( ALPHA .GT. 0.0) THEN ! ALPHA + + if(pblflg(i)) then + thermal(i) = thvx(i,1) + crb(i) = crbcon + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = max(min(crb(i), crbmax), crbmin) + endif + + ELSE +! use variable Ri for all conditions + if(pblflg(i)) then + thermal(i) = thvx(i,1) + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + endif + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn +! crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = crbcon + IF(islimsk(i).ne.0) crb(I) = 0.16*(tem1)**(-0.18) + IF(islimsk(i).eq.0) crb(I) = 0.25*(tem1)**(-0.18) + crb(i) = max(min(crb(i), crbmax), crbmin) + ENDIF ! ALPHA + + enddo + +!> Given the thermal's properties and the critical Richardson number, a loop is executed to find the first level above the surface where the modified Richardson number is greater than the critical Richardson number, using equation 10a from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): +!! \f[ +!! h = Ri\frac{T_0\left|\vec{v}(h)\right|^2}{g\left(\theta_v(h) - \theta_s\right)} +!! \f] +!! where \f$h\f$ is the PBL height, \f$Ri\f$ is the Richardson number, \f$T_0\f$ is the virtual potential temperature near the surface, \f$\left|\vec{v}\right|\f$ is the wind speed, and \f$\theta_s\f$ is for the thermal. Rearranging this equation to calculate the modified Richardson number at each level, k, for comparison with the critical value yields: +!! \f[ +!! Ri_k = gz(k)\frac{\left(\theta_v(k) - \theta_s\right)}{\theta_v(1)*\vec{v}(k)} +!! \f] + do k = 1, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) + rbup(i) = (thvx(i,k)-thermal(i))* + & (g*zl(i,k)/thvx(i,1))/spdk2 + kpbl(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo + +!> Once the level is found, some linear interpolation is performed to find the exact height of the boundary layer top (where \f$Ri = Ri_{cr}\f$) and the PBL height and the PBL top index are saved (hpblx and kpblx, respectively) + do i = 1,im + if(kpbl(i) > 1) then + k = kpbl(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 + else + hpbl(i) = zl(i,1) + kpbl(i) = 1 + endif + kpblx(i) = kpbl(i) + hpblx(i) = hpbl(i) + enddo +! +! compute similarity parameters +!> ## Calculate Monin-Obukhov similarity parameters +!! Using the initial guess for the PBL height, Monin-Obukhov similarity parameters are calculated. They are needed to refine the PBL height calculation and for calculating diffusion coefficients. +!! +!! First, calculate the Monin-Obukhov nondimensional stability parameter, commonly referred to as \f$\zeta\f$ using the following equation from Businger et al. (1971) \cite businger_et_al_1971 (equation 28): +!! \f[ +!! \zeta = Ri_{sfc}\frac{F_m^2}{F_h} = \frac{z}{L} +!! \f] +!! where \f$F_m\f$ and \f$F_h\f$ are surface Monin-Obukhov stability functions calculated in sfc_diff.f and \f$L\f$ is the Obukhov length. Then, the nondimensional gradients of momentum and temperature (phim and phih) are calculated using equations 5 and 6 from Hong and Pan (1996) \cite hong_and_pan_1996 depending on the surface layer stability. Then, the velocity scale valid for the surface layer (\f$w_s\f$, wscale) is calculated using equation 3 from Hong and Pan (1996) \cite hong_and_pan_1996. For the neutral and unstable PBL above the surface layer, the convective velocity scale, \f$w_*\f$, is calculated according to: +!! \f[ +!! w_* = \left(\frac{g}{\theta_0}h\overline{w'\theta_0'}\right)^{1/3} +!! \f] +!! and the mixed layer velocity scale is then calculated with equation 6 from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 +!! \f[ +!! w_s = (u_*^3 + 7\epsilon k w_*^3)^{1/3} +!! \f] + do i=1,im + zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) + if(sfcflg(i)) then + zol(i) = min(zol(i),-zfmin) + else + zol(i) = max(zol(i),zfmin) + endif + zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) + if(sfcflg(i)) then +! phim(i) = (1.-aphi16*zol1)**(-1./4.) +! phih(i) = (1.-aphi16*zol1)**(-1./2.) + tem = 1.0 / (1. - aphi16*zol1) + phih(i) = sqrt(tem) + phim(i) = sqrt(phih(i)) + else + phim(i) = 1. + aphi5*zol1 + phih(i) = phim(i) + endif + wscale(i) = ustar(i)/phim(i) + ustmin(i) = ustar(i)/aphi5 + wscale(i) = max(wscale(i),ustmin(i)) + enddo + do i=1,im + if(pblflg(i)) then + if(zol(i) < zolcru .and. kpbl(i) > 1) then + pcnvflg(i) = .true. + else + ublflg(i) = .true. + endif + wst3 = govrth(i)*sflux(i)*hpbl(i) + wstar(i)= wst3**h1 + ust3 = ustar(i)**3. + wscaleu(i) = (ust3+wfac*vk*wst3*sfcfrac)**h1 + wscaleu(i) = max(wscaleu(i),ustmin(i)) + endif + enddo +! +! compute counter-gradient mixing term for heat and moisture +!> ## Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). +!! Next, the counter-gradient terms for temperature and humidity are calculated using equation 4 of Hong and Pan (1996) \cite hong_and_pan_1996 and are used to calculate the "scaled virtual temperature excess near the surface" (equation 9 in Hong and Pan (1996) \cite hong_and_pan_1996) so that the properties of the thermal are updated to recalculate the PBL height. + do i = 1,im + if(ublflg(i)) then + hgamt(i) = min(cfac*heat(i)/wscaleu(i),gamcrt) + hgamq(i) = min(cfac*evap(i)/wscaleu(i),gamcrq) + vpert = hgamt(i) + hgamq(i)*fv*theta(i,1) + vpert = min(vpert,gamcrt) + thermal(i)= thermal(i)+max(vpert,0.) + hgamt(i) = max(hgamt(i),0.0) + hgamq(i) = max(hgamq(i),0.0) + endif + enddo +! +! enhance the pbl height by considering the thermal excess +!> The PBL height calculation follows the same procedure as the predictor step, except that it uses an updated virtual potential temperature for the thermal. + do i=1,im + flg(i) = .true. + if(ublflg(i)) then + flg(i) = .false. + rbup(i) = rbsoil(i) + endif + enddo + do k = 2, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) + rbup(i) = (thvx(i,k)-thermal(i))* + & (g*zl(i,k)/thvx(i,1))/spdk2 + kpbl(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo + do i = 1,im + if(ublflg(i)) then + k = kpbl(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 + if(kpbl(i) <= 1) then + ublflg(i) = .false. + pblflg(i) = .false. + endif + endif + enddo +! +! look for stratocumulus +!> ## Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion +!! - Starting at the PBL top and going downward, if the level is less than 2.5 km and \f$q_l>q_{l,cr}\f$ then set kcld = k (find the cloud top index in the PBL). If no cloud water above the threshold is found, scuflg is set to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= lcld(i)) then + if(qlx(i,k).ge.qlcr) then + kcld(i)=k + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. + enddo +!> - Starting at the PBL top and going downward, if the level is less than the cloud top, find the level of the minimum radiative heating rate within the cloud. If the level of the minimum is the lowest model level or the minimum radiative heating rate is positive, then set scuflg to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= kcld(i)) then + if(qlx(i,k) >= qlcr) then + if(radx(i,k) < radmin(i)) then + radmin(i)=radx(i,k) + krad(i)=k + endif + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. krad(i) <= 1) scuflg(i)=.false. + if(scuflg(i) .and. radmin(i)>=0.) scuflg(i)=.false. + enddo +!> - Starting at the PBL top and going downward, count the number of levels below the minimum radiative heating rate level that have cloud water above the threshold. If there are none, then set the scuflg to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,2,-1 + do i = 1, im + if(flg(i) .and. k <= krad(i)) then + if(qlx(i,k) >= qlcr) then + icld(i)=icld(i)+1 + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. icld(i) < 1) scuflg(i)=.false. + enddo +!> - Find the height of the interface where the minimum in radiative heating rate is located. If this height is less than the second model interface height, then set the scuflg to F. + do i = 1, im + if(scuflg(i)) then + hrad(i) = zi(i,krad(i)+1) +! hradm(i)= zl(i,krad(i)) + endif + enddo +! + do i = 1, im + if(scuflg(i) .and. hrad(i) - Calculate the hypothetical \f$\theta_v\f$ at the minimum radiative heating level that a parcel would reach due to radiative cooling after a typical cloud turnover time spent at that level. + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem = zi(i,k+1)-zi(i,k) + tem1 = cldtime*radmin(i)/tem + thlvx1(i) = thlvx(i,k)+tem1 +! if(thlvx1(i) > thlvx(i,k-1)) scuflg(i)=.false. + endif + enddo +!> - Determine the distance that a parcel would sink downwards starting from the level of minimum radiative heating rate by comparing the hypothetical minimum \f$\theta_v\f$ calculated above with the environmental \f$\theta_v\f$. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= krad(i))then + if(thlvx1(i) <= thlvx(i,k))then + tem=zi(i,k+1)-zi(i,k) + zd(i)=zd(i)+tem + else + flg(i)=.false. + endif + endif + enddo + enddo +!> - Calculate the cloud thickness, where the cloud top is the in-cloud minimum radiative heating level and the bottom is determined previously. + do i = 1, im + if(scuflg(i))then + kk = max(1, krad(i)+1-icld(i)) + zdd(i) = hrad(i)-zi(i,kk) + endif + enddo +!> - Find the largest between the cloud thickness and the distance of a sinking parcel, then determine the smallest of that number and the height of the minimum in radiative heating rate. Set this number to \f$zd\f$. Using \f$zd\f$, calculate the characteristic velocity scale of cloud-top radiative cooling-driven turbulence. + do i = 1, im + if(scuflg(i))then + zd(i) = max(zd(i),zdd(i)) + zd(i) = min(zd(i),hrad(i)) + tem = govrth(i)*zd(i)*(-radmin(i)) + vrad(i)= tem**h1 + endif + enddo +! +! compute inverse prandtl number +!> ## Calculate the inverse Prandtl number +!! For an unstable PBL, the Prandtl number is calculated according to Hong and Pan (1996) \cite hong_and_pan_1996, equation 10, whereas for a stable boundary layer, the Prandtl number is simply \f$Pr = \frac{\phi_h}{\phi_m}\f$. + do i = 1, im + if(ublflg(i)) then + tem = phih(i)/phim(i)+cfac*vk*sfcfrac + else + tem = phih(i)/phim(i) + endif + prinv(i) = 1.0 / tem + prinv(i) = min(prinv(i),prmax) + prinv(i) = max(prinv(i),prmin) + enddo + do i = 1, im + if(zol(i) > zolcr) then + kpbl(i) = 1 + endif + enddo + +!!! HAFS PBL, Bgin adjustment +! RGF determine wspd at roughly 500 m above surface, or as close as possible, +! reuse SPDK2 +! zi(i,k) is AGL, right? May not matter if applied only to water grid points + if(moninq_fac.lt.0)then + + DO I=1,IM + SPDK2 = 0. + WSPM(i,1) = 0. + DO K = 1, KMPBL ! kmpbl is like a max possible pbl height + if(zi(i,k).le.500.and.zi(i,k+1).gt.500.)then ! find level bracketing 500 m + SPDK2 = SQRT(U1(i,k)*U1(i,k)+V1(i,k)*V1(i,k)) ! wspd near 500 m + WSPM(i,1) = SPDK2/0.6 ! now the Km limit for 500 m. just store in K=1 + WSPM(i,2) = float(k) ! height of level at gridpoint i. store in K=2 +! if(i.eq.25) print *,' IK ',i,k,' ZI ',zi(i,k), ' WSPM1 ',wspm(i,1),' +! KMPBL ',kmpbl,' KPBL ',kpbl(i) + endif + ENDDO + ENDDO ! i + + endif ! moninq_fac < 0 + + +! +! compute diffusion coefficients below pbl +!> ## Compute diffusion coefficients below the PBL top +!! Below the PBL top, the diffusion coefficients (\f$K_m\f$ and \f$K_h\f$) are calculated according to equation 2 in Hong and Pan (1996) \cite hong_and_pan_1996 where a different value for \f$w_s\f$ (PBL vertical velocity scale) is used depending on the PBL stability. \f$K_h\f$ is calculated from \f$K_m\f$ using the Prandtl number. The calculated diffusion coefficients are checked so that they are bounded by maximum values and the local background diffusion coefficients. + + IF (ALPHA > 0) THEN ! AAAAAAAAAAAAAAAAAAAAAAAAAAA + + do k = 1, kmpbl + do i=1,im + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif + enddo + enddo + + ELSE ! ALPHA <0 AAAAAAAAAAAAA + + do i=1,im + do k = 1, kmpbl + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + ! tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg + tem = zi(i,k+1) * (zfac**pfac) * abs( moninq_fac) + +!!!! CHANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W + if(useshape .ge. 1) then + sz2h=(ZI(I,K+1)-ZL(I,1))/(HPBL(I)-ZL(I,1)) + sz2h=max(sz2h,zfmin) + sz2h=min(sz2h,1.0) + zfac=(1.0-sz2h)**pfac +! smax=0.148 !! max value of this shape function + smax=0.148 !! max value of this shape function + hmax=0.333 !! roughly height if max K + skmax=hmax*(1.0-hmax)**pfac + sksfc=min(ZI(I,2)/HPBL(I),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) + sksfc=sksfc*(1-sksfc)**pfac + + zfac=max(zfac,zfmin) + ashape=max(ABS(moninq_fac),0.2) ! should not be smaller than 0.2, otherwise too much adjustment(?) + if(useshape ==1) then + ashape=( 1.0 - ((sz2h*zfac/smax)**0.25) + & *( 1.0 - ashape ) ) + tem = zi(i,k+1) * (zfac) * ashape + endif + + if (useshape == 2) then !only adjus K that is > K_surface_top + ashape1=1.0 + if (skmax > sksfc) ashape1=(skmax*ashape-sksfc)/ + & (skmax-sksfc) + skminusk0=ZI(I,K+1)*zfac - HPBL(i)*sksfc + tem = zi(i,k+1) * (zfac) ! no adjustment + if (skminusk0 > 0) then ! only adjust K which is > surface top K + tem = skminusk0*ashape1 + HPBL(i)*sksfc + endif + endif + endif ! endif useshape>1 +!!!! END OF CHAGES , WANG W + + + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif + enddo !K loop + +! possible modification of first guess DKU, under certain conditions +! (1) this applies only to columns over water + + IF(islimsk(i).eq.0)then ! sea only + +! (2) alpha test +! if alpha < 0, find alpha for each column and do the loop again +! if alpha > 0, we are finished + + + if(alpha.lt.0)then ! variable alpha test + +! k-level of layer around 500 m + kLOC = INT(WSPM(i,2)) +! print *,' kLOC ',kLOC,' KPBL ',KPBL(I) + +! (3) only do this IF KPBL(I) >= kLOC. Otherwise, we are finished, with DKU as +! if alpha = +1 + + if(KPBL(I).gt.kLOC)then + + xDKU = DKU(i,kLOC) ! Km at k-level +! (4) DKU check. +! WSPM(i,1) is the KM cap for the 500-m level. +! if DKU at 500-m level < WSPM(i,1), do not limit Km ANYWHERE. Alpha = +! abs(alpha). No need to recalc. +! if DKU at 500-m level > WSPM(i,1), then alpha = WSPM(i,1)/xDKU for entire +! column + if(xDKU.ge.WSPM(i,1)) then ! ONLY if DKU at 500-m exceeds cap, otherwise already done + + WSPM(i,3) = WSPM(i,1)/xDKU ! ratio of cap to Km at k-level, store in WSPM(i,3) + !WSPM(i,4) = amin1(WSPM(I,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed + WSPM(i,4) = min(WSPM(I,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed + !! recalculate K capped by WSPM(i,1) + do k = 1, kmpbl + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + ! tem = zi(i,k+1) * (zfac**pfac) + tem = zi(i,k+1) * (zfac**pfac) * WSPM(i,4) + + +!!!! CHANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W + if(useshape .ge. 1) then + sz2h=(ZI(I,K+1)-ZL(I,1))/(HPBL(I)-ZL(I,1)) + sz2h=max(sz2h,zfmin) + sz2h=min(sz2h,1.0) + zfac=(1.0-sz2h)**pfac + smax=0.148 !! max value of this shape function + hmax=0.333 !! roughly height if max K + skmax=hmax*(1.0-hmax)**pfac + sksfc=min(ZI(I,2)/HPBL(I),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) + sksfc=sksfc*(1-sksfc)**pfac + + zfac=max(zfac,zfmin) + ashape=max(WSPM(i,4),0.2) !! adjustment coef should not smaller than 0.2 + if(useshape ==1) then + ashape=( 1.0 - ((sz2h*zfac/smax)**0.25) + & *( 1.0 - ashape ) ) + tem = zi(i,k+1) * (zfac) * ashape +! if(k ==5) write(0,*)'min alf, height-depend alf',WSPM(i,4),ashape + endif ! endif useshape=1 + + if (useshape == 2) then !only adjus K that is > K_surface_top + ashape1=1.0 + if (skmax > sksfc) ashape1=(skmax*ashape-sksfc)/ + & (skmax-sksfc) + + skminusk0=ZI(I,K+1)*zfac - HPBL(i)*sksfc + tem = zi(i,k+1) * (zfac) ! no adjustment +! if(k ==5) write(0,*)'before, dku,ashape,ashpe1', +! & tem*wscaleu(i)*vk,ashape,ashape1 + if (skminusk0 > 0) then ! only adjust K which is > surface top K + tem = skminusk0*ashape1 + HPBL(i)*sksfc + endif +! if(k ==5)write(0,*) +! & 'after,dku,k_sfc,skmax,sksfc,zi(2),hpbl' +! & ,tem*wscaleu(i)*vk,WSCALEU(I)*VK*HPBL(i)*sksfc, skmax, +! & sksfc,ZI(I,2),HPBL(I) + + endif ! endif useshape=2 + endif ! endif useshape>1 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif + enddo !K loop + endif ! xDKU.ge.WSPM(i,1) + endif ! KPBL(I).ge.kLOC + endif ! alpha < 0 + endif ! islimsk=0 + + enddo !I loop + ENDIF !AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + +! +! compute diffusion coefficients based on local scheme above pbl +!> ## Compute diffusion coefficients above the PBL top +!! Diffusion coefficients above the PBL top are computed as a function of local stability (gradient Richardson number), shear, and a length scale from Louis (1979) \cite louis_1979 : +!! \f[ +!! K_{m,h}=l^2f_{m,h}(Ri_g)\left|\frac{\partial U}{\partial z}\right| +!! \f] +!! The functions used (\f$f_{m,h}\f$) depend on the local stability. First, the gradient Richardson number is calculated as +!! \f[ +!! Ri_g=\frac{\frac{g}{T}\frac{\partial \theta_v}{\partial z}}{\frac{\partial U}{\partial z}^2} +!! \f] +!! where \f$U\f$ is the horizontal wind. For the unstable case (\f$Ri_g < 0\f$), the Richardson number-dependent functions are given by +!! \f[ +!! f_h(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.286\sqrt{\left|Ri_g\right|}}\\ +!! \f] +!! \f[ +!! f_m(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.746\sqrt{\left|Ri_g\right|}}\\ +!! \f] +!! For the stable case, the following formulas are used +!! \f[ +!! f_h(Ri_g) = \frac{1}{\left(1 + 5Ri_g\right)^2}\\ +!! \f] +!! \f[ +!! Pr = \frac{K_h}{K_m} = 1 + 2.1Ri_g +!! \f] +!! The source for the formulas used for the Richardson number-dependent functions is unclear. They are different than those used in Hong and Pan (1996) \cite hong_and_pan_1996 as the previous documentation suggests. They follow equation 14 of Louis (1979) \cite louis_1979 for the unstable case, but it is unclear where the values of the coefficients \f$b\f$ and \f$c\f$ from that equation used in this scheme originate. Finally, the length scale, \f$l\f$ is calculated according to the following formula from Hong and Pan (1996) \cite hong_and_pan_1996 +!! \f[ +!! \frac{1}{l} = \frac{1}{kz} + \frac{1}{l_0}\\ +!! \f] +!! \f[ +!! or\\ +!! \f] +!! \f[ +!! l=\frac{l_0kz}{l_0+kz} +!! \f] +!! where \f$l_0\f$ is currently 30 m for stable conditions and 150 m for unstable. Finally, the diffusion coefficients are kept in a range bounded by the background diffusion and the maximum allowable values. + do k = 1, km1 + do i=1,im + if(k >= kpbl(i)) then + bvf2 = g*bf(i,k)*ti(i,k) + ri = max(bvf2/shr2(i,k),rimin) + zk = vk*zi(i,k+1) + if(ri < 0.) then ! unstable regime + rl2 = zk*rlamun/(rlamun+zk) + dk = rl2*rl2*sqrt(shr2(i,k)) + sri = sqrt(-ri) +! dku(i,k) = xkzmo(i,k) + dk*(1+8.*(-ri)/(1+1.746*sri)) +! dkt(i,k) = xkzo(i,k) + dk*(1+8.*(-ri)/(1+1.286*sri)) + dku(i,k) = dk*(1+8.*(-ri)/(1+1.746*sri)) + dkt(i,k) = dk*(1+8.*(-ri)/(1+1.286*sri)) + else ! stable regime + rl2 = zk*rlam/(rlam+zk) +!! tem = rlam * sqrt(0.01*prsi(i,k)) +!! rl2 = zk*tem/(tem+zk) + dk = rl2*rl2*sqrt(shr2(i,k)) + tem1 = dk/(1+5.*ri)**2 +! + if(k >= kpblx(i)) then + prnum = 1.0 + 2.1*ri + prnum = min(prnum,prmax) + else + prnum = 1.0 + endif +! dku(i,k) = xkzmo(i,k) + tem1 * prnum +! dkt(i,k) = xkzo(i,k) + tem1 + dku(i,k) = tem1 * prnum + dkt(i,k) = tem1 + endif +! + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) +! + endif +! + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute components for mass flux mixing by large thermals +!> ## If the PBL is convective, call the mass flux scheme to replace the countergradient terms. +!! If the PBL is convective, the updraft properties are initialized to be the same as the state variables and the subroutine mfpbl is called. + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + tcko(i,k) = t1(i,k) + ucko(i,k) = u1(i,k) + vcko(i,k) = v1(i,k) + xmf(i,k) = 0. + endif + enddo + enddo + do kk = 1, ntrac + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + qcko(i,k,kk) = q1(i,k,kk) + endif + enddo + enddo + enddo +!> For details of the mfpbl subroutine, step into its documentation ::mfpbl + call mfpbl(im,ix,km,ntrac,dt2,pcnvflg, + & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, + & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute diffusion coefficients for cloud-top driven diffusion +! if the condition for cloud-top instability is met, +! increase entrainment flux at cloud top +! +!> ## Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs +!! If a stratocumulus layer has been identified in the PBL, the diffusion coefficients in the PBL are modified in the following way. +!! +!! -# First, the criteria for CTEI is checked, using the threshold from equation 13 of Macvean and Mason (1990) \cite macvean_and_mason_1990. If the criteria is met, the cloud top diffusion is increased: +!! \f[ +!! K_h^{Sc} = -c\frac{\Delta F_R}{\rho c_p}\frac{1}{\frac{\partial \theta_v}{\partial z}} +!! \f] +!! where the constant \f$c\f$ is set to 0.2 if the CTEI criterion is not met and 1.0 if it is. +!! +!! -# Calculate the diffusion coefficients due to stratocumulus mixing according to equation 5 in Lock et al. (2000) \cite lock_et_al_2000 for every level below the stratocumulus top using the characteristic stratocumulus velocity scale previously calculated. The diffusion coefficient for momentum is calculated assuming a constant inverse Prandtl number of 0.75. + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem = thetae(i,k) - thetae(i,k+1) + tem1 = qtx(i,k) - qtx(i,k+1) + if (tem > 0. .and. tem1 > 0.) then + cteit= cp*tem/(hvap*tem1) + if(cteit > actei) rent(i) = rentf2 + endif + endif + enddo + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem1 = max(bf(i,k),tdzmin) + ckt(i,k) = -rent(i)*radmin(i)/tem1 + cku(i,k) = ckt(i,k) + endif + enddo +! + do k = 1, kmpbl + do i=1,im + if(scuflg(i) .and. k < krad(i)) then + tem1=hrad(i)-zd(i) + tem2=zi(i,k+1)-tem1 + if(tem2 > 0.) then + ptem= tem2/zd(i) + if(ptem.ge.1.) ptem= 1. + ptem= tem2*ptem*sqrt(1.-ptem) + ckt(i,k) = radfac*vk*vrad(i)*ptem + cku(i,k) = 0.75*ckt(i,k) + ckt(i,k) = max(ckt(i,k),dkmin) + ckt(i,k) = min(ckt(i,k),dkmax) + cku(i,k) = max(cku(i,k),dkmin) + cku(i,k) = min(cku(i,k),dkmax) + endif + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!> After \f$K_h^{Sc}\f$ has been determined from the surface to the top of the stratocumulus layer, it is added to the value for the diffusion coefficient calculated previously using surface-based mixing [see equation 6 of Lock et al. (2000) \cite lock_et_al_2000 ]. + do k = 1, kmpbl + do i=1,im + if(scuflg(i)) then + ! dkt(i,k) = dkt(i,k)+ckt(i,k) + ! dku(i,k) = dku(i,k)+cku(i,k) + !! if K needs to be adjusted by alpha, then no need to add this term + if(alpha .ge. 0.0) dkt(i,k) = dkt(i,k)+ckt(i,k) + if(alpha .ge. 0.0) dku(i,k) = dku(i,k)+cku(i,k) + + dkt(i,k) = min(dkt(i,k),dkmax) + dku(i,k) = min(dku(i,k),dkmax) + endif + enddo + enddo +! +! compute tridiagonal matrix elements for heat and moisture +! +!> ## Solve for the temperature and moisture tendencies due to vertical mixing. +!! The tendencies of heat, moisture, and momentum due to vertical diffusion are calculated using a two-part process. First, a solution is obtained using an implicit time-stepping scheme, then the time tendency terms are "backed out". The tridiagonal matrix elements for the implicit solution for temperature and moisture are prepared in this section, with differing algorithms depending on whether the PBL was convective (substituting the mass flux term for counter-gradient term), unstable but not convective (using the computed counter-gradient terms), or stable (no counter-gradient terms). + do i=1,im + ad(i,1) = 1. + a1(i,1) = t1(i,1) + beta(i) * heat(i) + a2(i,1) = q1(i,1,1) + beta(i) * evap(i) + enddo + + if(ntrac >= 2) then + do k = 2, ntrac + is = (k-1) * km + do i = 1, im + a2(i,1+is) = q1(i,1,k) + enddo + enddo + endif +! + do k = 1,km1 + do i = 1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dkt(i,k) * rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 +! + if(pcnvflg(i) .and. k < kpbl(i)) then + tem2 = dsig * rdz + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ad(i,k) = ad(i,k)-au(i,k)-ptem1 + ad(i,k+1) = 1.-al(i,k)+ptem2 + au(i,k) = au(i,k)-ptem1 + al(i,k) = al(i,k)+ptem2 + ptem = tcko(i,k) + tcko(i,k+1) + dsdzt = tem1 * gocp + a1(i,k) = a1(i,k)+dtodsd*dsdzt-ptem1*ptem + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt+ptem2*ptem + ptem = qcko(i,k,1) + qcko(i,k+1,1) + a2(i,k) = a2(i,k) - ptem1 * ptem + a2(i,k+1) = q1(i,k+1,1) + ptem2 * ptem + elseif(ublflg(i) .and. k < kpbl(i)) then + ptem1 = dsig * dktx(i,k) * rdz + tem = 1.0 / hpbl(i) + dsdzt = tem1 * gocp - ptem1 * hgamt(i) * tem + dsdzq = - ptem1 * hgamq(i) * tem + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + a1(i,k) = a1(i,k)+dtodsd*dsdzt + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + a2(i,k) = a2(i,k)+dtodsd*dsdzq + a2(i,k+1) = q1(i,k+1,1)-dtodsu*dsdzq + else + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + dsdzt = tem1 * gocp + a1(i,k) = a1(i,k)+dtodsd*dsdzt + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + a2(i,k+1) = q1(i,k+1,1) + endif +! + enddo + enddo +! + if(ntrac >= 2) then + do kk = 2, ntrac + is = (kk-1) * km + do k = 1, km1 + do i = 1, im + if(pcnvflg(i) .and. k < kpbl(i)) then + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + tem = dsig * rdzt(i,k) + ptem = 0.5 * tem * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem1 = qcko(i,k,kk) + qcko(i,k+1,kk) + a2(i,k+is) = a2(i,k+is) - ptem1*tem1 + a2(i,k+1+is)= q1(i,k+1,kk) + ptem2*tem1 + else + a2(i,k+1+is) = q1(i,k+1,kk) + endif + enddo + enddo + enddo + endif +! +! solve tridiagonal problem for heat and moisture +! +!> The tridiagonal system is solved by calling the internal ::tridin subroutine. + call tridin99(im,km,ntrac,al,ad,au,a1,a2,au,a1,a2) + +! +! recover tendencies of heat and moisture +! +!> After returning with the solution, the tendencies for temperature and moisture are recovered. + do k = 1,km + do i = 1,im + ttend = (a1(i,k)-t1(i,k)) * rdt + qtend = (a2(i,k)-q1(i,k,1))*rdt + tau(i,k) = tau(i,k)+ttend + rtg(i,k,1) = rtg(i,k,1)+qtend + dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend + dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend + enddo + enddo + if(ntrac >= 2) then + do kk = 2, ntrac + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (a2(i,k+is)-q1(i,k,kk))*rdt + rtg(i,k,kk) = rtg(i,k,kk)+qtend + enddo + enddo + enddo + endif +! +! compute tke dissipation rate +! +!> ## Calculate heating due to TKE dissipation and add to the tendency for temperature +!! Following Han et al. (2015) \cite han_et_al_2015 , turbulence dissipation contributes to the tendency of temperature in the following way. First, turbulence dissipation is calculated by equation 17 of Han et al. (2015) \cite han_et_al_2015 for the PBL and equation 16 for the surface layer. + if(dspheat) then +! + do k = 1,km1 + do i = 1,im + diss(i,k) = dku(i,k)*shr2(i,k)-g*ti(i,k)*dkt(i,k)*bf(i,k) +! diss(i,k) = dku(i,k)*shr2(i,k) + enddo + enddo +! +! add dissipative heating at the first model layer +! +!> Next, the temperature tendency is updated following equation 14. + do i = 1,im + tem = govrth(i)*sflux(i) + tem1 = tem + stress(i)*spd1(i)/zl(i,1) + tem2 = 0.5 * (tem1+diss(i,1)) + tem2 = max(tem2, 0.) + ttend = tem2 / cp + if (alpha .gt. 0.0) then + tau(i,1) = tau(i,1)+0.5*ttend + else + tau(i,1) = tau(i,1)+0.7*ttend ! in HWRF/HMON, use 0.7 + endif + enddo +! +! add dissipative heating above the first model layer +! + do k = 2,km1 + do i = 1,im + tem = 0.5 * (diss(i,k-1)+diss(i,k)) + tem = max(tem, 0.) + ttend = tem / cp + tau(i,k) = tau(i,k) + 0.5*ttend + enddo + enddo +! + endif +! +! compute tridiagonal matrix elements for momentum +! +!> ## Solve for the horizontal momentum tendencies and add them to the output tendency terms +!! As with the temperature and moisture tendencies, the horizontal momentum tendencies are calculated by solving tridiagonal matrices after the matrices are prepared in this section. + do i=1,im + ad(i,1) = 1.0 + beta(i) * stress(i) / spd1(i) + a1(i,1) = u1(i,1) + a2(i,1) = v1(i,1) + enddo +! + do k = 1,km1 + do i=1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig*dku(i,k)*rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 +! + if(pcnvflg(i) .and. k < kpbl(i)) then + tem2 = dsig * rdz + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ad(i,k) = ad(i,k)-au(i,k)-ptem1 + ad(i,k+1) = 1.-al(i,k)+ptem2 + au(i,k) = au(i,k)-ptem1 + al(i,k) = al(i,k)+ptem2 + ptem = ucko(i,k) + ucko(i,k+1) + a1(i,k) = a1(i,k) - ptem1 * ptem + a1(i,k+1) = u1(i,k+1) + ptem2 * ptem + ptem = vcko(i,k) + vcko(i,k+1) + a2(i,k) = a2(i,k) - ptem1 * ptem + a2(i,k+1) = v1(i,k+1) + ptem2 * ptem + else + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + a1(i,k+1) = u1(i,k+1) + a2(i,k+1) = v1(i,k+1) + endif +! + enddo + enddo +! +! solve tridiagonal problem for momentum +! + call tridi299(im,km,al,ad,au,a1,a2,au,a1,a2) +! +! recover tendencies of momentum +! +!> Finally, the tendencies are recovered from the tridiagonal solutions. + do k = 1,km + do i = 1,im + utend = (a1(i,k)-u1(i,k))*rdt + vtend = (a2(i,k)-v1(i,k))*rdt + du(i,k) = du(i,k) + utend + dv(i,k) = dv(i,k) + vtend + dusfc(i) = dusfc(i) + conw*del(i,k)*utend + dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend +! +! for dissipative heating for ecmwf model +! +! tem1 = 0.5*(a1(i,k)+u1(i,k)) +! tem2 = 0.5*(a2(i,k)+v1(i,k)) +! diss(i,k) = -(tem1*utend+tem2*vtend) +! diss(i,k) = max(diss(i,k),0.) +! ttend = diss(i,k) / cp +! tau(i,k) = tau(i,k) + ttend +! + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do i = 1, im + hpbl(i) = hpblx(i) + kpbl(i) = kpblx(i) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + return + end subroutine hedmf_hafs_run + +!> @} + +c----------------------------------------------------------------------- +!> \ingroup PBL +!! \brief Routine to solve the tridiagonal system to calculate temperature and moisture at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. +!! +!! Origin of subroutine unknown. + subroutine tridi299(l,n,cl,cm,cu,r1,r2,au,a1,a2) +cc + use machine , only : kind_phys + implicit none + integer k,n,l,i + real(kind=kind_phys) fk +cc + real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n), & + & au(l,n-1),a1(l,n),a2(l,n) +c----------------------------------------------------------------------- + do i=1,l + fk = 1./cm(i,1) + au(i,1) = fk*cu(i,1) + a1(i,1) = fk*r1(i,1) + a2(i,1) = fk*r2(i,1) + enddo + do k=2,n-1 + do i=1,l + fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fk*cu(i,k) + a1(i,k) = fk*(r1(i,k)-cl(i,k)*a1(i,k-1)) + a2(i,k) = fk*(r2(i,k)-cl(i,k)*a2(i,k-1)) + enddo + enddo + do i=1,l + fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + a1(i,n) = fk*(r1(i,n)-cl(i,n)*a1(i,n-1)) + a2(i,n) = fk*(r2(i,n)-cl(i,n)*a2(i,n-1)) + enddo + do k=n-1,1,-1 + do i=1,l + a1(i,k) = a1(i,k)-au(i,k)*a1(i,k+1) + a2(i,k) = a2(i,k)-au(i,k)*a2(i,k+1) + enddo + enddo +c----------------------------------------------------------------------- + return + end subroutine tridi299 +c----------------------------------------------------------------------- +!> \ingroup PBL +!! \brief Routine to solve the tridiagonal system to calculate u- and v-momentum at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. +!! +!! Origin of subroutine unknown. + subroutine tridin99(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) +cc + use machine , only : kind_phys + implicit none + integer is,k,kk,n,nt,l,i + real(kind=kind_phys) fk(l) +cc + real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & + & r1(l,n), r2(l,n*nt), & + & au(l,n-1), a1(l,n), a2(l,n*nt), & + & fkk(l,2:n-1) +c----------------------------------------------------------------------- + do i=1,l + fk(i) = 1./cm(i,1) + au(i,1) = fk(i)*cu(i,1) + a1(i,1) = fk(i)*r1(i,1) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + a2(i,1+is) = fk(i) * r2(i,1+is) + enddo + enddo + do k=2,n-1 + do i=1,l + fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fkk(i,k)*cu(i,k) + a1(i,k) = fkk(i,k)*(r1(i,k)-cl(i,k)*a1(i,k-1)) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=2,n-1 + do i=1,l + a2(i,k+is) = fkk(i,k)*(r2(i,k+is)-cl(i,k)*a2(i,k+is-1)) + enddo + enddo + enddo + do i=1,l + fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + a1(i,n) = fk(i)*(r1(i,n)-cl(i,n)*a1(i,n-1)) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + a2(i,n+is) = fk(i)*(r2(i,n+is)-cl(i,n)*a2(i,n+is-1)) + enddo + enddo + do k=n-1,1,-1 + do i=1,l + a1(i,k) = a1(i,k) - au(i,k)*a1(i,k+1) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=n-1,1,-1 + do i=1,l + a2(i,k+is) = a2(i,k+is) - au(i,k)*a2(i,k+is+1) + enddo + enddo + enddo +c----------------------------------------------------------------------- + return + end subroutine tridin99 + +!> @} + + end module hedmf_hafs diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta new file mode 100644 index 000000000..bc1461ada --- /dev/null +++ b/physics/moninedmf_hafs.meta @@ -0,0 +1,526 @@ +[ccpp-arg-table] + name = hedmf_hafs_init + type = scheme +[moninq_fac] + standard_name = atmosphere_diffusivity_coefficient_factor + long_name = multiplicative constant for atmospheric diffusivities + 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 + 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 = hedmf_hafs_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = cloud condensate index in tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[dv] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tau] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtg] + 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 +[u1] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + long_name = total sky shortwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + long_name = total sky longwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psk] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the surface interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rbsoil] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsea] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spd1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + 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 +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + 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 + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspheat] + standard_name = flag_TKE_dissipation_heating + long_name = flag for using TKE dissipation heating + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hgamt] + standard_name = countergradient_mixing_term_for_temperature + long_name = countergradient mixing term for temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hgamq] + standard_name = countergradient_mixing_term_for_water_vapor + long_name = countergradient mixing term for water vapor + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dkt] + standard_name = atmosphere_heat_diffusivity + long_name = diffusivity for heat + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension_minus_one) + type = real + kind = kind_phys + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + 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 +[xkzminv] + standard_name = atmosphere_heat_diffusivity_background_maximum + long_name = maximum background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[moninq_fac] + standard_name = atmosphere_diffusivity_coefficient_factor + long_name = multiplicative constant for atmospheric diffusivities + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + 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 bf549a0227a2e53745518fc29a7883b76f746e88 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 18 Dec 2019 08:13:01 -0700 Subject: [PATCH 56/84] Apply missing code change for coupled model runs in physics/GFS_surface_generic.F90 --- physics/GFS_surface_generic.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index d8520c333..104d57f07 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -187,10 +187,11 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, if (cplflx) then do i=1,im - islmsk_cice(i) = int(slimskin_cpl(i)+0.5) - if(islmsk_cice(i) == 4)then - flag_cice(i) = .true. - ulwsfc_cice(i) = ulwsfcin_cpl(i) + islmsk_cice(i) = nint(slimskin_cpl(i)) + flag_cice(i) = (islmsk_cice(i) == 4) + + if (flag_cice(i)) then +! ulwsfc_cice(i) = ulwsfcin_cpl(i) dusfc_cice(i) = dusfcin_cpl(i) dvsfc_cice(i) = dvsfcin_cpl(i) dtsfc_cice(i) = dtsfcin_cpl(i) From 608b3c921a50f79212f3d40c9d3e9db33b9a35e0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 26 Dec 2019 10:30:18 -0700 Subject: [PATCH 57/84] Mirror updates to IPD physics in CCPP --- physics/GFS_DCNV_generic.F90 | 17 +++++++++----- physics/GFS_DCNV_generic.meta | 17 ++++++++++++++ physics/GFS_rrtmg_post.F90 | 42 ++++++++++++++++++++++++++--------- physics/GFS_rrtmg_post.meta | 8 +++++++ physics/sflx.f | 1 + 5 files changed, 70 insertions(+), 15 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 0acfbd19e..3778d8ed9 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -17,17 +17,17 @@ end subroutine GFS_DCNV_generic_pre_finalize !! \htmlinclude GFS_DCNV_generic_pre_run.html !! #endif - subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, & + 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, & - errmsg, errflg) + dqdti, errmsg, errflg) - use machine, only: kind_phys + use machine, only: kind_phys implicit none integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, isppt_deep + 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 @@ -37,9 +37,12 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_qv real(kind=kind_phys), dimension(im), intent(in) :: ca_deep + ! dqdti only allocated if cplchm is .true. + real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + real(kind=kind_phys), parameter :: zero = 0.0d0 integer :: i, k ! Initialize CCPP error handling variables @@ -70,7 +73,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, enddo endif - if (ldiag3d .or. isppt_deep) then + if (ldiag3d .or. cplchm .or. isppt_deep) then do k=1,levs do i=1,im save_qv(i,k) = gq0_water_vapor(i,k) @@ -78,6 +81,10 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, enddo endif + if (cplchm) then + dqdti = zero + endif + end subroutine GFS_DCNV_generic_pre_run end module GFS_DCNV_generic_pre diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index eae53a910..5e8377133 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -41,6 +41,14 @@ 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 [isppt_deep] standard_name = flag_for_combination_of_sppt_with_isppt_deep long_name = switch for combination with isppt_deep. @@ -130,6 +138,15 @@ kind = kind_phys intent = in optional = F +[dqdti] + standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection + long_name = instantaneous moisture tendency due to convection + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index dd9b9191e..db3de4f44 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -15,7 +15,7 @@ end subroutine GFS_rrtmg_post_init !! subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, & - cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, & + cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, nday, & errmsg, errflg) use machine, only: kind_phys @@ -41,7 +41,7 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & type(GFS_diag_type), intent(inout) :: Diag type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(in) :: scmpsw - integer, intent(in) :: im, lm, ltp, kt, kb, kd + integer, intent(in) :: im, lm, ltp, kt, kb, kd, nday real(kind=kind_phys), intent(in) :: raddt real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(in) :: aerodp @@ -152,18 +152,40 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop+kt) Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc+kb) Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) + enddo + enddo ! Anning adds optical depth and emissivity output - tem1 = 0. - tem2 = 0. - do k=ibtc,itop - tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel - tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel + if (Model%lsswr .and. (nday > 0)) then + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + tem1 = 0. + do k=ibtc,itop + tem1 = tem1 + cldtausw(i,k) ! approx .55 um channel + enddo + Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 enddo - Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 - Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) enddo - enddo + endif + + if (Model%lslwr) then + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + tem2 = 0. + do k=ibtc,itop + tem2 = tem2 + cldtaulw(i,k) ! approx 10. um channel + enddo + Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + enddo + enddo + endif + endif endif ! end_if_lssav diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index fdd2c2b55..61e89098d 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -180,6 +180,14 @@ kind = kind_phys intent = in optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + 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/sflx.f b/physics/sflx.f index 1654a8872..6a5914d02 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -359,6 +359,7 @@ subroutine gfssflx &! --- input runoff2 = 0.0 runoff3 = 0.0 snomlt = 0.0 + rc = 0.0 ! --- ... define local variable ice to achieve: ! sea-ice case, ice = 1 From 62fb748a3cacaa78e34dea5f1791eaed91af9094 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 28 Dec 2019 01:25:54 +0000 Subject: [PATCH 58/84] 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 59/84] 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 20ff17891f4d7a0ed1c59b585fbf6e5af5509739 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 11 Jan 2020 20:55:51 -0500 Subject: [PATCH 60/84] physics/samfdeepcnv.f, physics/satmedmfvdifq.F: GFSv16 updates copied from IPD --- physics/samfdeepcnv.f | 28 ++++++++++++++-------------- physics/satmedmfvdifq.F | 15 +++++++++------ 2 files changed, 23 insertions(+), 20 deletions(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index bb5d5deb1..83e1efb80 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -1554,22 +1554,22 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & enddo enddo do i = 1, im - betamn = betas - if(islimsk(i) == 1) betamn = betal - if(ntk > 0) then - betamx = betamn + dbeta - if(tkemean(i) > tkemx) then - beta = betamn - else if(tkemean(i) < tkemn) then - beta = betamx + if(cnvflg(i)) then + betamn = betas + if(islimsk(i) == 1) betamn = betal + if(ntk > 0) then + betamx = betamn + dbeta + if(tkemean(i) > tkemx) then + beta = betamn + else if(tkemean(i) < tkemn) then + beta = betamx + else + tem = (betamx - betamn) * (tkemean(i) - tkemn) + beta = betamx - tem / dtke + endif else - tem = (betamx - betamn) * (tkemean(i) - tkemn) - beta = betamx - tem / dtke + beta = betamn endif - else - beta = betamn - endif - if(cnvflg(i)) then dz = (sumx(i)+zi(i,1))/float(kbcon(i)) tem = 1./float(kbcon(i)) xlamd(i) = (1.-beta**tem)/dz diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 546cefca6..f5a5f1f78 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -184,7 +184,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & buop, shrp, dtn, & prnum, prmax, prmin, prtke, & prscu, pr0, ri, - & dw2, dw2min, zk, + & dw2, dw2min, zk, & elmfac, elefac, dspmax, & alp, clwt, cql, & f0, robn, crbmin, crbmax, @@ -193,7 +193,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & epsi, beta, chx, cqx, & rdt, rdz, qmin, qlmin, & rimin, rbcr, rbint, tdzmin, - & rlmn, rlmn1, rlmx, elmx, + & rlmn, rlmn1, rlmn2, + & rlmx, elmx, & ttend, utend, vtend, qtend, & zfac, zfmin, vk, spdk2, & tkmin, tkminx, xkzinv, xkgdx, @@ -205,13 +206,14 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! real(kind=kind_phys) qlcr, zstblmax ! - real(kind=kind_phys) h1 + real(kind=kind_phys) h1 !! parameter(wfac=7.0,cfac=3.0) parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) parameter(vk=0.4,rimin=-100.) parameter(rbcr=0.25,zolcru=-0.02,tdzmin=1.e-3) - parameter(rlmn=30.,rlmn1=5.,rlmx=300.,elmx=300.) + parameter(rlmn=30.,rlmn1=5.,rlmn2=10.) + parameter(rlmx=300.,elmx=300.) parameter(prmin=0.25,prmax=4.0) parameter(pr0=1.0,prtke=1.0,prscu=0.67) parameter(f0=1.e-4,crbmin=0.15,crbmax=0.35) @@ -751,8 +753,9 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! if(tem1 > 1.e-5) then tem1 = tvx(i,k+1)-tvx(i,k) if(tem1 > 0.) then - xkzo(i,k) = min(xkzo(i,k),xkzinv) - xkzmo(i,k) = min(xkzmo(i,k),xkzinv) + xkzo(i,k) = min(xkzo(i,k), xkzinv) + xkzmo(i,k) = min(xkzmo(i,k), xkzinv) + rlmnz(i,k) = min(rlmnz(i,k), rlmn2) endif enddo enddo From ed16475af3e9710368b388614cf0c26d4830d24f Mon Sep 17 00:00:00 2001 From: "Chunxi.Zhang-NOAA" Date: Wed, 22 Jan 2020 16:42:07 +0000 Subject: [PATCH 61/84] Fixed the bugs related to the closure of shallow convection. --- physics/cu_ntiedtke.F90 | 40 +++++++++++++++++----------------------- physics/cu_ntiedtke.meta | 22 ++++++++++++++++++++-- 2 files changed, 37 insertions(+), 25 deletions(-) diff --git a/physics/cu_ntiedtke.F90 b/physics/cu_ntiedtke.F90 index 8e42ebdd4..c06f3ecc7 100644 --- a/physics/cu_ntiedtke.F90 +++ b/physics/cu_ntiedtke.F90 @@ -148,7 +148,7 @@ end subroutine cu_ntiedtke_finalize !----------------------------------------------------------------------- ! level 1 subroutine 'tiecnvn' !----------------------------------------------------------------- - subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & + subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & evap,hfx,zprecc,lmask,lq,ix,km,dt,dx,kbot,ktop,kcnv,& ktrac,ud_mf,dd_mf,dt_mf,cnvw,cnvc,errmsg,errflg) !----------------------------------------------------------------- @@ -162,13 +162,9 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & integer, dimension( lq ), intent(in) :: lmask real(kind=kind_phys), dimension( lq ), intent(in ) :: evap, hfx, dx real(kind=kind_phys), dimension( ix , km ), intent(inout) :: pu, pv, pt, pqv - real(kind=kind_phys), dimension( ix , km ), intent(in ) :: poz, prsl, pomg, pqvf, ptf + real(kind=kind_phys), dimension( ix , km ), intent(in ) :: tdi, qvdi, poz, prsl, pomg, pqvf, ptf real(kind=kind_phys), dimension( ix , km+1 ), intent(in ) :: pzz, prsi - ! DH* TODO - check dimensions of clw, ktrac+2 seems to be smaller - ! than the actual dimensions (ok as long as only indices 1 and 2 - ! are accessed here, and as long as these contain what is expected); - ! better to expand into the cloud-ice and cloud-water components *DH - real(kind=kind_phys), dimension( ix , km, ktrac+2 ), intent(inout ) :: clw + real(kind=kind_phys), dimension( ix , km, ktrac ), intent(inout ) :: clw integer, dimension( lq ), intent(out) :: kbot, ktop, kcnv real(kind=kind_phys), dimension( lq ), intent(out) :: zprecc @@ -188,7 +184,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & real(kind=kind_phys) ztp1(lq,km), zqp1(lq,km), ztu(lq,km), zqu(lq,km),& & zlu(lq,km), zlude(lq,km), zmfu(lq,km), zmfd(lq,km), zmfude_rate(lq,km),& & zqsat(lq,km), zrain(lq) - real(kind=kind_phys) pcen(lq,km,ktrac),ptenc(lq,km,ktrac) + real(kind=kind_phys) pcen(lq,km,ktrac-2),ptenc(lq,km,ktrac-2) integer icbot(lq), ictop(lq), ktype(lq), lndj(lq) logical locum(lq) @@ -246,9 +242,9 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & zqs = min(0.5,zqs) zcor = 1./(1.-vtmpc1*zqs) zqsat(j,k1)=zqs*zcor - pqte(j,k1)=pqvf(j,k) + pqte(j,k1)=pqvf(j,k)+(pqv(j,k)-qvdi(j,k))/ztmst zqq(j,k1) =pqte(j,k1) - ptte(j,k1)=ptf(j,k) + ptte(j,k1)=ptf(j,k)+(pt(j,k)-tdi(j,k))/ztmst ztt(j,k1) =ptte(j,k1) ud_mf(j,k1)=0. dd_mf(j,k1)=0. @@ -258,7 +254,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & end do end do - do n=1,ktrac + do n=1,ktrac-2 do k=1,km k1=km-k+1 do j=1,lq @@ -289,7 +285,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & & zqp1, pum1, pvm1, pverv, zqsat,& & pqhfl, ztmst, pap, paph, pgeo, & & ptte, pqte, pvom, pvol, prsfc,& - & pssfc, locum, ktrac, pcen, ptenc,& + & pssfc, locum, ktrac-2, pcen, ptenc,& & ktype, icbot, ictop, ztu, zqu, & & zlu, zlude, zmfu, zmfd, zrain,& & pcte, phhfl, lndj, pgeoh, zmfude_rate, dx) @@ -314,7 +310,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & pt(j,k) = ztp1(j,k1)+(ptte(j,k1)-ztt(j,k1))*ztmst pqv(j,k)= zqp1(j,k1)+(pqte(j,k1)-zqq(j,k1))*ztmst ud_mf(j,k)= zmfu(j,k1)*ztmst - dd_mf(j,k)= zmfd(j,k1)*ztmst + dd_mf(j,k)= -zmfd(j,k1)*ztmst dt_mf(j,k)= zmfude_rate(j,k1)*ztmst cnvw(j,k) = zlude(j,k1)*ztmst*g/(prsi(j,k)-prsi(j,k+1)) cnvc(j,k) = 0.04 * log(1. + 675. * ud_mf(j,k)) @@ -344,16 +340,14 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & end do endif ! - if (ktrac > 0) then - do n=1,ktrac - do k=1,km - k1=km-k+1 - do j=1,lq - clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst - end do - end do - end do - end if +! do n=1,ktrac-2 +! do k=1,km +! k1=km-k+1 +! do j=1,lq +! clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst +! end do +! end do +! end do ! return end subroutine cu_ntiedtke_run diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index da9219c10..4208b6e46 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -80,6 +80,24 @@ kind = kind_phys intent = inout optional = F +[tdi] + standard_name = air_temperature + long_name = mid-layer temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qvdi] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [pqvf] standard_name = moisture_tendency_due_to_dynamics long_name = moisture tendency due to dynamics only @@ -254,8 +272,8 @@ intent = out optional = F [ktrac] - standard_name = number_of_total_tracers - long_name = number of total tracers + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport units = count dimensions = () type = integer From 7db1d7ec8d2832cf372bc2d86d83a0d391c3cd0d Mon Sep 17 00:00:00 2001 From: "Chunxi.Zhang-NOAA" Date: Thu, 23 Jan 2020 15:40:02 +0000 Subject: [PATCH 62/84] Revised the code the new Tiedtke scheme --- physics/cu_ntiedtke.F90 | 57 +++++++++++++++++++++++++++++------------ 1 file changed, 40 insertions(+), 17 deletions(-) diff --git a/physics/cu_ntiedtke.F90 b/physics/cu_ntiedtke.F90 index c06f3ecc7..156e75c70 100644 --- a/physics/cu_ntiedtke.F90 +++ b/physics/cu_ntiedtke.F90 @@ -184,13 +184,13 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, real(kind=kind_phys) ztp1(lq,km), zqp1(lq,km), ztu(lq,km), zqu(lq,km),& & zlu(lq,km), zlude(lq,km), zmfu(lq,km), zmfd(lq,km), zmfude_rate(lq,km),& & zqsat(lq,km), zrain(lq) - real(kind=kind_phys) pcen(lq,km,ktrac-2),ptenc(lq,km,ktrac-2) + real(kind=kind_phys),allocatable :: pcen(:,:,:),ptenc(:,:,:) integer icbot(lq), ictop(lq), ktype(lq), lndj(lq) logical locum(lq) ! real(kind=kind_phys) ztmst,fliq,fice,ztc,zalf,tt - integer i,j,k,k1,n,km1 + integer i,j,k,k1,n,km1,ktracer real(kind=kind_phys) ztpp1 real(kind=kind_phys) zew,zqs,zcor ! @@ -254,16 +254,33 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, end do end do - do n=1,ktrac-2 - do k=1,km - k1=km-k+1 - do j=1,lq - pcen(j,k1,n) = clw(j,k,n+2) - ptenc(j,k1,n)= 0. + if(ktrac > 2) then + ktracer = ktrac - 2 + allocate(pcen(lq,km,ktracer)) + allocate(ptenc(lq,km,ktracer)) + do n=1,ktracer + do k=1,km + k1=km-k+1 + do j=1,lq + pcen(j,k1,n) = clw(j,k,n+2) + ptenc(j,k1,n)= 0. + end do end do end do - end do - + else + ktracer = 2 + allocate(pcen(lq,km,ktracer)) + allocate(ptenc(lq,km,ktracer)) + do n=1,ktracer + do k=1,km + do j=1,lq + pcen(j,k,n) = 0. + ptenc(j,k,n)= 0. + end do + end do + end do + end if + ! print *, "pgeo=",pgeo(1,:) ! print *, "pgeoh=",pgeoh(1,:) ! print *, "pap=",pap(1,:) @@ -285,7 +302,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, & zqp1, pum1, pvm1, pverv, zqsat,& & pqhfl, ztmst, pap, paph, pgeo, & & ptte, pqte, pvom, pvol, prsfc,& - & pssfc, locum, ktrac-2, pcen, ptenc,& + & pssfc, locum, ktracer, pcen, ptenc,& & ktype, icbot, ictop, ztu, zqu, & & zlu, zlude, zmfu, zmfd, zrain,& & pcte, phhfl, lndj, pgeoh, zmfude_rate, dx) @@ -339,15 +356,21 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, end do end do endif + ! -! do n=1,ktrac-2 -! do k=1,km -! k1=km-k+1 -! do j=1,lq -! clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst +! Currently, vertical mixing of tracers are turned off +! if(ktrac > 2) then +! do n=1,ktrac-2 +! do k=1,km +! k1=km-k+1 +! do j=1,lq +! clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst +! end do ! end do ! end do -! end do +! end if + deallocate(pcen) + deallocate(ptenc) ! return end subroutine cu_ntiedtke_run From 8223afed5e66b0e124702eab47feca896543a1ee Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 23 Jan 2020 11:50:13 -0700 Subject: [PATCH 63/84] physics/module_mp_thompson.F90: bugfix, remove threaded computation/read of lookup tables --- physics/module_mp_thompson.F90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index b1ca6ba07..dfaea5c2f 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -924,11 +924,6 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & call cpu_time(stime) -!$OMP parallel num_threads(threads) - -!$OMP sections - -!$OMP section !> - Call qr_acr_qg() to create rain collecting graupel & graupel collecting rain table if (mpirank==mpiroot) write(0,*) ' creating rain collecting graupel table' call cpu_time(stime) @@ -936,7 +931,6 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & call cpu_time(etime) if (mpirank==mpiroot) print '("Computing rain collecting graupel table took ",f10.3," seconds.")', etime-stime -!$OMP section !> - Call qr_acr_qs() to create rain collecting snow & snow collecting rain table if (mpirank==mpiroot) write (*,*) ' creating rain collecting snow table' call cpu_time(stime) @@ -944,10 +938,6 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & call cpu_time(etime) if (mpirank==mpiroot) print '("Computing rain collecting snow table took ",f10.3," seconds.")', etime-stime -!$OMP end sections - -!$OMP end parallel - !> - Call freezeh2o() to create cloud water and rain freezing (Bigg, 1953) table if (mpirank==mpiroot) write(0,*) ' creating freezing of water drops table' call cpu_time(stime) From 4c7dcaa8ae1e5465c5358647e75c239c6dafb30c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 27 Jan 2020 10:08:39 -0700 Subject: [PATCH 64/84] Add missing updates from IPD physics commit 7ffe6471c20404091fbbf8f321fbb9ee84a4f36d --- physics/module_gfdl_cloud_microphys.F90 | 2 +- physics/module_sf_noahmp_glacier.f90 | 0 physics/module_sf_noahmplsm.f90 | 0 physics/noahmp_tables.f90 | 0 physics/sfc_noahmp_drv.f | 0 5 files changed, 1 insertion(+), 1 deletion(-) mode change 100755 => 100644 physics/module_sf_noahmp_glacier.f90 mode change 100755 => 100644 physics/module_sf_noahmplsm.f90 mode change 100755 => 100644 physics/noahmp_tables.f90 mode change 100755 => 100644 physics/sfc_noahmp_drv.f diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/module_gfdl_cloud_microphys.F90 index 01ab4655c..5750d27fd 100644 --- a/physics/module_gfdl_cloud_microphys.F90 +++ b/physics/module_gfdl_cloud_microphys.F90 @@ -3320,7 +3320,7 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) else tc (k) = tk (k) - tice vti (k) = (3. + log10 (qi (k) * den (k))) * (tc (k) * (aa * tc (k) + bb) + cc) + dd * tc (k) + ee - vti (k) = vi0 * exp (log_10 * vti (k)) * 0.8 + vti (k) = vi0 * exp (log_10 * vti (k)) * 0.9 vti (k) = min (vi_max, max (vf_min, vti (k))) endif enddo diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 old mode 100755 new mode 100644 diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 old mode 100755 new mode 100644 diff --git a/physics/noahmp_tables.f90 b/physics/noahmp_tables.f90 old mode 100755 new mode 100644 diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f old mode 100755 new mode 100644 From 06aeee65e2f084acba2340a1245f1722df26eaf4 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Jan 2020 19:12:59 +0000 Subject: [PATCH 65/84] 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 66/84] 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 67/84] 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 68/84] 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 69/84] 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 f562f446ed6c7bbc567c02df4c18fd98b1eb35b2 Mon Sep 17 00:00:00 2001 From: "Shan.Sun" Date: Fri, 14 Feb 2020 16:15:25 +0000 Subject: [PATCH 70/84] Changing ice fraction definition --- physics/GFS_surface_composites.F90 | 36 +++++++++--------------------- 1 file changed, 11 insertions(+), 25 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 9636eb384..abeb9cc8b 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -70,38 +70,30 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan errmsg = '' errflg = 0 - if (frac_grid) then ! here cice is fraction of the whole grid that is ice + if (frac_grid) then ! cice is ice fraction wrt water area do i=1,im frland(i) = landfrac(i) if (frland(i) > zero) dry(i) = .true. - tem = one - frland(i) - if (tem > zero) then + if (frland(i) < one) then if (flag_cice(i)) then - if (cice(i) >= min_seaice*tem) then + if (cice(i) >= min_seaice) then icy(i) = .true. else cice(i) = zero endif else - if (cice(i) >= min_lakeice*tem) then + if (cice(i) >= min_lakeice) then icy(i) = .true. - cice(i) = cice(i)/tem ! cice is fraction of ocean/lake else cice(i) = zero endif endif - if (icy(i)) tsfco(i) = max(tsfco(i), tisfc(i), tgice) + if (cice(i) < one ) then + wet(i)=.true. !there is some open ocean/lake water! + if (.not. cplflx) tsfco(i) = max(tsfco(i), tisfc(i), tgice) + end if else cice(i) = zero - endif - - ! ocean/lake area that is not frozen - tem = max(zero, tem - cice(i)) - - if (tem > zero) 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) endif enddo @@ -144,7 +136,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan tprcp_ocn(i) = tprcp(i) tprcp_lnd(i) = tprcp(i) tprcp_ice(i) = tprcp(i) - if (wet(i)) then ! Water + if (wet(i) .or. icy(i)) then ! Water zorl_ocn(i) = zorlo(i) tsfc_ocn(i) = tsfco(i) tsurf_ocn(i) = tsfco(i) @@ -335,8 +327,8 @@ subroutine GFS_surface_composites_post_run ( ! Three-way composites (fields from sfc_diff) txl = landfrac(i) - txi = cice(i) ! here cice is grid fraction that is ice - txo = one - txl - txi + txi = cice(i)*(one - txl) ! txi = ice fraction wrt whole cell + txo = max(zero, one - txl - txi) zorl(i) = txl*zorl_lnd(i) + txi*zorl_ice(i) + txo*zorl_ocn(i) cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_ocn(i) @@ -394,12 +386,6 @@ subroutine GFS_surface_composites_post_run ( if (.not. flag_cice(i)) then if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array - ! DH* NOT NEEDED? Sfcprop%hice(i) = zice(i) -! DH* is this correct? can we update cice in place or do we need separate variables as for IPD? -!! Sfcprop%fice(i) = fice(i) * Sfcprop%lakefrac(i) ! fice is fraction of lake area that is frozen -! Sfcprop%fice(i) = fice(i) * (one-Sfcprop%landfrac(i)) ! fice is fraction of wet area that is frozen - cice(i) = cice(i) * (1.0-landfrac(i)) ! cice is fraction of wet area that is frozen -! *DH tisfc(i) = tice(i) else ! this would be over open ocean or land (no ice fraction) hice(i) = zero From d5f25a022418586202419aee7f3f8623ce16187b Mon Sep 17 00:00:00 2001 From: "Shan.Sun" Date: Fri, 14 Feb 2020 22:02:46 +0000 Subject: [PATCH 71/84] Revert one unnecessary change --- physics/GFS_surface_composites.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index abeb9cc8b..f74c8c399 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -136,7 +136,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan tprcp_ocn(i) = tprcp(i) tprcp_lnd(i) = tprcp(i) tprcp_ice(i) = tprcp(i) - if (wet(i) .or. icy(i)) then ! Water + if (wet(i)) then ! Water zorl_ocn(i) = zorlo(i) tsfc_ocn(i) = tsfco(i) tsurf_ocn(i) = tsfco(i) From 86644f441543836454ea88e73d2cba9fa4155f54 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Tue, 18 Feb 2020 17:46:06 +0000 Subject: [PATCH 72/84] Use reset to call full Thompson refl at output times, pass in kdt, and allow Thompson without aerosols. --- physics/module_mp_thompson.F90 | 51 +++++++++++++++++++++------------- physics/mp_thompson.F90 | 22 +++++++-------- physics/mp_thompson.meta | 16 +++++++++++ physics/mp_thompson_pre.F90 | 10 +++---- 4 files changed, 64 insertions(+), 35 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index b1ca6ba07..866273927 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1017,14 +1017,15 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims its,ite, jts,jte, kts,kte, & ! tile dims - errmsg, errflg) + errmsg, errflg, reset, kdt) implicit none !..Subroutine arguments INTEGER, INTENT(IN):: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte + its,ite, jts,jte, kts,kte, & + kdt REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & qv, qc, qr, qi, qs, qg, ni, nr REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & @@ -1055,6 +1056,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & vt_dbz_wt LOGICAL, OPTIONAL, INTENT(IN) :: first_time_step REAL, INTENT(IN):: dt_in + LOGICAL, INTENT (IN) :: reset !..Local variables REAL, DIMENSION(kts:kte):: & @@ -1077,6 +1079,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & INTEGER:: i_start, j_start, i_end, j_end LOGICAL, OPTIONAL, INTENT(IN) :: diagflag INTEGER, OPTIONAL, INTENT(IN) :: do_radar_ref + logical :: melti = .false. + ! CCPP error handling character(len=*), optional, intent( out) :: errmsg integer, optional, intent( out) :: errflg @@ -1372,15 +1376,25 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & enddo !> - Call calc_refl10cm() + IF ( PRESENT (diagflag) ) THEN if (diagflag .and. do_radar_ref == 1) then +! + ! Only set melti to true at the output times + if (reset) then + melti=.true. + else + melti=.false. + endif +! if (present(vt_dbz_wt) .and. present(first_time_step)) then call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, i, j, & - vt_dbz_wt(i,:,j), first_time_step) + t1d, p1d, dBZ, kts, kte, i, j, & + melti, kdt,vt_dbz_wt(i,:,j), & + first_time_step) else call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, i, j) + t1d, p1d, dBZ, kts, kte, i, j,melti,kdt) end if do k = kts, kte refl_10cm(i,k,j) = MAX(-35., dBZ(k)) @@ -1587,7 +1601,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & INTEGER:: idx_tc, idx_t, idx_s, idx_g1, idx_g, idx_r1, idx_r, & idx_i1, idx_i, idx_c, idx, idx_d, idx_n, idx_in - LOGICAL:: melti, no_micro + LOGICAL:: no_micro LOGICAL, DIMENSION(kts:kte):: L_qc, L_qi, L_qr, L_qs, L_qg LOGICAL:: debug_flag INTEGER:: nu_c @@ -5214,12 +5228,13 @@ end subroutine calc_effectRad !! of frozen species remaining from what initially existed at the !! melting level interface. subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, ii, jj, vt_dBZ, first_time_step) + t1d, p1d, dBZ, kts, kte, ii, jj, melti,kdt,vt_dBZ, & + first_time_step) IMPLICIT NONE !..Sub arguments - INTEGER, INTENT(IN):: kts, kte, ii, jj + INTEGER, INTENT(IN):: kts, kte, ii, jj, kdt REAL, DIMENSION(kts:kte), INTENT(IN):: & qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, t1d, p1d REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ @@ -5247,7 +5262,7 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & DOUBLE PRECISION:: fmelt_s, fmelt_g INTEGER:: i, k, k_0, kbot, n - LOGICAL:: melti + LOGICAL, INTENT(IN):: melti LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg DOUBLE PRECISION:: cback, x, eta, f_d @@ -5400,18 +5415,16 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !+---+-----------------------------------------------------------------+ !..Locate K-level of start of melting (k_0 is level above). !+---+-----------------------------------------------------------------+ - melti = .false. k_0 = kts - do k = kte-1, kts, -1 - if ( (temp(k).gt.273.15) .and. L_qr(k) & + if ( melti ) then + K_LOOP:do k = kte-1, kts, -1 + if ((temp(k).gt.273.15) .and. L_qr(k) & & .and. (L_qs(k+1).or.L_qg(k+1)) ) then - k_0 = MAX(k+1, k_0) - melti=.true. - goto 195 - endif - enddo - 195 continue - + k_0 = MAX(k+1, k_0) + EXIT K_LOOP + endif + enddo K_LOOP + endif !+---+-----------------------------------------------------------------+ !..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps) !.. and non-water-coated snow and graupel when below freezing are diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 812229f98..7708a4962 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -38,7 +38,6 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & ! Interface variables integer, intent(in) :: ncol integer, intent(in) :: nlev - logical, intent(in) :: is_aerosol_aware real(kind_phys), optional, intent(inout) :: nwfa2d(1:ncol) real(kind_phys), optional, intent(inout) :: nifa2d(1:ncol) @@ -138,13 +137,13 @@ end subroutine mp_thompson_init !>\ingroup aathompson !>\section gen_thompson_hrrr Thompson MP General Algorithm !>@{ - subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & + subroutine mp_thompson_run(ncol, nlev, kdt, con_g, con_rd, & spechum, qc, qr, qi, qs, qg, ni, nr, & is_aerosol_aware, nc, nwfa, nifa, & nwfa2d, nifa2d, & tgrs, prsl, phii, omega, dtp, & prcp, rain, graupel, ice, snow, sr, & - refl_10cm, do_radar_ref, & + refl_10cm, reset, do_radar_ref, & re_cloud, re_ice, re_snow, & mpicomm, mpirank, mpiroot, & errmsg, errflg) @@ -156,6 +155,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! Dimensions and constants integer, intent(in ) :: ncol integer, intent(in ) :: nlev + integer, intent(in ) :: kdt real(kind_phys), intent(in ) :: con_g real(kind_phys), intent(in ) :: con_rd ! Hydrometeors @@ -168,12 +168,12 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent(inout) :: ni(1:ncol,1:nlev) real(kind_phys), intent(inout) :: nr(1:ncol,1:nlev) ! Aerosols - logical, intent(in) :: is_aerosol_aware - real(kind_phys), optional, intent(inout) :: nc(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nwfa(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nifa(1:ncol,1:nlev) - real(kind_phys), optional, intent(in ) :: nwfa2d(1:ncol) - real(kind_phys), optional, intent(in ) :: nifa2d(1:ncol) + logical, intent(in) :: is_aerosol_aware,reset + real(kind_phys), optional, intent(inout) :: nc(:,:) + real(kind_phys), optional, intent(inout) :: nwfa(:,:) + real(kind_phys), optional, intent(inout) :: nifa(:,:) + real(kind_phys), optional, intent(in ) :: nwfa2d(:) + real(kind_phys), optional, intent(in ) :: nifa2d(:) ! State variables and timestep information real(kind_phys), intent(inout) :: tgrs(1:ncol,1:nlev) real(kind_phys), intent(in ) :: prsl(1:ncol,1:nlev) @@ -359,7 +359,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & - errmsg=errmsg, errflg=errflg) + errmsg=errmsg, errflg=errflg, reset=reset, kdt=kdt) else call mp_gt_driver(qv=qv_mp, qc=qc_mp, qr=qr_mp, qi=qi_mp, qs=qs_mp, qg=qg_mp, & @@ -376,7 +376,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & - errmsg=errmsg, errflg=errflg) + errmsg=errmsg, errflg=errflg, reset=reset, kdt=kdt) end if if (errflg/=0) return diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 619053882..ef50b1d82 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -147,6 +147,14 @@ 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 [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -398,6 +406,14 @@ kind = kind_phys intent = out optional = F +[reset] + standard_name = flag_reset_maximum_hourly_fields + long_name = flag for resetting maximum hourly fields + units = flag + dimensions = () + type = logical + intent = in + optional = F [do_radar_ref] standard_name = flag_for_radar_reflectivity long_name = flag for radar reflectivity diff --git a/physics/mp_thompson_pre.F90 b/physics/mp_thompson_pre.F90 index 14ede1ec9..3654b6682 100644 --- a/physics/mp_thompson_pre.F90 +++ b/physics/mp_thompson_pre.F90 @@ -53,11 +53,11 @@ subroutine mp_thompson_pre_run(ncol, nlev, kdt, con_g, con_rd, & real(kind_phys), intent(inout) :: nr(1:ncol,1:nlev) ! Aerosols logical, intent(in ) :: is_aerosol_aware - real(kind_phys), optional, intent(inout) :: nc(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nwfa(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nifa(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nwfa2d(1:ncol) - real(kind_phys), optional, intent(inout) :: nifa2d(1:ncol) + real(kind_phys), optional, intent(inout) :: nc(:,:) + real(kind_phys), optional, intent(inout) :: nwfa(:,:) + real(kind_phys), optional, intent(inout) :: nifa(:,:) + real(kind_phys), optional, intent(inout) :: nwfa2d(:) + real(kind_phys), optional, intent(inout) :: nifa2d(:) ! State variables and timestep information real(kind_phys), intent(in ) :: tgrs(1:ncol,1:nlev) real(kind_phys), intent( out) :: tgrs_save(1:ncol,1:nlev) From 90b5d9a0a3d894681b01be870de12b0bdf31990c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 19 Feb 2020 16:39:58 +0000 Subject: [PATCH 73/84] 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 74/84] 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 75/84] 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 76/84] 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 77/84] 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 78/84] 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) From c9557ec09ad7c5ec5b210577728cba62191a82d9 Mon Sep 17 00:00:00 2001 From: jeff beck Date: Mon, 2 Mar 2020 20:16:47 +0000 Subject: [PATCH 79/84] Flip k dimension to correctly output all ad-hoc stochastic physics fields --- physics/GFS_stochastics.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index c35de0954..2a6552f18 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -124,7 +124,7 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, if (use_zmtnblck)then sppt_wts(i,k)=(sppt_wts(i,k)-1)*sppt_vwt+1.0 endif - sppt_wts_inv(i,km-k+1)=sppt_wts(i,k) + sppt_wts_inv(i,k)=sppt_wts(i,k) !if(isppt_deep)then @@ -190,7 +190,7 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, if (do_shum) then do k=1,km gq0(:,k) = gq0(:,k)*(1.0 + shum_wts(:,k)) - shum_wts_inv(:,km-k+1) = shum_wts(:,k) + shum_wts_inv(:,k) = shum_wts(:,k) end do endif @@ -198,8 +198,8 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, do k=1,km gu0(:,k) = gu0(:,k)+skebu_wts(:,k)*(diss_est(:,k)) gv0(:,k) = gv0(:,k)+skebv_wts(:,k)*(diss_est(:,k)) - skebu_wts_inv(:,km-k+1) = skebu_wts(:,k) - skebv_wts_inv(:,km-k+1) = skebv_wts(:,k) + skebu_wts_inv(:,k) = skebu_wts(:,k) + skebv_wts_inv(:,k) = skebv_wts(:,k) enddo endif From 9a0327b3a544f5dec256decf02d2a66619711d00 Mon Sep 17 00:00:00 2001 From: "Shan.Sun" Date: Thu, 12 Mar 2020 17:44:19 +0000 Subject: [PATCH 80/84] Mering master (e7909b4) into branch fractional_landmask --- physics/GFS_PBL_generic.F90 | 72 ++++++++-------- physics/GFS_surface_composites.F90 | 129 ++++++++++++++--------------- 2 files changed, 96 insertions(+), 105 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 4bebae589..a440836e1 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -81,10 +81,10 @@ end subroutine GFS_PBL_generic_pre_finalize !! subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, & ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, & - ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef, trans_aero, ntchs, ntchm, & + 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, errmsg, errflg) + imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, cplchm, ltaerosol, & + hybedmf, do_shoc, satmedmf, qgrs, vdftra, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -99,11 +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, levs, ntrac), intent(in) :: qgrs + real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(out) :: errflg !local variables integer :: i, k, kk, k1, n @@ -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, epsln = 1.0d-10 integer :: i, k, kk, k1, n real(kind=kind_phys) :: tem, tem1, rho @@ -498,38 +499,41 @@ 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 (icy(i) .or. dry(i)) then - tem1 = max(q1(i), 1.e-8) - rho = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) - if (wind(i) > 0.0) then - tem = - rho * stress_ocn(i) / wind(i) - dusfci_cpl(i) = tem * ugrs1(i) ! U-momentum flux - dvsfci_cpl(i) = tem * vgrs1(i) ! V-momentum flux - else - dusfci_cpl(i) = 0.0 - dvsfci_cpl(i) = 0.0 - 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 - dusfci_cpl(i) = dusfc1(i) - dvsfci_cpl(i) = dvsfc1(i) - dtsfci_cpl(i) = dtsfc1(i) - dqsfci_cpl(i) = dqsfc1(i) + if (fice(i) > 1.-epsln) then ! no open water, 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 + tem1 = max(q1(i), 1.e-8) + rho = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) + if (wind(i) > 0.0) then + tem = - rho * stress_ocn(i) / wind(i) + dusfci_cpl(i) = tem * ugrs1(i) ! U-momentum flux + dvsfci_cpl(i) = tem * vgrs1(i) ! V-momentum flux + else + dusfci_cpl(i) = 0.0 + dvsfci_cpl(i) = 0.0 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 + dusfci_cpl(i) = dusfc1(i) + dvsfci_cpl(i) = dvsfc1(i) + dtsfci_cpl(i) = dtsfc1(i) + dqsfci_cpl(i) = dqsfc1(i) endif ! dusfc_cpl (i) = dusfc_cpl(i) + dusfci_cpl(i) * dtf 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 @@ -547,10 +551,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(ipr),' dusfc1=',dusfc1(ipr),' dtf=', - ! & dtf,' kdt=',kdt,' lat=',lat - ! endif if (ldiag3d) then if (lsidea) then @@ -565,9 +565,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_surface_composites.F90 b/physics/GFS_surface_composites.F90 index f74c8c399..6cca60ccf 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 @@ -116,6 +116,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan 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 @@ -125,11 +126,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 @@ -140,8 +146,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 @@ -165,13 +171,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 @@ -200,15 +206,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 @@ -236,12 +245,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 @@ -259,8 +270,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 @@ -276,7 +286,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, & @@ -289,7 +299,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, & @@ -312,8 +322,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 = '' @@ -340,17 +348,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 @@ -365,10 +373,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) @@ -409,7 +413,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) @@ -417,13 +421,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) @@ -435,7 +440,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) @@ -443,13 +448,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) @@ -461,49 +467,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 From 059548223262c948f8a1c44ab658d3a283a53b27 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 12 Mar 2020 13:12:46 -0600 Subject: [PATCH 81/84] physics/mp_thompson.meta: use different standard name for reset --- physics/mp_thompson.meta | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index ef50b1d82..d1d3ea48f 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -407,8 +407,8 @@ intent = out optional = F [reset] - standard_name = flag_reset_maximum_hourly_fields - long_name = flag for resetting maximum hourly fields + standard_name = flag_for_resetting_radar_reflectivity_calculation + long_name = flag for resetting radar reflectivity calculation units = flag dimensions = () type = logical From 215399e4cfc08855e1d98d5b52cad0967eb93920 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 13 Mar 2020 13:17:25 -0600 Subject: [PATCH 82/84] Remove unused argument kdt from MP Thompson --- physics/module_mp_thompson.F90 | 18 +++++++++--------- physics/mp_thompson.F90 | 23 +++++++++++------------ physics/mp_thompson.meta | 8 -------- 3 files changed, 20 insertions(+), 29 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 52b25dae5..8a8755495 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1007,15 +1007,14 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims its,ite, jts,jte, kts,kte, & ! tile dims - errmsg, errflg, reset, kdt) + errmsg, errflg, reset) implicit none !..Subroutine arguments INTEGER, INTENT(IN):: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, & - kdt + its,ite, jts,jte, kts,kte REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & qv, qc, qr, qi, qs, qg, ni, nr REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & @@ -1380,11 +1379,12 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & if (present(vt_dbz_wt) .and. present(first_time_step)) then call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & t1d, p1d, dBZ, kts, kte, i, j, & - melti, kdt,vt_dbz_wt(i,:,j), & + melti, vt_dbz_wt(i,:,j), & first_time_step) else - call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, i, j,melti,kdt) + call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & + t1d, p1d, dBZ, kts, kte, i, j, & + melti) end if do k = kts, kte refl_10cm(i,k,j) = MAX(-35., dBZ(k)) @@ -5217,14 +5217,14 @@ end subroutine calc_effectRad !! library of routines. The meltwater fraction is simply the amount !! of frozen species remaining from what initially existed at the !! melting level interface. - subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, ii, jj, melti,kdt,vt_dBZ, & + subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & + t1d, p1d, dBZ, kts, kte, ii, jj, melti, vt_dBZ, & first_time_step) IMPLICIT NONE !..Sub arguments - INTEGER, INTENT(IN):: kts, kte, ii, jj, kdt + INTEGER, INTENT(IN):: kts, kte, ii, jj REAL, DIMENSION(kts:kte), INTENT(IN):: & qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, t1d, p1d REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 7708a4962..2978b8df2 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -137,15 +137,15 @@ end subroutine mp_thompson_init !>\ingroup aathompson !>\section gen_thompson_hrrr Thompson MP General Algorithm !>@{ - subroutine mp_thompson_run(ncol, nlev, kdt, con_g, con_rd, & - spechum, qc, qr, qi, qs, qg, ni, nr, & - is_aerosol_aware, nc, nwfa, nifa, & - nwfa2d, nifa2d, & - tgrs, prsl, phii, omega, dtp, & - prcp, rain, graupel, ice, snow, sr, & - refl_10cm, reset, do_radar_ref, & - re_cloud, re_ice, re_snow, & - mpicomm, mpirank, mpiroot, & + subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & + spechum, qc, qr, qi, qs, qg, ni, nr, & + is_aerosol_aware, nc, nwfa, nifa, & + nwfa2d, nifa2d, & + tgrs, prsl, phii, omega, dtp, & + prcp, rain, graupel, ice, snow, sr, & + refl_10cm, reset, do_radar_ref, & + re_cloud, re_ice, re_snow, & + mpicomm, mpirank, mpiroot, & errmsg, errflg) implicit none @@ -155,7 +155,6 @@ subroutine mp_thompson_run(ncol, nlev, kdt, con_g, con_rd, & ! Dimensions and constants integer, intent(in ) :: ncol integer, intent(in ) :: nlev - integer, intent(in ) :: kdt real(kind_phys), intent(in ) :: con_g real(kind_phys), intent(in ) :: con_rd ! Hydrometeors @@ -359,7 +358,7 @@ subroutine mp_thompson_run(ncol, nlev, kdt, con_g, con_rd, & ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & - errmsg=errmsg, errflg=errflg, reset=reset, kdt=kdt) + errmsg=errmsg, errflg=errflg, reset=reset) else call mp_gt_driver(qv=qv_mp, qc=qc_mp, qr=qr_mp, qi=qi_mp, qs=qs_mp, qg=qg_mp, & @@ -376,7 +375,7 @@ subroutine mp_thompson_run(ncol, nlev, kdt, con_g, con_rd, & ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & - errmsg=errmsg, errflg=errflg, reset=reset, kdt=kdt) + errmsg=errmsg, errflg=errflg, reset=reset) end if if (errflg/=0) return diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index d1d3ea48f..45113cbb2 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -147,14 +147,6 @@ 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 [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration From c8a345a38e56949f1d18223ce37da8d8f068b95d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 17 Mar 2020 11:32:06 -0600 Subject: [PATCH 83/84] physics/dcyc2.meta: bugfix for levr < levs --- physics/dcyc2.meta | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index c4a8d9051..2fa998781 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -183,37 +183,37 @@ intent = in optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep long_name = total sky shortwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [swhc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep long_name = clear sky shortwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep long_name = total sky longwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [hlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep long_name = clear sky longwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in From bdc2c7005a96591484f9d60eeabf8430279f11e0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 17 Mar 2020 12:23:30 -0600 Subject: [PATCH 84/84] Further bugfixes for levr