From b002bc978bed5f3f5226ee7be22491c82e2666f4 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Fri, 31 May 2019 22:34:36 -0400 Subject: [PATCH 001/141] fixed a bug in calculating CIN --- physics/cs_conv.F90 | 36 ++++++++++++++++++++++++++---------- 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index d5c2e1011..f1d0a5468 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -209,7 +209,8 @@ module cs_conv ! spblcrit=0.03, & !< minimum cloudbase height in p/ps ! spblcrit=0.035,& !< minimum cloudbase height in p/ps ! spblcrit=0.025,& !< minimum cloudbase height in p/ps - cincrit=-150.0 + cincrit=-10.0, & + capecrit=0.0 ! cincrit=-120.0 ! cincrit=-100.0 @@ -1155,8 +1156,22 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions DO I=ISTS,IENS CAPE(i) = zero CIN(i) = zero - JBUOY(i) = 0 +! JBUOY(i) = 0 enddo + +!Anning Cheng, CIN from the cloud base to positive buoy layer only + DO I=ISTS,IENS + if (kb(i) > 0) then + DO K=kb(i),KMAX + BUOY = (GDH(I,1)-GDHS(I,K)) / ((one+ELOCP*FDQS(I,K)) * CP*GDT(I,K)) + if (BUOY < 0.) then + CIN(I) = CIN(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) + else + cycle + end if + ENDDO + end if + ENDDO DO K=2,KMAX DO I=ISTS,IENS if (kb(i) > 0) then @@ -1165,21 +1180,22 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ELSE BUOY = (GDS(I,1)-GDS(I,K)) / (CP*GDT(I,K)) END IF - IF (BUOY > zero .AND. JBUOY(I) /= 0) THEN + IF (BUOY > zero) THEN CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) - JBUOY(I) = 2 - ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN - CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) - JBUOY(I) = 1 +! IF (BUOY > zero .AND. JBUOY(I) /= 0) THEN +! CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) +! JBUOY(I) = 2 +! ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN +! CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) +! JBUOY(I) = 1 ENDIF endif ENDDO ENDDO DO I=ISTS,IENS - IF (JBUOY(I) /= 2) CIN(I) = -999.D0 - if (cin(i) < cincrit) kb(i) = -1 +! IF (JBUOY(I) /= 2) CIN(I) = -999.D0 + if (cin(i) < cincrit .or. cape(i) -# Initialization before summing over cloud type do k=1,kmax ! Moorthi From ab96404961a9357dea4c7a2bfce19af80545297c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 18 Sep 2019 15:53:56 +0000 Subject: [PATCH 002/141] three files GFS_debug.F90, rrtmg_lw_pre.F90, and rrtmg_sw_pre.F90 are changed by commenting out print of Sfcprop%hprim and replacing replace Sfcprop%hprim variable by Sfcprop%hprime(:,1) in rrtmg routines --- physics/GFS_debug.F90 | 149 +++++++++++---------------------------- physics/rrtmg_lw_pre.F90 | 14 +++- physics/rrtmg_sw_pre.F90 | 33 ++++++--- 3 files changed, 78 insertions(+), 118 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 600936cce..30a25f93e 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -41,7 +41,23 @@ subroutine GFS_diagtoscreen_finalize () end subroutine GFS_diagtoscreen_finalize !> \section arg_table_GFS_diagtoscreen_run Argument Table -!! \htmlinclude GFS_diagtoscreen_run.html +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type in FV3 | DDT | 0 | GFS_control_type | | in | F | +!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type in FV3 | DDT | 0 | GFS_statein_type | | in | F | +!! | Stateout | GFS_stateout_type_instance | instance of derived type GFS_stateout_type | DDT | 0 | GFS_stateout_type | | in | F | +!! | Sfcprop | GFS_sfcprop_type_instance | instance of type GFS_sfcprop_type in FV3 | DDT | 0 | GFS_sfcprop_type | | in | F | +!! | Coupling | GFS_coupling_type_instance | instance of type GFS_coupling_type in FV3 | DDT | 0 | GFS_coupling_type | | in | F | +!! | Grid | GFS_grid_type_instance | instance of type GFS_grid_type in FV3 | DDT | 0 | GFS_grid_type | | in | F | +!! | Tbd | GFS_tbd_type_instance | instance of type GFS_tbd_type in FV3 | DDT | 0 | GFS_tbd_type | | in | F | +!! | Cldprop | GFS_cldprop_type_instance | instance of type GFS_cldprop_type in FV3 | DDT | 0 | GFS_cldprop_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | instance of type GFS_radtend_type in FV3 | DDT | 0 | GFS_radtend_type | | in | F | +!! | Diag | GFS_diag_type_instance | instance of type GFS_diag_type in FV3 | DDT | 0 | GFS_diag_type | | in | F | +!! | Interstitial | GFS_interstitial_type_instance | instance of type GFS_interstitial_type in FV3 | DDT | 0 | GFS_interstitial_type | | in | F | +!! | nthreads | omp_threads | number of OpenMP threads or fast physics schemes | count | 0 | integer | | in | F | +!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & @@ -130,7 +146,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Sfcprop%zorlo' , Sfcprop%zorlo) call print_var(mpirank,omprank, blkno, 'Sfcprop%zorll' , Sfcprop%zorll) call print_var(mpirank,omprank, blkno, 'Sfcprop%fice' , Sfcprop%fice) - call print_var(mpirank,omprank, blkno, 'Sfcprop%hprim' , Sfcprop%hprim) +! call print_var(mpirank,omprank, blkno, 'Sfcprop%hprim' , Sfcprop%hprim) call print_var(mpirank,omprank, blkno, 'Sfcprop%hprime' , Sfcprop%hprime) call print_var(mpirank,omprank, blkno, 'Sfcprop%sncovr' , Sfcprop%sncovr) call print_var(mpirank,omprank, blkno, 'Sfcprop%snoalb' , Sfcprop%snoalb) @@ -756,7 +772,23 @@ subroutine GFS_interstitialtoscreen_finalize () end subroutine GFS_interstitialtoscreen_finalize !> \section arg_table_GFS_interstitialtoscreen_run Argument Table -!! \htmlinclude GFS_interstitialtoscreen_run.html +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type | DDT | 0 | GFS_control_type | | in | F | +!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type | DDT | 0 | GFS_statein_type | | in | F | +!! | Stateout | GFS_stateout_type_instance | instance of derived type GFS_stateout_type | DDT | 0 | GFS_stateout_type | | in | F | +!! | Sfcprop | GFS_sfcprop_type_instance | instance of derived type GFS_sfcprop_type | DDT | 0 | GFS_sfcprop_type | | in | F | +!! | Coupling | GFS_coupling_type_instance | instance of derived type GFS_coupling_type | DDT | 0 | GFS_coupling_type | | in | F | +!! | Grid | GFS_grid_type_instance | instance of derived type GFS_grid_type | DDT | 0 | GFS_grid_type | | in | F | +!! | Tbd | GFS_tbd_type_instance | instance of derived type GFS_tbd_type | DDT | 0 | GFS_tbd_type | | in | F | +!! | Cldprop | GFS_cldprop_type_instance | instance of derived type GFS_cldprop_type | DDT | 0 | GFS_cldprop_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | instance of derived type GFS_radtend_type | DDT | 0 | GFS_radtend_type | | in | F | +!! | Diag | GFS_diag_type_instance | instance of derived type GFS_diag_type | DDT | 0 | GFS_diag_type | | in | F | +!! | Interstitial | GFS_interstitial_type_instance | instance of derived type GFS_interstitial_type | DDT | 0 | GFS_interstitial_type | | in | F | +!! | nthreads | omp_threads | number of OpenMP threads or fast physics schemes | count | 0 | integer | | in | F | +!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & @@ -868,7 +900,12 @@ subroutine GFS_abort_finalize () end subroutine GFS_abort_finalize !> \section arg_table_GFS_abort_run Argument Table -!! \htmlinclude GFS_abort_run.html +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type | DDT | 0 | GFS_control_type | | in | F | +!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine GFS_abort_run (Model, blkno, errmsg, errflg) @@ -896,107 +933,3 @@ subroutine GFS_abort_run (Model, blkno, errmsg, errflg) end subroutine GFS_abort_run end module GFS_abort - - module GFS_checkland - - private - - public GFS_checkland_init, GFS_checkland_run, GFS_checkland_finalize - - contains - - subroutine GFS_checkland_init () - end subroutine GFS_checkland_init - - subroutine GFS_checkland_finalize () - end subroutine GFS_checkland_finalize - -!> \section arg_table_GFS_checkland_run Argument Table -!! \htmlinclude GFS_checkland_run.html -!! - subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_guess, & - flag_init, flag_restart, frac_grid, isot, ivegsrc, stype, vtype, slope, & - soiltyp, vegtype, slopetyp, dry, icy, wet, lake, ocean, & - oceanfrac, landfrac, lakefrac, slmsk, islmsk, errmsg, errflg ) - - use machine, only: kind_phys - - implicit none - - ! Interface variables - integer, intent(in ) :: me - integer, intent(in ) :: master - integer, intent(in ) :: blkno - integer, intent(in ) :: im - integer, intent(in ) :: kdt - integer, intent(in ) :: iter - logical, intent(in ) :: flag_iter(im) - logical, intent(in ) :: flag_guess(im) - logical, intent(in ) :: flag_init - logical, intent(in ) :: flag_restart - logical, intent(in ) :: frac_grid - integer, intent(in ) :: isot - integer, intent(in ) :: ivegsrc - real(kind_phys), intent(in ) :: stype(im) - real(kind_phys), intent(in ) :: vtype(im) - real(kind_phys), intent(in ) :: slope(im) - integer, intent(in ) :: soiltyp(im) - integer, intent(in ) :: vegtype(im) - integer, intent(in ) :: slopetyp(im) - logical, intent(in ) :: dry(im) - logical, intent(in ) :: icy(im) - logical, intent(in ) :: wet(im) - logical, intent(in ) :: lake(im) - logical, intent(in ) :: ocean(im) - real(kind_phys), intent(in ) :: oceanfrac(im) - real(kind_phys), intent(in ) :: landfrac(im) - real(kind_phys), intent(in ) :: lakefrac(im) - real(kind_phys), intent(in ) :: slmsk(im) - integer, intent(in ) :: islmsk(im) - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - ! Local variables - integer :: i - - errflg = 0 - errmsg = '' - - write(0,'(a,i5)') 'YYY: me :', me - write(0,'(a,i5)') 'YYY: master :', master - write(0,'(a,i5)') 'YYY: blkno :', blkno - write(0,'(a,i5)') 'YYY: im :', im - write(0,'(a,i5)') 'YYY: kdt :', kdt - write(0,'(a,i5)') 'YYY: iter :', iter - write(0,'(a,1x,l)') 'YYY: flag_init :', flag_init - write(0,'(a,1x,l)') 'YYY: flag_restart :', flag_restart - write(0,'(a,1x,l)') 'YYY: frac_grid :', frac_grid - write(0,'(a,i5)') 'YYY: isot :', isot - write(0,'(a,i5)') 'YYY: ivegsrc :', ivegsrc - - do i=1,im - !if (vegtype(i)==15) then - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_iter(i) :', i, blkno, flag_iter(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_guess(i) :', i, blkno, flag_guess(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, stype(i) :', i, blkno, stype(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, vtype(i) :', i, blkno, vtype(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slope(i) :', i, blkno, slope(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, soiltyp(i) :', i, blkno, soiltyp(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, vegtype(i) :', i, blkno, vegtype(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, slopetyp(i) :', i, blkno, slopetyp(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, dry(i) :', i, blkno, dry(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, icy(i) :', i, blkno, icy(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, wet(i) :', i, blkno, wet(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, lake(i) :', i, blkno, lake(i) - write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, ocean(i) :', i, blkno, ocean(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, oceanfrac(i) :', i, blkno, oceanfrac(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, landfrac(i) :', i, blkno, landfrac(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, lakefrac(i) :', i, blkno, lakefrac(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slmsk(i) :', i, blkno, slmsk(i) - write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, islmsk(i) :', i, blkno, islmsk(i) - !end if - end do - - end subroutine GFS_checkland_run - - end module GFS_checkland diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 783d65e90..ca0bc408b 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -12,7 +12,17 @@ subroutine rrtmg_lw_pre_init () end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table -!! \htmlinclude rrtmg_lw_pre_run.html +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | +!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errmsg, errflg) @@ -43,7 +53,7 @@ subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errm !! emissivity for LW radiation. call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, IM, & + tsfg, tsfa, Sfcprop%hprime(:,1), IM, & Radtend%semis) ! --- outputs endif diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index de994ba79..41919b1a2 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -12,7 +12,24 @@ subroutine rrtmg_sw_pre_init () end subroutine rrtmg_sw_pre_init !> \section arg_table_rrtmg_sw_pre_run Argument Table -!! \htmlinclude rrtmg_sw_pre_run.html +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | +!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | +!! | idxday | daytime_points | daytime points | index | 1 | integer | | out | F | +!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb3 | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb4 | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | out | F | +!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & nday, idxday, tsfg, tsfa, sfcalb1, sfcalb2, sfcalb3, sfcalb4, & @@ -66,13 +83,13 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & !> - Call module_radiation_surface::setalb() to setup surface albedo. !! for SW radiation. - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& - tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, IM, & - alb1d, Model%pertalb, & ! mg, sfc-perts + call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, & ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, & + tsfg, tsfa, Sfcprop%hprime(:,1), Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, IM, & + alb1d, Model%pertalb, & ! mg, sfc-perts sfcalb) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. From 596c435586cd58ea8a058538098127b2ccc10e83 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 21 Oct 2019 10:47:53 +0000 Subject: [PATCH 003/141] 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 004/141] updating rascnv.meta --- physics/rascnv.meta | 29 ++--------------------------- 1 file changed, 2 insertions(+), 27 deletions(-) diff --git a/physics/rascnv.meta b/physics/rascnv.meta index 022871ec6..ee27a6c16 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -9,7 +9,6 @@ type = integer intent = in optional = F - [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -27,6 +26,7 @@ type = integer intent = out optional = F + ######################################################################## [ccpp-arg-table] name = rascnv_finalize @@ -50,9 +50,8 @@ optional = F ######################################################################## - [ccpp-arg-table] - name = rascnvcnv_run + name = rascnv_run type = scheme [im] standard_name = horizontal_loop_extent @@ -247,7 +246,6 @@ kind = kind_phys intent = out optional = F - [kbot] standard_name = vertical_index_at_cloud_base long_name = index for cloud base @@ -272,7 +270,6 @@ type = integer intent = inout optional = F - [ddvel] standard_name = downdraft_induced_surface_wind long_name = downdraft induced surface wind @@ -282,7 +279,6 @@ kind = kind_phys intent = out optional = F - [flipv] standard_name = flag_flip long_name = vertical flip logical @@ -291,7 +287,6 @@ type = logical intent = in optional = F - [facmb] standard_name = pressure_conversion_factor long_name = conversion factor from input pressure to hPa @@ -301,7 +296,6 @@ kind = kind_phys intent = in optional = F - [me] standard_name = mpi_rank long_name = current MPI-rank @@ -310,7 +304,6 @@ type = integer intent = in optional = F - [garea] standard_name = cell_area long_name = grid cell area @@ -320,7 +313,6 @@ kind = kind_phys intent = in optional = F - [ccwfac] standard_name = critical_work_function_factor long_name = factor mupltiplying critical work function @@ -330,7 +322,6 @@ kind = kind_phys intent = in optional = F - [nrcm] standard_name = number_of_random_numbers long_name = number of random numbers @@ -339,7 +330,6 @@ type = integer intent = in optional = F - [rhc] standard_name = critical_relative_humidity long_name = critical relative humidity @@ -349,7 +339,6 @@ kind = kind_phys intent = in optional = F - [ud_mf] standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt @@ -359,7 +348,6 @@ kind = kind_phys intent = out optional = F - [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -369,7 +357,6 @@ kind = kind_phys intent = out optional = F - [det_mf] standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt @@ -379,7 +366,6 @@ kind = kind_phys intent = out optional = F - [c00] standard_name = rain_auto_conversion_coefficient long_name = rain auto conversion coefficient @@ -390,7 +376,6 @@ kind = kind_phys intent = in optional = F - [qw0] standard_name = liquid_water_threshold_in_autoconversion long_name = liquid water threshold in autoconversion @@ -400,7 +385,6 @@ kind = kind_phys intent = in optional = F - [c00i] standard_name = snow_auto_conversion_coefficient long_name = snow auto conversion coefficient @@ -410,7 +394,6 @@ kind = kind_phys intent = in optional = F - [qi0] standard_name = ice_water_threshold_in_autoconversion long_name = iice water threshold in autoconversion @@ -420,7 +403,6 @@ kind = kind_phys intent = in optional = F - [dlqfac] standard_name = condensate_fraction_detrained_in_updraft_layer long_name = condensate fraction detrained with in a updraft layer @@ -430,7 +412,6 @@ kind = kind_phys intent = in optional = F - [lprnt] standard_name = flag_debug_print long_name = debug print logical @@ -439,7 +420,6 @@ type = logical intent = in optional = F - [ipr] standard_name = horizontal_grid_index long_name = horizontal grid index @@ -448,7 +428,6 @@ type = integer intent = in optional = F - [kdt] standard_name = htime_step long_name = current time step @@ -457,7 +436,6 @@ type = integer intent = in optional = F - [revap] standard_name = flag_rain_revap long_name = rain reevaporation logical @@ -466,9 +444,6 @@ type = logical intent = in optional = F - - - [qlcn] standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water From 2b42c9eaaa71206ce68d088066a507c085c10052 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 22 Oct 2019 00:45:16 +0000 Subject: [PATCH 005/141] addingarg_table_rascnv-run to rascnv.F90 --- physics/rascnv.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 602e1cc94..a68b96998 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -267,6 +267,9 @@ end subroutine rascnv_finalize ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! \section arg_table_rascnv_run Argument Table +!! \htmlinclude rascnv_run.html +!! subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & &, tin, qin, uin, vin, ccin, trac, fscav& &, prsi, prsl, prsik, prslk, phil, phii & From 42997f3a0fe1edfcc63a972701471d4bd9243f48 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 23 Oct 2019 18:22:25 +0000 Subject: [PATCH 006/141] updating rascnv.F90 and rascnv.meta --- physics/rascnv.F90 | 200 ++++++++++++++++++++++---------------------- physics/rascnv.meta | 45 +++++----- 2 files changed, 121 insertions(+), 124 deletions(-) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index a68b96998..f4834cdb8 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -2,8 +2,6 @@ !! This file contains the entire Relaxed Arakawa-Schubert convection !! parameteriztion -!> This module contains the CCPP-compliant scale-aware mass-flux deep -!! convection scheme. module rascnv USE machine , ONLY : kind_phys @@ -13,6 +11,7 @@ module rascnv implicit none public :: rascnv_init, rascnv_run, rascnv_finalize private + logical :: is_initialized = .False. ! integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s @@ -140,39 +139,38 @@ subroutine rascnv_init(me, errmsg, errflg) ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (first) then + if (is_initialized) return ! set critical workfunction arrays - ACTOP = ACTP*FACM - DO L=1,15 - A(L) = A(L)*FACM - ENDDO - DO L=2,15 - TEM = one / (PH(L) - PH(L-1)) - AC(L) = (PH(L)*A(L-1) - PH(L-1)*A(L)) * TEM - AD(L) = (A(L) - A(L-1)) * TEM - ENDDO - AC(1) = ACTOP - AC(16) = A(15) - AD(1) = zero - AD(16) = zero + ACTOP = ACTP*FACM + DO L=1,15 + A(L) = A(L)*FACM + ENDDO + DO L=2,15 + TEM = one / (PH(L) - PH(L-1)) + AC(L) = (PH(L)*A(L-1) - PH(L-1)*A(L)) * TEM + AD(L) = (A(L) - A(L-1)) * TEM + ENDDO + AC(1) = ACTOP + AC(16) = A(15) + AD(1) = zero + AD(16) = zero ! - CALL SETQRP - CALL SETVTP + CALL SETQRP + CALL SETVTP ! - do i=1,7 - tlbpl(i) = (tlac(i)-tlac(i+1)) / (plac(i)-plac(i+1)) - enddo - do i=1,5 - drdp(i) = (REFR(i+1)-REFR(i)) / (REFP(i+1)-REFP(i)) - enddo + do i=1,7 + tlbpl(i) = (tlac(i)-tlac(i+1)) / (plac(i)-plac(i+1)) + enddo + do i=1,5 + drdp(i) = (REFR(i+1)-REFR(i)) / (REFP(i+1)-REFP(i)) + enddo ! -! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 +! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 ! - if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & + if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & &, ' DETRAINING AT NORMALIZED PRESSURE ABOVE ',DPD ! - first = .false. - endif + is_initialized = .true. ! end subroutine rascnv_init @@ -192,79 +190,79 @@ subroutine rascnv_finalize (errmsg, errflg) errflg = 0 end subroutine rascnv_finalize -! -! -! ===================================================================== ! -! rascnv_run: ! -! ! -! program history log: ! -! Oct 2019 -- shrinivas moorthi ! -! ! -! ! -! ==================== defination of variables ==================== -! ! -! ! -! inputs: size -! ! -! im - integer, horiz dimension and num of used pts 1 ! -! ix - integer, maximum horiz dimension 1 ! -! k - integer, vertical dimension 1 ! -! dt - real, time step in seconds 1 ! -! dtf - real, dynamics time step in seconds 1 ! -! rannum - real, array holding random numbers between 0 an 1 (ix,nrcm) ! -! tin - real, input temperature (K) -! qin - real, input specific humidity (kg/kg) -! uin - real, input zonal wind component -! vin - real, input meridional wind component -! ccin - real, input condensates+tracers -! fscav - real -! prsi - real, layer interface pressure -! prsl - real, layer mid pressure -! prsik - real, layer interface Exner function -! prslk - real, layer mid Exner function -! phil - real, layer mid geopotential height -! phii - real, layer interface geopotential height -! kpbl - integer pbl top index -! cdrag - real, drag coefficient -! rainc - real, convectinve rain (m/sec) -! kbot - integer, cloud bottom index -! ktop - integer, cloud top index -! knv - integer, 0 - no convvection; 1 - convection -! ddvel - downdraft induced surface wind -! flipv - logical, true if input data from bottom to top -! facmb - real, factor bewteen input pressure and hPa -! me - integer, current pe number -! garea - real, grid area -! ccwfac - real, grid area -! nrcm - integer, number of random numbers at each grid point -! rhc - real, critical relative humidity -! ud_mf - real, updraft mass flux -! dd_mf - real, downdraft mass flux -! det_mf - real, detrained mass flux -! c00 - real, auto convection coefficient for rain -! qw0 - real, min cloud water before autoconversion -! c00i - real, auto convection coefficient for snow -! qi0 - real, min cloud ice before autoconversion -! dlqfac - real,fraction of condensated detrained in layers -! lprnt - logical, true for debug print -! ipr - integer, horizontal grid point to print when lprnt=true -! kdt - integer, current teime step -! revap - logial, when true reevaporate falling rain/snow -! qlcn - real -! qicn - real -! w_upi - real -! cf_upi - real -! cnv_mfd - real -! cnv_dqldt- real -! clcn - real -! cnv_fice - real -! cnv_ndrop- real -! cnv_nice - real -! mp_phys - integer, microphysics option -! mp_phys_mg - integer, flag for MG microphysics option -! trcmin - real, floor value for tracers -! ntk - integer, index representing TKE in the tracer array -! +!! +!! +!!===================================================================== ! +!! rascnv_run: ! +!! ! +!! program history log: ! +!! Oct 2019 -- shrinivas moorthi ! +!! ! +!! ! +!! ==================== defination of variables ==================== +!! ! +!! ! +!! inputs: size +!! ! +!! im - integer, horiz dimension and num of used pts 1 ! +!! ix - integer, maximum horiz dimension 1 ! +!! k - integer, vertical dimension 1 ! +!! dt - real, time step in seconds 1 ! +!! dtf - real, dynamics time step in seconds 1 ! +!! rannum - real, array holding random numbers between 0 an 1 (ix,nrcm) ! +!! tin - real, input temperature (K) +!! qin - real, input specific humidity (kg/kg) +!! uin - real, input zonal wind component +!! vin - real, input meridional wind component +!! ccin - real, input condensates+tracers +!! fscav - real +!! prsi - real, layer interface pressure +!! prsl - real, layer mid pressure +!! prsik - real, layer interface Exner function +!! prslk - real, layer mid Exner function +!! phil - real, layer mid geopotential height +!! phii - real, layer interface geopotential height +!! kpbl - integer pbl top index +!! cdrag - real, drag coefficient +!! rainc - real, convectinve rain (m/sec) +!! kbot - integer, cloud bottom index +!! ktop - integer, cloud top index +!! knv - integer, 0 - no convvection; 1 - convection +!! ddvel - downdraft induced surface wind +!! flipv - logical, true if input data from bottom to top +!! facmb - real, factor bewteen input pressure and hPa +!! me - integer, current pe number +!! garea - real, grid area +!! ccwfac - real, grid area +!! nrcm - integer, number of random numbers at each grid point +!! rhc - real, critical relative humidity +!! ud_mf - real, updraft mass flux +!! dd_mf - real, downdraft mass flux +!! det_mf - real, detrained mass flux +!! c00 - real, auto convection coefficient for rain +!! qw0 - real, min cloud water before autoconversion +!! c00i - real, auto convection coefficient for snow +!! qi0 - real, min cloud ice before autoconversion +!! dlqfac - real,fraction of condensated detrained in layers +!! lprnt - logical, true for debug print +!! ipr - integer, horizontal grid point to print when lprnt=true +!! kdt - integer, current teime step +!! revap - logial, when true reevaporate falling rain/snow +!! qlcn - real +!! qicn - real +!! w_upi - real +!! cf_upi - real +!! cnv_mfd - real +!! cnv_dqldt- real +!! clcn - real +!! cnv_fice - real +!! cnv_ndrop- real +!! cnv_nice - real +!! mp_phys - integer, microphysics option +!! mp_phys_mg - integer, flag for MG microphysics option +!! trcmin - real, floor value for tracers +!! ntk - integer, index representing TKE in the tracer array +!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! \section arg_table_rascnv_run Argument Table diff --git a/physics/rascnv.meta b/physics/rascnv.meta index ee27a6c16..7d93886c0 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -96,10 +96,10 @@ intent = in optional = F [rannum] - standard_name = random_numbers - long_name = random numbers time step - units = count - dimensions = () + standard_name = random_number_array + long_name = random number array (0-1) + units = none + dimensions = (horizontal_dimension,array_dimension_of_random_number) type = real kind = kind_phys intent = in @@ -178,7 +178,7 @@ [prsl] standard_name = air_pressure long_name = mean layer pressure - units = count + units = Pa dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -187,7 +187,7 @@ [prsik] standard_name = interface_exner_function long_name = layer interface exner function - units = count + units = ratio dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -196,7 +196,7 @@ [prslk] standard_name = layer_exner_function long_name = mean layer exner function - units = Pa + units = ratio dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -290,7 +290,7 @@ [facmb] standard_name = pressure_conversion_factor long_name = conversion factor from input pressure to hPa - units = none + units = ratio dimensions = () type = real kind = kind_phys @@ -325,7 +325,7 @@ [nrcm] standard_name = number_of_random_numbers long_name = number of random numbers - units = none + units = count dimensions = () type = integer intent = in @@ -333,7 +333,7 @@ [rhc] standard_name = critical_relative_humidity long_name = critical relative humidity - units = none + units = frac dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -341,7 +341,7 @@ optional = F [ud_mf] standard_name = instantaneous_atmosphere_updraft_convective_mass_flux - long_name = (updraft mass flux) * delt + long_name = (updraft mass flux) * dt units = kg m-2 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -350,7 +350,7 @@ optional = F [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux - long_name = (downdraft mass flux) * delt + long_name = (downdraft mass flux) * dt units = kg m-2 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -359,7 +359,7 @@ optional = F [det_mf] standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux - long_name = (detrainment mass flux) * delt + long_name = (detrainment mass flux) * dt units = kg m-2 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -369,7 +369,6 @@ [c00] standard_name = rain_auto_conversion_coefficient long_name = rain auto conversion coefficient - long_name = convective rain conversion parameter for deep conv. units = m-1 dimensions = (horizontal_dimension) type = real @@ -396,7 +395,7 @@ optional = F [qi0] standard_name = ice_water_threshold_in_autoconversion - long_name = iice water threshold in autoconversion + long_name = ice water threshold in autoconversion units = kg kg-1 dimensions = (horizontal_dimension) type = real @@ -429,9 +428,9 @@ intent = in optional = F [kdt] - standard_name = htime_step - long_name = current time step - units = count + standard_name = index_of_time_step + long_name = current time step index + units = index dimensions = () type = integer intent = in @@ -552,17 +551,17 @@ optional = F [trcmin] standard_name = floor_value_for_tracers - long_name = minimum tracet value - units = kgkg-1 + long_name = minimum tracer value + units = kg kg-1 dimensions = () type = real kind = kind_phys intent = in optional = F [ntk] - standard_name = index_of_location_turbulent_kinetic_energy - long_name = index of turbulent kinetic energy location - units = flag + standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer + long_name = index for turbulent kinetic energy in the convectively transported tracer array + units = index dimensions = () type = integer intent = in From de0058a2d40edb98b47be3eaf7cd42db6f535af9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 28 Oct 2019 17:25:36 +0000 Subject: [PATCH 007/141] modifying rascvnv and GFS_suite_interstitial to include ras convection parameterization --- physics/GFS_suite_interstitial.F90 | 6 +- physics/GFS_suite_interstitial.meta | 8 + physics/rascnv.F90 | 490 ++++++++++++++-------------- physics/rascnv.meta | 390 +++++++++++----------- 4 files changed, 448 insertions(+), 446 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 6ecc5925f..73b275b04 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -422,7 +422,7 @@ end subroutine GFS_suite_interstitial_3_finalize subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, xlat, gq0, imp_physics, imp_physics_mg, imp_physics_zhao_carr,& imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, prsi, prsl, prslk, rhcbot, & - rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, kinver, & + rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, kinver, ras, & clw, rhc, save_qc, save_qi, errmsg, errflg) use machine, only: kind_phys @@ -434,7 +434,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 integer, dimension(im), intent(in) :: islmsk, kpbl, kinver - logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol + logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras real(kind=kind_phys), intent(in) :: rhcbot, rhcmax, rhcpbl, rhctop real(kind=kind_phys), dimension(im), intent(in) :: work1, work2 @@ -493,7 +493,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr ! endif !*GF - if (cscnv .or. satmedmf .or. trans_trac ) then + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then tracers = 2 do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 91a2c04a4..a97574b99 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1303,6 +1303,14 @@ type = integer intent = in optional = F +[ras] + standard_name = flag_for_ras_deep_convection + long_name = flag for ras convection scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F [clw] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index f4834cdb8..8273bd3af 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -5,9 +5,13 @@ module rascnv USE machine , ONLY : kind_phys - use physcons, grav => con_g, cp => con_cp, alhl => con_hvap& - &, alhf => con_hfus, rgas => con_rd, rkap => con_rocp& - &, nu => con_FVirt, pi => con_pi, t0c => con_t0c + use physcons, grav => con_g, cp => con_cp, alhl => con_hvap& + &, alhf => con_hfus, rgas => con_rd, rkap => con_rocp& + &, nu => con_FVirt, pi => con_pi, t0c => con_t0c & + &, rv => con_rv, cvap => con_cvap & + &, cliq => con_cliq, csol => con_csol, ttp=> con_ttp & + &, eps => con_eps, epsm1 => con_epsm1 + USE FUNCPHYS , ONLY : fpvs implicit none public :: rascnv_init, rascnv_run, rascnv_finalize private @@ -34,6 +38,7 @@ module rascnv &, ONE_M2=1.E-2, ONE_M1=1.E-1 & &, oneolog10=one/log(10.0) & &, deg2rad=pi/180.d0 & ! conversion factor from degree to radians +! &, pa2mb = 0.01 !& ! conversion factor from Pa to hPa (or mb) &, cmb2pa = 100.0 ! Conversion from hPa to Pa ! real(kind=kind_phys), parameter :: & @@ -59,7 +64,7 @@ module rascnv logical, parameter :: do_aw=.true., cumfrc=.true. & &, updret=.false., vsmooth=.false. & &, wrkfun=.false., crtfun=.true. & - &, calkbl=.true, botop=.true. + &, calkbl=.true., botop=.true., revap=.true. & &, advcld=.true., advups=.false.,advtvd=.true. ! &, advcld=.true., advups=.true., advtvd=.false. ! &, advcld=.true., advups=.false.,advtvd=.false. @@ -99,6 +104,7 @@ module rascnv integer, parameter :: nvtp=10001 real(kind=kind_phys) C1XVTP, C2XVTP, TBVTP(NVTP) ! + real(kind=kind_phys) afc, facdt contains @@ -112,11 +118,12 @@ module rascnv !> \section arg_table_rascnv_init Argument Table !! \htmlinclude rascnv_init.html !! - subroutine rascnv_init(me, errmsg, errflg) + subroutine rascnv_init(me, dt, errmsg, errflg) ! Implicit none ! integer, intent(in) :: me + real(kind=kind_phys), intent(in) :: dt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -167,6 +174,8 @@ subroutine rascnv_init(me, errmsg, errflg) ! ! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 ! + AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 + if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & &, ' DETRAINING AT NORMALIZED PRESSURE ABOVE ',DPD ! @@ -230,18 +239,15 @@ end subroutine rascnv_finalize !! knv - integer, 0 - no convvection; 1 - convection !! ddvel - downdraft induced surface wind !! flipv - logical, true if input data from bottom to top -!! facmb - real, factor bewteen input pressure and hPa !! me - integer, current pe number -!! garea - real, grid area -!! ccwfac - real, grid area +!! area - real, grid area +!! ccwf - real, multiplication factor for critical workfunction !! nrcm - integer, number of random numbers at each grid point !! rhc - real, critical relative humidity !! ud_mf - real, updraft mass flux !! dd_mf - real, downdraft mass flux -!! det_mf - real, detrained mass flux -!! c00 - real, auto convection coefficient for rain +!! dt_mf - real, detrained mass flux !! qw0 - real, min cloud water before autoconversion -!! c00i - real, auto convection coefficient for snow !! qi0 - real, min cloud ice before autoconversion !! dlqfac - real,fraction of condensated detrained in layers !! lprnt - logical, true for debug print @@ -268,19 +274,19 @@ end subroutine rascnv_finalize !! \section arg_table_rascnv_run Argument Table !! \htmlinclude rascnv_run.html !! - subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & - &, tin, qin, uin, vin, ccin, trac, fscav& - &, prsi, prsl, prsik, prslk, phil, phii & - &, KPBL, CDRAG, RAINC, kbot, ktop, kcnv & - &, DDVEL, FLIPV, facmb, me, garea, ccwfac & - &, nrcm, rhc, ud_mf, dd_mf, det_mf & - &, c00, qw0, c00i, qi0, dlqfac & - &, lprnt, ipr, kdt, revap & - &, QLCN, QICN, w_upi, cf_upi, CNV_MFD & - &, CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE & - &, mp_phys, mp_phys_mg, trcmin, ntk & - &, errmsg, errflg) -! &, lprnt, ipr, kdt, fscav, ctei_r, ctei_rm) + subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & + &, ccwf, area, dxmin, dxinv & + &, psauras, prauras, wminras, dlqf, flipv & + &, me, rannum, nrcm, mp_phys, mp_phys_mg & + &, ntk, lprnt, ipr, kdt, rhc & +! &, ntk, lprnt, ipr, kdt, trcmin, rhc & + &, tin, qin, uin, vin, ccin, fscav & + &, prsi, prsl, prsik, prslk, phil, phii & + &, KPBL, CDRAG, RAINC, kbot, ktop, kcnv & + &, DDVEL, ud_mf, dd_mf, dt_mf & + &, QLCN, QICN, w_upi, cf_upi, CNV_MFD & + &, CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE & + &, errmsg, errflg) ! !********************************************************************* !********************************************************************* @@ -298,39 +304,40 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & !********************************************************************* ! ! - USE MACHINE , ONLY : kind_phys Implicit none ! LOGICAL FLIPV, lprnt,revap ! ! input ! -! Integer IM, IX, k, ncrnd, me, trac, ipr, nrcm, mp_phys, kdt - Integer IM, IX, k, ncrnd, me, trac, ipr, nrcm, mp_phys, kdt,ntk - integer, dimension(im) :: kbot, ktop, kcnv, kpbl, mg_phys_mg + integer, intent(in) :: im, ix, k, ntr, me, nrcm, ntk, ipr & + &, kdt, mp_phys, mp_phys_mg + integer, dimension(im) :: kbot, ktop, kcnv, kpbl +! + real(kind=kind_phys), intent(in) :: dxmin, dxinv, ccwf(2) & + &, psauras(2), prauras(2) & + &, wminras(2), dlqf(2) ! real(kind=kind_phys), dimension(ix,k) :: tin, qin, uin, vin & &, prsl, prslk, phil real(kind=kind_phys), dimension(ix,k+1) :: prsi, prsik, phii - real(kind=kind_phys), dimension(im,k) :: ud_mf, dd_mf, det_mf & + real(kind=kind_phys), dimension(im,k) :: ud_mf, dd_mf, dt_mf & &, rhc, qlcn, qicn, w_upi & &, cnv_mfd & -! &, cnv_mfd, cnv_prc3 & &, cnv_dqldt, clcn & &, cnv_fice, cnv_ndrop & &, cnv_nice, cf_upi - real(kind=kind_phys), dimension(im) :: ccwfac, rainc, cdrag & - &, ddvel, garea & - &, c00, c00i, dlqfac + real(kind=kind_phys), dimension(im) :: area, cdrag & + &, rainc, ddvel real(kind=kind_phys), dimension(ix,nrcm):: rannum - real(kind=kind_phys) ccin(ix,k,trac+2) - real(kind=kind_phys) trcmin(trac+2) + real(kind=kind_phys) ccin(ix,k,ntr+2) + real(kind=kind_phys) trcmin(ntr+2) - real(kind=kind_phys) DT, facmb, dtf, qw0, qi0 + real(kind=kind_phys) DT, dtf, qw0, qi0 ! ! Added for aerosol scavenging for GOCART ! - real(kind=kind_phys), intent(in) :: fscav(trac) + real(kind=kind_phys), intent(in) :: fscav(ntr) ! &, ctei_r(im), ctei_rm character(len=*), intent(out) :: errmsg @@ -341,7 +348,7 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & real(kind=kind_phys), dimension(k) :: toi, qoi, tcu, qcu & &, pcu, clw, cli, qii, qli& &, phi_l, prsm,psjm & - &, alfinq, alfind, rhc_l + &, alfinq, alfind, rhc_l & &, qoi_l, qli_l, qii_l real(kind=kind_phys), dimension(k+1) :: prs, psj, phi_h, flx, flxd @@ -349,18 +356,18 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & integer, dimension(100) :: ic real(kind=kind_phys), parameter :: clwmin=1.0e-10 ! - real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) + real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) & &, trcfac(:,:), rcu(:,:) real(kind=kind_phys) dtvd(2,4) ! &, DPI(K) - real(kind=kind_phys) CFAC, TEM, sgc, ccwf, tem1, tem2, rain & + real(kind=kind_phys) CFAC, TEM, sgc, ccwfac, tem1, tem2, rain & &, wfnc,tla,pl,qiid,qlid, c0, c0i, dlq_fac, sumq& - &, rainp, facdt + &, rainp ! Integer KCR, KFX, NCMX, NC, KTEM, I, L, lm1 & &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & - &, kblmn, ksfc + &, kblmn, ksfc, ncrnd real(kind=kind_phys) sgcs(k,im) ! LOGICAL lprint @@ -368,14 +375,16 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ! ! Scavenging related parameters ! - real fscav_(trac+2) ! Fraction scavenged per km + real fscav_(ntr+2) ! Fraction scavenged per km ! fscav_ = zero ! By default no scavenging - if (trac > 0) then - do i=1,trac + if (ntr > 0) then + do i=1,ntr fscav_(i) = fscav(i) enddo endif + trcmin = -99999.0 + if (ntk-2 > 0) trcmin(ntk-2) = 1.0d-4 !> - Initialize CCPP error handling variables @@ -383,9 +392,8 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & errflg = 0 ! if (me == 0) write(0,*)' rann=',rannum(1,:),' kdt=',kdt -! if (lprnt) write(0,*)' in RAS fscav=',fscav_,' ccwfac=', -! & ccwfac(ipr),' mp_phys=',mp_phys -! &, ' fscav=',fscav,' trac=',trac +! if (lprnt) write(0,*)' in RAS fscav=',fscav_, ' mp_phys=',mp_phys & +! &, ' fscav=',fscav,' ntr=',ntr ! km1 = k - 1 kp1 = k + 1 @@ -395,7 +403,7 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ksfc = kp1 endif ! - ntrc = trac + ntrc = ntr IF (CUMFRC) THEN ntrc = ntrc + 2 ENDIF @@ -434,24 +442,26 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ! ! call set_ras_afc(dt) ! AFC = -(1.04E-4*DT)*(3600./DT)**0.578 - AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 +! AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 ! do l=1,k do i=1,im ud_mf(i,l) = zero dd_mf(i,l) = zero - det_mf(i,l) = zero + dt_mf(i,l) = zero enddo enddo DO IPT=1,IM - ccwf = half - if (ccwfac(ipt) >= zero) ccwf = ccwfac(ipt) - - dlq_fac = dlqfac(ipt) + tem1 = (log(area(i)) - dxmin) * dxinv + tem2 = one - tem1 + ccwfac = ccwf(1)*tem1 + ccwf(2)*tem2 + dlq_fac = dlqf(1)*tem1 + dlqf(2)*tem2 tem = one + dlq_fac - c0 = c00(IPT) * tem - c0i = c00i(IPT) * tem + c0i = (psauras(1)*tem1 + psauras(2)*tem2) * tem + c0 = (prauras(1)*tem1 + prauras(2)*tem2) * tem + if (ccwfac == zero) ccwfac = half + ! ! ctei = .false. ! if (ctei_r(ipt) > ctei_rm) ctei = .true. @@ -572,18 +582,18 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & toi(l) = tin(ipt,ll) qoi(l) = qin(ipt,ll) - PRSM(L) = prsl(ipt,ll) * facmb ! facmb is for conversion to MB + PRSM(L) = prsl(ipt,ll) * Pa2mb PSJM(L) = prslk(ipt,ll) phi_l(L) = phil(ipt,ll) rhc_l(L) = rhc(ipt,ll) ! - if (ntrc > trac) then ! CUMFRC is true - uvi(l,trac+1) = uin(ipt,ll) - uvi(l,trac+2) = vin(ipt,ll) + if (ntrc > ntr) then ! CUMFRC is true + uvi(l,ntr+1) = uin(ipt,ll) + uvi(l,ntr+2) = vin(ipt,ll) endif ! - if (trac > 0) then ! tracers such as O3, dust etc - do n=1,trac + if (ntr > 0) then ! tracers such as O3, dust etc + do n=1,ntr uvi(l,n) = ccin(ipt,ll,n+2) if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero enddo @@ -591,7 +601,7 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & enddo do l=1,kp1 ll = kp1 + 1 - l ! Input variables are bottom to top! - PRS(LL) = prsi(ipt,L) * facmb ! facmb is for conversion to MB + PRS(LL) = prsi(ipt,L) * Pa2mb PSJ(LL) = prsik(ipt,L) phi_h(LL) = phii(ipt,L) enddo @@ -621,25 +631,25 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & toi(l) = tin(ipt,l) qoi(l) = qin(ipt,l) - PRSM(L) = prsl(ipt, L) * facmb ! facmb is for conversion to MB + PRSM(L) = prsl(ipt, L) * Pa2mb PSJM(L) = prslk(ipt,L) phi_l(L) = phil(ipt,L) rhc_l(L) = rhc(ipt,L) ! - if (ntrc > trac) then ! CUMFRC is true - uvi(l,trac+1) = uin(ipt,l) - uvi(l,trac+2) = vin(ipt,l) + if (ntrc > ntr) then ! CUMFRC is true + uvi(l,ntr+1) = uin(ipt,l) + uvi(l,ntr+2) = vin(ipt,l) endif ! - if (trac > 0) then ! tracers such as O3, dust etc - do n=1,trac + if (ntr > 0) then ! tracers such as O3, dust etc + do n=1,ntr uvi(l,n) = ccin(ipt,l,n+2) if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero enddo endif enddo DO L=1,kp1 - PRS(L) = prsi(ipt,L) * facmb ! facmb is for conversion to MB + PRS(L) = prsi(ipt,L) * Pa2mb PSJ(L) = prsik(ipt,L) phi_h(L) = phii(ipt,L) ENDDO @@ -776,15 +786,15 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & if (CUMFRC) then do l=krmin,k tem = one - max(pgfbot, min(pgftop, pgftop+pgfgrad*prsm(l))) - trcfac(l,trac+1) = tem - trcfac(l,trac+2) = tem + trcfac(l,ntr+1) = tem + trcfac(l,ntr+2) = tem enddo endif ! ! lprint = lprnt .and. ipt == ipr ! if (lprint) then -! write(0,*)' trcfac=',trcfac(krmin:k,1+trac) +! write(0,*)' trcfac=',trcfac(krmin:k,1+ntr) ! write(0,*)' alfint=',alfint(krmin:k,1) ! write(0,*)' alfinq=',alfint(krmin:k,2) ! write(0,*)' alfini=',alfint(krmin:k,4) @@ -915,13 +925,13 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & &, FRAC, MAX_NEG_BOUY, vsmooth, do_aw & &, REVAP, WRKFUN, CALKBL, CRTFUN, lprint & &, DT, KDT, TLA, DPD & - &, ALFINT, rhfacl, rhfacs, garea(ipt) & - &, ccwf, CDRAG(ipt), trcfac & + &, ALFINT, rhfacl, rhfacs, area(ipt) & + &, ccwfac, CDRAG(ipt), trcfac & &, alfind, rhc_l, phi_l, phi_h, PRS, PRSM,sgcs(1,ipt) & &, TOI, QOI, UVI, QLI, QII, KBL, DDVEL(ipt) & &, TCU, QCU, RCU, PCU, FLX, FLXD, RAIN, WFNC, fscav_ & -! &, trcmin) - &, trcmin, ntk-2, c0, qw0, c0i, qi0, dlq_fac, afc) + &, trcmin, ntk-2, c0, wminras(1), c0i, wminras(2) & + &, dlq_fac) ! &, ctei) ! if(lprint) write(0,*)' uvitkea=',uvi(ib:k,ntk-2),' ib=',ib @@ -951,7 +961,7 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & dd_mf(ipt,ll) = dd_mf(ipt,ll) + flxd(l+1) enddo ll = kp1 - ib - det_mf(ipt,ll) = det_mf(ipt,ll) + flx(ib) + dt_mf(ipt,ll) = dt_mf(ipt,ll) + flx(ib) if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 @@ -965,10 +975,10 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ! CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) ! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt - CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) + flx(ib)* + CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) + flx(ib)* & & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt ! & max(0.,(QLI(ib)+QII(ib)))/dt/3. - if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) + if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & & ,ipt,ll endif @@ -978,7 +988,7 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ud_mf(ipt,l) = ud_mf(ipt,l) + flx(l+1) dd_mf(ipt,l) = dd_mf(ipt,l) + flxd(l+1) enddo - det_mf(ipt,ib) = det_mf(ipt,ib) + flx(ib) + dt_mf(ipt,ib) = dt_mf(ipt,ib) + flx(ib) if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 ! if (lprint) write(0,*)' ib=',ib,' flx=',flx(ib),' ib=',ib @@ -988,10 +998,10 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & ! &,' ib=',ib,' kp1=',kp1 ! CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) ! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt - CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* + CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* & & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt ! & max(0.,(QLI(ib)+QII(ib)))/dt/3. - if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) + if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & & ,ipt,ib endif endif @@ -1053,17 +1063,17 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & if (flipv) then do l=1,k ll = kp1 - l - tin(ipt,ll) = toi(l) ! Temperature - qin(ipt,ll) = qoi(l) ! Specific humidity - uin(ipt,ll) = uvi(l,trac+1) ! U momentum - vin(ipt,ll) = uvi(l,trac+2) ! V momentum + tin(ipt,ll) = toi(l) ! Temperature + qin(ipt,ll) = qoi(l) ! Specific humidity + uin(ipt,ll) = uvi(l,ntr+1) ! U momentum + vin(ipt,ll) = uvi(l,ntr+2) ! V momentum !! for 2M microphysics, always output these variables if (mp_phys == 10) then if (advcld) then QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) - CNV_FICE(ipt,ll) = QICN(ipt,ll) + CNV_FICE(ipt,ll) = QICN(ipt,ll) & & / max(1.e-10,QLCN(ipt,ll)+QICN(ipt,ll)) else QLCN(ipt,ll) = qli(l) @@ -1073,18 +1083,18 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & !! CNV_PRC3(ipt,ll) = PCU(l)/dt ! CNV_PRC3(ipt,ll) = zero ! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,ll - cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ + cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ & & 500*ud_mf(ipt,ll)/dt), cfmax)) ! & 500*ud_mf(ipt,ll)/dt), 0.60)) ! if (lprint) write(0,*)' ll=',ll,' cf_upi=',cf_upi(ipt,ll) ! &,' ud_mf=',ud_mf(ipt,ll),' dt=',dt,' cfmax=',cfmax CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft - w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / + w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / & & (dt*max(cf_upi(ipt,ll),1.e-12)*prsl(ipt,ll)) endif - if (trac > 0) then - do n=1,trac + if (ntr > 0) then + do n=1,ntr ccin(ipt,ll,n+2) = uvi(l,n) ! Tracers enddo endif @@ -1114,17 +1124,17 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & else do l=1,k - tin(ipt,l) = toi(l) ! Temperature - qin(ipt,l) = qoi(l) ! Specific humidity - uin(ipt,l) = uvi(l,trac+1) ! U momentum - vin(ipt,l) = uvi(l,trac+2) ! V momentum + tin(ipt,l) = toi(l) ! Temperature + qin(ipt,l) = qoi(l) ! Specific humidity + uin(ipt,l) = uvi(l,ntr+1) ! U momentum + vin(ipt,l) = uvi(l,ntr+2) ! V momentum !! for 2M microphysics, always output these variables if (mp_phys == 10) then if (advcld) then QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) - CNV_FICE(ipt,l) = QICN(ipt,l) + CNV_FICE(ipt,l) = QICN(ipt,l) & & / max(1.e-10,QLCN(ipt,l)+QICN(ipt,l)) else QLCN(ipt,l) = qli(l) @@ -1134,16 +1144,16 @@ subroutine rascnv_run(IM, IX, k, dt, dtf, rannum & !! CNV_PRC3(ipt,l) = PCU(l)/dt ! CNV_PRC3(ipt,l) = zero ! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,l - cf_upi(ipt,l) = max(zero,min(0.02*log(one+ + cf_upi(ipt,l) = max(zero,min(0.02*log(one+ & & 500*ud_mf(ipt,l)/dt), cfmax)) ! & 500*ud_mf(ipt,l)/dt), 0.60)) CLCN(ipt,l) = cf_upi(ipt,l) !downdraft is below updraft - w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / + w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / & & (dt*max(cf_upi(ipt,l),1.e-12)*prsl(ipt,l)) endif - if (trac > 0) then - do n=1,trac + if (ntr > 0) then + do n=1,ntr ccin(ipt,l,n+2) = uvi(l,n) ! Tracers enddo endif @@ -1182,11 +1192,11 @@ SUBROUTINE CLOUD( & &, FRACBL, MAX_NEG_BOUY, vsmooth, do_aw & &, REVAP, WRKFUN, CALKBL, CRTFUN, lprnt & &, DT, KDT, TLA, DPD & - &, ALFINT, RHFACL, RHFACS, garea, ccwf, cd, trcfac & + &, ALFINT, RHFACL, RHFACS, area, ccwf, cd, trcfac & &, alfind, rhc_ls, phil, phih, prs, prsm, sgcs & &, TOI, QOI, ROI, QLI, QII, KPBL, DSFC & &, TCU, QCU, RCU, PCU, FLX, FLXD, CUP, WFNC,fscav_ & - &, trcmin, ntk, c0, qw0, c0i, qi0, dlq_fac, afc) + &, trcmin, ntk, c0, qw0, c0i, qi0, dlq_fac) ! &, ctei) ! @@ -1246,36 +1256,35 @@ SUBROUTINE CLOUD( & !===> FLX(K ) UPDATE MASS FLUX @ TOP OF LAYER KG/M^2 !===> CUP UPDATE PRECIPITATION AT THE SURFACE KG/M^2 ! - USE MACHINE , ONLY : kind_phys -! use module_ras IMPLICIT NONE ! - real (kind=kind_phys) :: RHMAX=1.0 ! MAX RELATIVE HUMIDITY - &, QUAD_LAM=1.0 ! MASK FOR QUADRATIC LAMBDA - &, RHRAM=0.05 ! PBL RELATIVE HUMIDITY RAMP -! &, RHRAM=0.15 ! PBL RELATIVE HUMIDITY RAMP - &, HCRITD=4000.0 ! Critical Moist Static Energy for Deep clouds - &, HCRITS=2000.0 ! Critical Moist Static Energy for Shallow clouds - &, pcrit_lcl=250.0 ! Critical pressure difference between boundary layer top - ! layer top and lifting condensation level (hPa) -! &, hpert_fac=1.01 ! Perturbation on hbl when ctei=.true. -! &, hpert_fac=1.005 ! Perturbation on hbl when ctei=.true. - &, qudfac=quad_lam*half, shalfac=3.0 -! &, qudfac=quad_lam*pt25, shalfac=3.0 ! Yogesh's - &, testmb=0.1, testmbi=one/testmb - &, testmboalhl=testmb/alhl - &, c0ifac=0.07 ! following Han et al, 2016 MWR - &, dpnegcr = 150.0 -! &, dpnegcr = 100.0 -! &, dpnegcr = 200.0 + real (kind=kind_phys), parameter :: RHMAX=1.0 & ! MAX RELATIVE HUMIDITY + &, QUAD_LAM=1.0 & ! MASK FOR QUADRATIC LAMBDA + &, RHRAM=0.05 & ! PBL RELATIVE HUMIDITY RAMP +! &, RHRAM=0.15 !& ! PBL RELATIVE HUMIDITY RAMP + &, HCRITD=4000.0 & ! Critical Moist Static Energy for Deep clouds + &, HCRITS=2000.0 & ! Critical Moist Static Energy for Shallow clouds + &, pcrit_lcl=250.0 & ! Critical pressure difference between boundary layer top + ! layer top and lifting condensation level (hPa) +! &, hpert_fac=1.01 !& ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.005 !& ! Perturbation on hbl when ctei=.true. + &, qudfac=quad_lam*half & + &, shalfac=3.0 & +! &, qudfac=quad_lam*pt25, shalfac=3.0 !& ! Yogesh's + &, testmb=0.1, testmbi=one/testmb& + &, testmboalhl=testmb/alhl & + &, c0ifac=0.07 & ! following Han et al, 2016 MWR + &, dpnegcr = 150.0 +! &, dpnegcr = 100.0 +! &, dpnegcr = 200.0 ! real(kind=kind_phys), parameter :: ERRMIN=0.0001 & &, ERRMI2=0.1*ERRMIN & -! &, rainmin=1.0e-9 ! & +! &, rainmin=1.0e-9 !& &, rainmin=1.0e-8 & &, oneopt9=1.0/0.09 & &, oneopt4=1.0/0.04 - real(kind=kind_phys), parameter :: almax=1.0e-2 + real(kind=kind_phys), parameter :: almax=1.0e-2 & &, almin1=0.0, almin2=0.0 real(kind=kind_phys), parameter :: bldmax = 300.0, bldmin=25.0 ! @@ -1298,8 +1307,8 @@ SUBROUTINE CLOUD( & real(kind=kind_phys) ALFINT(K,NTRC+4) real(kind=kind_phys) FRACBL, MAX_NEG_BOUY, DPD & - &, RHFACL, RHFACS, garea, ccwf & - &, c0, qw0, c0i, qi0, dlq_fac, afc + &, RHFACL, RHFACS, area, ccwf & + &, c0, qw0, c0i, qi0, dlq_fac ! UPDATE ARGUMENTS @@ -1350,16 +1359,17 @@ SUBROUTINE CLOUD( & &, FAC, RSUM1, RSUM2, RSUM3, dpneg, hcrit & &, ACTEVAP,AREARAT,DELTAQ,MASS,MASSINV,POTEVAP & &, TEQ,QSTEQ,DQDT,QEQ & - &, CLFRAC, DT, clf, clvfr, delzkm, fnoscav, delp + &, CLFRAC, DT, clvfr, delzkm, fnoscav, delp +! &, CLFRAC, DT, clf, clvfr, delzkm, fnoscav, delp ! &, almin1, almin2 INTEGER I, L, N, KD1, II, idh, lcon & - &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1, kbls, kmxh + &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1, kbls, kmxh & &, kblh, kblm, kblpmn, kmax, kmaxm1, kmaxp1, klcl, kmin, kmxb ! !*********************************************************************** ! -! almin2 = 0.2 * sqrt(pi/garea) +! almin2 = 0.2 * sqrt(pi/area) ! almin1 = almin2 KM1 = K - 1 @@ -1939,7 +1949,7 @@ SUBROUTINE CLOUD( & cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4 -! if (lprnt) write(0,*)' ii=',ii,' cnvflg=',cnvflg,' hsu=',hsu +! if (lprnt) write(0,*)' ii=',ii,' cnvflg=',cnvflg,' hsu=',hsu & ! &,' hbl=',hbl,' tx1=',tx1,' hsd=',hsd !*********************************************************************** @@ -1972,7 +1982,7 @@ SUBROUTINE CLOUD( & if (tem2 > almax) tem2 = -100.0 alm = max(tem1,tem2) -! if (lprnt) write(0,*) ' tem1=',tem1,' tem2=',tem2,' alm=',alm +! if (lprnt) write(0,*) ' tem1=',tem1,' tem2=',tem2,' alm=',alm & ! &,' tx1=',tx1,' tem=',tem,' epp=',epp,' x00=',x00,' st2=',st2 endif @@ -2062,7 +2072,8 @@ SUBROUTINE CLOUD( & rel_fac = max(zero, min(half,rel_fac)) IF (CRTFUN) THEN - II = MAX(1, MIN(tem*0.02-0.999999999, 16)) + II = tem*0.02-0.999999999 + II = MAX(1, MIN(II, 16)) ACR = tx1 * (AC(II) + tem * AD(II)) * CCWF ENDIF ! @@ -2136,8 +2147,8 @@ SUBROUTINE CLOUD( & ! ! if(lprnt) write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu ! if (lprnt .and. kd == 15) -! & write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu -! &,' qst=',qst(l),' qol=',qol(l),' hccp=',hccp,' detp=',detp +! & write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu & +! &,' qst=',qst(l),' qol=',qol(l),' hccp=',hccp,' detp=',detp & ! *,' qtp=',qtp,' alhf=',alhf,' vtf=',vtf(l) ST2 = LTL(L) * VTF(L) @@ -2147,17 +2158,17 @@ SUBROUTINE CLOUD( & ! ! if (lprnt) then ! if (lprnt .and. kd == 12) then -! write(0,*)' tem3=',tem3,' tx1=',tx1,' st1=',st1,' eta1=',eta(l+1) -! &, ' st2=',st2,' det=',det,' tem5=',tem5,' dlb=',dlb(l) -! write(0,*)' tem4=',tem4,' tem2=',tem2,' detp=',detp -! &, ' eta=',eta(l),' dlt=',dlt(l),' rns=',rns(l),' l=',l +! write(0,*)' tem3=',tem3,' tx1=',tx1,' st1=',st1,' eta1=',eta(l+1) & +! &, ' st2=',st2,' det=',det,' tem5=',tem5,' dlb=',dlb(l) & +! write(0,*)' tem4=',tem4,' tem2=',tem2,' detp=',detp & +! &, ' eta=',eta(l),' dlt=',dlt(l),' rns=',rns(l),' l=',l & ! write(0,*)' bt1=',tem3/(eta(l+1)*qrb(l)) ! &, ' bt2=',tem4/(eta(l)*qrt(l)) ! endif ST1 = TEM3 + TEM4 -! if (lprnt) write(0,*)' wfn=',wfn,' st1=',st1,' l=',l,' ep_wfn=', +! if (lprnt) write(0,*)' wfn=',wfn,' st1=',st1,' l=',l,' ep_wfn=', & ! &ep_wfn,' akm=',akm WFN = WFN + ST1 @@ -2236,7 +2247,7 @@ SUBROUTINE CLOUD( & endif ! ! -! ST1 = 0.5 * (HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) +! ST1 = 0.5 * (HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) & ! & + HST(KD1) - LTL(KD1)*NU*(QST(KD1)-QOL(KD1))) ! ST1 = HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) @@ -2244,7 +2255,7 @@ SUBROUTINE CLOUD( & TEM5 = (QLS + QIS) * eta(kd1) ST1 = HALF * (TX1-ETA(KD1)*ST1-ST2*(DET-TEM5))*DLB(KD) ! -! if (lprnt) write(0,*)' st1=',st1,' st2=',st2,' ltl=',ltl(kd) +! if (lprnt) write(0,*)' st1=',st1,' st2=',st2,' ltl=',ltl(kd) & ! *,ltl(kd1),' qos=',qos,qol(kd1) WFN = WFN + ST1 @@ -2253,7 +2264,7 @@ SUBROUTINE CLOUD( & BUY(KD) = ST1 / (ETA(KD1)*qrb(kd)) ! -! if (lprnt) write(0,*)' wfn=',wfn,' akm=',akm,' st1=',st1 +! if (lprnt) write(0,*)' wfn=',wfn,' akm=',akm,' st1=',st1 & ! &,' dpneg=',dpneg DET = DETP @@ -2677,9 +2688,9 @@ SUBROUTINE CLOUD( & ! endif if (do_aw) then tx1 = (0.2 / max(alm, 1.0e-5)) - tx2 = one - min(one, pi * tx1 * tx1 / garea) + tx2 = one - min(one, pi * tx1 * tx1 / area) ! if(lprnt) write(0,*)' kd=',kd,' alm=',alm,' tx1=',tx1 -! &,' garea=',garea,' pi=',pi,' tx2=',tx2 +! &,' area=',area,' pi=',pi,' tx2=',tx2 tx2 = tx2 * tx2 ! if(lprnt) write(0,*)' kd=',kd,' wvl=',wvl(kd:k+1) ! if(lprnt) write(0,*)' kd=',kd,' eta=',eta(kd:k+1) @@ -2755,7 +2766,7 @@ SUBROUTINE CLOUD( & ! avr = avr + (QLL(L) + QIL(L)*(1+alhf/alhl)) avr = avr + (QLL(L) + QIL(L)) * delp * sigf(l) * gravcon -! if(lprnt) write(0,*)' avr=',avr,' qll=',qll(l),' l=',l +! if(lprnt) write(0,*)' avr=',avr,' qll=',qll(l),' l=',l & ! &, ' qil=',qil(l) ! Correction for negative condensate! @@ -2802,11 +2813,11 @@ SUBROUTINE CLOUD( & ! avt = avt * cp * 100.0*86400.0 / (alhl*DT*grav) ! avq = avq * 100.0*86400.0 / (DT*grav) ! avr = avr * 86400.0 / DT -! write(0,*) ' avt=',avt,' avq=',avq,' avr=',avr,' avh=' -! * ,avh,' alm=',alm,' DDFT=',DDFT,' KD=',KD -! &,' TOIK-',toi(k),' TOIK-1=',toi(k-1),' TOIK-2=',toi(k-2) +! write(0,*) ' avt=',avt,' avq=',avq,' avr=',avr,' avh=' & +! * ,avh,' alm=',alm,' DDFT=',DDFT,' KD=',KD & +! &,' TOIK-',toi(k),' TOIK-1=',toi(k-1),' TOIK-2=',toi(k-2) & ! if (kd == 12 .and. .not. ddft) stop -! if (avh > 0.1 .or. abs(avt+avq) > 1.0e-5 .or. +! if (avh > 0.1 .or. abs(avt+avq) > 1.0e-5 .or. & ! & abs(avt-avr) > 1.0e-5 .or. abs(avr+avq) > 1.0e-5) stop ! ! if (lprnt) then @@ -2828,12 +2839,12 @@ SUBROUTINE CLOUD( & enddo tem = tem + amb * dof * sigf(kbl) tem = tem * (3600.0/dt) -!!!! tem1 = max(1.0, min(100.0,sqrt((5.0E10/max(garea,one))))) -! tem1 = max(1.0, min(100.0,(7.5E10/max(garea,one)))) -! tem1 = max(1.0, min(100.0,(5.0E10/max(garea,one)))) -! tem1 = max(1.0, min(100.0,(4.0E10/max(garea,one)))) -!! tem1 = sqrt(max(1.0, min(100.0,(4.0E10/max(garea,one))))) ! 20100902 - tem1 = sqrt(max(one, min(100.0,(6.25E10/max(garea,one))))) ! 20110530 +!!!! tem1 = max(1.0, min(100.0,sqrt((5.0E10/max(area,one))))) +! tem1 = max(1.0, min(100.0,(7.5E10/max(area,one)))) +! tem1 = max(1.0, min(100.0,(5.0E10/max(area,one)))) +! tem1 = max(1.0, min(100.0,(4.0E10/max(area,one)))) +!! tem1 = sqrt(max(1.0, min(100.0,(4.0E10/max(area,one))))) ! 20100902 + tem1 = sqrt(max(one, min(100.0,(6.25E10/max(area,one))))) ! 20110530 ! if (lprnt) write(0,*)' clfr0=',clf(tem),' tem=',tem,' tem1=',tem1 @@ -2896,9 +2907,9 @@ SUBROUTINE CLOUD( & ! & TEM4 = POTEVAP * (1. - EXP( AFC*tx4*SQRT(TX1) ) ) ACTEVAP = MIN(TX1, TEM4*CLFRAC) -! if(lprnt) write(0,*)' L=',L,' actevap=',actevap,' tem4=',tem4, -! &' clfrac=' -! &,clfrac,' potevap=',potevap,'efac=',AFC*SQRT(TX1*TEM3) +! if(lprnt) write(0,*)' L=',L,' actevap=',actevap,' tem4=',tem4, & +! &' clfrac=' & +! &,clfrac,' potevap=',potevap,'efac=',AFC*SQRT(TX1*TEM3) & ! &,' tx1=',tx1 if (tx1 < rainmin*dt) actevap = min(tx1, potevap) @@ -3012,7 +3023,7 @@ SUBROUTINE CLOUD( & if (st2 < zero) then ROI(L,N) = trcmin(n) RCU(L,N) = RCU(L,N) + ST1 - if (l < k) + if (l < k) & & st2 = st2 * (prl(l+1)-prl(l))*pri(l+1) * (cmb2pa/grav) else ROI(L,N) = ST3 @@ -3045,7 +3056,7 @@ SUBROUTINE CLOUD( & ! if (lprnt) write(0,*)' qoio=',qoi RETURN - END + end subroutine cloud SUBROUTINE DDRFT( & & K, KP1, KD & @@ -3078,8 +3089,6 @@ SUBROUTINE DDRFT( & !===> K INPUT THE RISE & THE INDEX OF THE SUBCLOUD LAYER !===> KD INPUT DETRAINMENT LEVEL ( 1<= KD < K ) ! - USE MACHINE , ONLY : kind_phys -! use module_ras IMPLICIT NONE ! ! INPUT ARGUMENTS @@ -3119,7 +3128,8 @@ SUBROUTINE DDRFT( & &, GMF1, GMF5, QRAF, QRBF, del_tla & &, TLA, STLA, CTL2, CTL3 & ! &, TLA, STLA, CTL2, CTL3, ASIN & - &, RNT, RNB, ERRQ, RNTP, QRPF, VTPF & +! &, RNT, RNB, ERRQ, RNTP, QRPF, VTPF & + &, RNT, RNB, ERRQ, RNTP & &, EDZ, DDZ, CE, QHS, FAC, FACG & &, RSUM1, RSUM2, RSUM3, CEE, DOF, DOFW ! &, sialf @@ -3145,15 +3155,15 @@ SUBROUTINE DDRFT( & parameter (WCMIN=sqrt(wc2min)) ! parameter (sialf=0.5) ! - integer, parameter :: itrmu=25, itrmd=25 + integer, parameter :: itrmu=25, itrmd=25 & &, itrmin=15, itrmnd=12, numtla=2 ! uncentering for vvel in dd - real(kind=kind_phys), parameter :: ddunc1=0.25, ddunc2=one-ddunc1 -! &, ddunc1=0.4, ddunc2=one-ddunc1 -! &, ddunc1=0.3, ddunc2=one-ddunc1 - &, VTPEXP=-0.3636 - & VTP=36.34*SQRT(1.2)*(0.001)**0.1364 + real(kind=kind_phys), parameter :: ddunc1=0.25, ddunc2=one-ddunc1 & +! &, ddunc1=0.4, ddunc2=one-ddunc1 & +! &, ddunc1=0.3, ddunc2=one-ddunc1 & + &, VTPEXP=-0.3636 & + &, VTP=36.34*SQRT(1.2)*(0.001)**0.1364 ! ! real(kind=kind_phys) EM(K*K), ELM(K) real(kind=kind_phys) ELM(K), AA(KD:K,KD:KP1), QW(KD:K,KD:K) & @@ -3302,7 +3312,7 @@ SUBROUTINE DDRFT( & STLA = SIN(TLA*deg2rad) ! sine of tilting angle CTL2 = one - STLA * STLA ! cosine square of tilting angle ! -! if (lprnt) write(0,*)' tla=',tla,' al2=',al2,' ptop=' +! if (lprnt) write(0,*)' tla=',tla,' al2=',al2,' ptop=' & ! &,0.5*(prl(kd)+prl(kd1)),' ntla=',ntla,' f2=',f2,' stla=',stla ! if (lprnt) write(0,*)' buy=',(buy(l),l=kd,kbl) ! @@ -3350,8 +3360,8 @@ SUBROUTINE DDRFT( & ! & + qrp(l)) else -! if (lprnt) write(0,*)' l=',l,' st1=',st1,' wcb=',wcb(l),' qw=' -! &,qw(l,l),' qrp=',qrp(l),' tx1=',tx1,' gsd=',gsd(l),' itr=',itr +! if (lprnt) write(0,*)' l=',l,' st1=',st1,' wcb=',wcb(l),' qw='& +! &,qw(l,l),' qrp=',qrp(l),' tx1=',tx1,' gsd=',gsd(l),' itr=',itr & ! &,' wvl=',wvl(l) ! wvl(l) = 0.5*(wcmin+wvl(l)) @@ -3611,7 +3621,7 @@ SUBROUTINE DDRFT( & KK1 = KK + 1 AA(KK,KK1) = AA(KK,KK1) / AA(KK,KK) ! Qr correction ! TX2 = ABS(AA(KK,KK1)) * QRPI(KK) ! Error Measure ! -! if (lprnt) write(0,*) ' tx2a=',tx2,' aa1=',aa(kk,kk1) +! if (lprnt) write(0,*) ' tx2a=',tx2,' aa1=',aa(kk,kk1) & ! &,' qrpi=',qrpi(kk) ! KK = KBL + 1 @@ -3624,7 +3634,7 @@ SUBROUTINE DDRFT( & AA(L,KK) = (AA(L,KK) - TX1) / AA(L,L) ! Qr correction ! TX2 = MAX(TX2, ABS(AA(L,KK))*QRPI(L)) ! Error Measure ! -! if (lprnt) write(0,*)' tx2b=',tx2,' aa1=',aa(l,kk) +! if (lprnt) write(0,*)' tx2b=',tx2,' aa1=',aa(l,kk) & ! &,' qrpi=',qrpi(l),' L=',L ENDDO @@ -3652,7 +3662,7 @@ SUBROUTINE DDRFT( & ELSE SKPUP = .TRUE. ! Converges ! ERRQ = zero ! Rain profile exists! -! if (lprnt) write(0,*)' here1',' tem=',tem,' tx2=',tx2,' errmi2=', +! if (lprnt) write(0,*)' here1',' tem=',tem,' tx2=',tx2,' errmi2=', & ! &errmi2,' errmin=',errmin ENDIF ELSE @@ -3858,8 +3868,8 @@ SUBROUTINE DDRFT( & ! VT(1) = GMS(L-1) * QRP(L-1) ** 0.1364 VT(1) = GMS(L-1) * QRPF(QRP(L-1)) RNT = ROR(L-1) * (WVL(L-1)+VT(1))*QRP(L-1) -! if(lprnt) write(0,*)' l=',l,' qa=',qa(1), ' tx1RNT=',RNT*tx1, -! *' wvl=',wvl(l-1) +! if(lprnt) write(0,*)' l=',l,' qa=',qa(1), ' tx1RNT=',RNT*tx1,& +! *' wvl=',wvl(l-1) & ! *,' qrp=',qrp(l-1),' tx5=',tx5,' tx1=',tx1,' rnt=',rnt ! @@ -3961,8 +3971,8 @@ SUBROUTINE DDRFT( & TEM2 = TX8 ST1 = zero ENDIF -! if (lprnt) write(0,*)' st1=',st1,' tem=',tem,' ror=',ror(l) -! &,' qrp=',qrp(l),' rnt=',rnt,' ror1=',ror(l-1),' wvl=',wvl(l) +! if (lprnt) write(0,*)' st1=',st1,' tem=',tem,' ror=',ror(l) & +! &,' qrp=',qrp(l),' rnt=',rnt,' ror1=',ror(l-1),' wvl=',wvl(l) & ! &,' wvl1=',wvl(l-1),' tem2=',tem2,' vt=',vt(1),' tx3=',tx3 ! st2 = tx5 @@ -3984,12 +3994,12 @@ SUBROUTINE DDRFT( & ! endif ! ! if(lprnt) write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' -! if(tx5 <= 0.0 .and. l > kd+2) -! & write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' -! *,tem2,' tx3=',tx3,' tem=',tem,' tem1=',tem1,' wvl=',wvl(l-1), -! &wvl(l),' l=',l,' itr=',itr,' evp=',evp(l-1),' vt=',vt(1) +! if(tx5 <= 0.0 .and. l > kd+2) & +! & write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' i & +! *,tem2,' tx3=',tx3,' tem=',tem,' tem1=',tem1,' wvl=',wvl(l-1), & +! &wvl(l),' l=',l,' itr=',itr,' evp=',evp(l-1),' vt=',vt(1) & ! *,' qrp=',qrp(l),' rnt=',rnt,' kd=',kd -! if (lprnt) write(0,*)' etd=',etd(l),' wvl=',wvl(l) +! if (lprnt) write(0,*)' etd=',etd(l),' wvl=',wvl(l) & ! &,' trw=',trw(1),trw(2),' ror=',ror(l),' wa=',wa @@ -4036,7 +4046,7 @@ SUBROUTINE DDRFT( & ENDIF ERRH = HOD(L) - TEM1 ERRQ = ABS(ERRH/HOD(L)) + ABS(ERRE/MAX(ETD(L),ONE_M5)) -! if (lprnt) write(0,*)' ERRQP=',errq,' errh=',errh,' hod=',hod(l) +! if (lprnt) write(0,*)' ERRQP=',errq,' errh=',errh,' hod=',hod(l) & ! &,' erre=',erre,' etd=',etd(l),' del_eta=',del_eta DOF = DDZ VT(2) = QQQ @@ -4080,7 +4090,7 @@ SUBROUTINE DDRFT( & ! Calculate Pd (L+1/2) QA(1) = TX1*RNT + RNF(L-1) - EVP(L-1) ! -! if(lprnt) write(0,*)' etd=',etd(l),' tx5=',tx5,' rnt=',rnt +! if(lprnt) write(0,*)' etd=',etd(l),' tx5=',tx5,' rnt=',rnt & ! *,' rnf=',rnf(l-1),' evp=',evp(l-1),' itr=',itr,' L=',L ! if (qa(1) > zero) then @@ -4099,8 +4109,8 @@ SUBROUTINE DDRFT( & ! Compute Buoyancy TEM1 = WA(3) + (HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & & * onebcp -! if (lprnt) write(0,*)' tem1=',tem1,' wa3=',wa(3),' hod=' -! &,hod(l),' wa1=',wa(1),' qod=',qod(l),' wa2=',wa(2),' alhl=',alhl +! if (lprnt) write(0,*)' tem1=',tem1,' wa3=',wa(3),' hod=' & +! &,hod(l),' wa1=',wa(1),' qod=',qod(l),' wa2=',wa(2),' alhl=',alhl & ! &,' cmpor=',cmpor,' dofw=',dofw,' prl=',prl(l),' qrp=',qrp(l) TEM1 = TEM1 * (one + NU*QOD(L)) ROR(L) = CMPOR * PRL(L) / TEM1 @@ -4115,8 +4125,8 @@ SUBROUTINE DDRFT( & WVL(L) = VT(2) * (ETD(L-1)*WVL(L-1) - FACG & & * (BUY(L-1)*QRT(L-1)+BUY(L)*QRB(L-1))) ! -! if (lprnt) write(0,*)' wvl=',wvl(l),'vt2=',vt(2),' buy1=' -! &,buy(l-1),' buy=',buy(l),' qrt1=',qrt(l-1),' qrb1=',qrb(l-1) +! if (lprnt) write(0,*)' wvl=',wvl(l),'vt2=',vt(2),' buy1=' & +! &,buy(l-1),' buy=',buy(l),' qrt1=',qrt(l-1),' qrb1=',qrb(l-1) & ! &,' etd1=',etd(l-1),' wvl1=',wvl(l-1) ! ENDIF ! @@ -4173,13 +4183,13 @@ SUBROUTINE DDRFT( & QA(1) = TEM - EVP(L-1) ! IF (QA(1) > 0.0) THEN -! if(lprnt) write(0,*)' ror=',ror(l),' tx5=',tx5,' tx1=',tx1 -! *,' tx9=',tx9,' gms=',gms(l),' qa=',qa(1) +! if(lprnt) write(0,*)' ror=',ror(l),' tx5=',tx5,' tx1=',tx1 & +! *,' tx9=',tx9,' gms=',gms(l),' qa=',qa(1 ! if(lprnt) call mpi_quit(13) ! if (tx5 == 0.0 .or. gms(l) == 0.0) -! if (lprnt) -! * write(0,*)' Atx5=',tx5,' gms=',gms(l),' ror=',ror(l) -! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 +! if (lprnt) & +! * write(0,*)' Atx5=',tx5,' gms=',gms(l),' ror=',ror(l) & +! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & ! *,' kbl=',kbl,' etd1=',etd(l-1),' idnm=',idnm,' idn=',idn(idnm) ! *,' errq=',errq @@ -4256,9 +4266,9 @@ SUBROUTINE DDRFT( & ! ! if (tx5 == 0.0 .or. gms(l) == 0.0) ! if (lprnt) -! * write(0,*)' Btx5=',tx5,' gms=',gms(l),' ror=',ror(l) -! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 -! *,' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA +! * write(0,*)' Btx5=',tx5,' gms=',gms(l),' ror=',ror(l) & +! *,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & +! *,' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA & ! &,' evp=',evp(l-1) ! ! IF (QA(1) > 0.0) THEN @@ -4441,17 +4451,11 @@ SUBROUTINE DDRFT( & !*********************************************************************** RETURN - END + end subroutine ddrft SUBROUTINE QSATCN(TT,P,Q,DQDT) ! SUBROUTINE QSATCN(TT,P,Q,DQDT,lprnt) - USE MACHINE , ONLY : kind_phys - USE FUNCPHYS , ONLY : fpvs - USE PHYSCONS, RV => con_RV, CVAP => con_CVAP, CLIQ => con_CLIQ & - &, CSOL => con_CSOL, TTP => con_TTP, HVAP => con_HVAP & - &, HFUS => con_HFUS, EPS => con_eps & - &, EPSM1 => con_epsm1 implicit none ! real(kind=kind_phys) TT, P, Q, DQDT @@ -4459,7 +4463,7 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & &, ONE_M10=1.E-10 & &, rvi=one/rv, facw=CVAP-CLIQ & - &, faci=CVAP-CSOL, hsub=HVAP+HFUS & + &, faci=CVAP-CSOL, hsub=alhl+alhf & &, tmix=TTP-20.0 & &, DEN=one/(TTP-TMIX) ! logical lprnt @@ -4473,15 +4477,14 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) q = MIN(eps*es*D, ONE) ! W = max(ZERO, min(ONE, (TT - TMIX)*DEN)) - hlorv = ( W * (HVAP + FACW * (tt-ttp)) & - & + (one-W) * (HSUB + FACI * (tt-ttp)) ) * RVI + hlorv = ( W * (alhl + FACW * (tt-ttp)) & + & + (one-W) * (alhf + FACI * (tt-ttp)) ) * RVI dqdt = p * q * hlorv * D / (tt*tt) ! return - end + end subroutine qsatcn SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) - USE MACHINE , ONLY : kind_phys ! use module_ras , only : refp, refr, tlac, plac, tlbpl, drdp implicit none @@ -4530,9 +4533,9 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) al2 = min(4.0*tem, max(alm, tem)) ! RETURN - END + end subroutine angrad + SUBROUTINE SETQRP - USE MACHINE , ONLY : kind_phys ! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB,one implicit none @@ -4555,26 +4558,9 @@ SUBROUTINE SETQRP ENDDO ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END - FUNCTION QRPF(QRP) -! - USE MACHINE , ONLY : kind_phys -! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB, one - implicit none + end subroutine setqrp - real(kind=kind_phys) QRP, QRPF, XJ, REAL_NQRP - INTEGER JX -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - REAL_NQRP = REAL(NQRP) - XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),REAL_NQRP) -! XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),FLOAT(NQRP)) - JX = MIN(XJ,NQRP-ONE) - QRPF = TBQRP(JX) + (XJ-JX) * (TBQRP(JX+1)-TBQRP(JX)) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END SUBROUTINE QRABF(QRP,QRAF,QRBF) - USE MACHINE , ONLY : kind_phys ! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB, one implicit none ! @@ -4589,9 +4575,9 @@ SUBROUTINE QRABF(QRP,QRAF,QRBF) QRBF = TBQRB(JX) + XJ * (TBQRB(JX+1)-TBQRB(JX)) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END + end subroutine qrabf + SUBROUTINE SETVTP - USE MACHINE , ONLY : kind_phys ! use module_ras , only : NVTP,C1XVTP,C2XVTP,TBVTP implicit none @@ -4610,13 +4596,28 @@ SUBROUTINE SETVTP ENDDO ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END - FUNCTION VTPF(ROR) + end subroutine setvtp +! + real(kind=kind_phys) FUNCTION QRPF(QRP) +! + implicit none + + real(kind=kind_phys) QRP, XJ, REAL_NQRP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NQRP = REAL(NQRP) + XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),REAL_NQRP) +! XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),FLOAT(NQRP)) + JX = MIN(XJ,NQRP-ONE) + QRPF = TBQRP(JX) + (XJ-JX) * (TBQRP(JX+1)-TBQRP(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end function qrpf + + real(kind=kind_phys) FUNCTION VTPF(ROR) ! - USE MACHINE , ONLY : kind_phys -! use module_ras , only : NVTP,C1XVTP,C2XVTP,TBVTP, one implicit none - real(kind=kind_phys) ROR, VTPF, XJ, REAL_NVTP + real(kind=kind_phys) ROR, XJ, REAL_NVTP INTEGER JX ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - REAL_NVTP = REAL(NVTP) @@ -4625,12 +4626,12 @@ FUNCTION VTPF(ROR) VTPF = TBVTP(JX) + (XJ-JX) * (TBVTP(JX+1)-TBVTP(JX)) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN - END - FUNCTION CLF(PRATE) + end function vtpf + + real(kind=kind_phys) FUNCTION CLF(PRATE) ! - USE MACHINE , ONLY : kind_phys implicit none - real(kind=kind_phys) PRATE, CLF + real(kind=kind_phys) PRATE ! real (kind=kind_phys), parameter :: ccf1=0.30, ccf2=0.09 & &, ccf3=0.04, ccf4=0.01 & @@ -4648,4 +4649,5 @@ FUNCTION CLF(PRATE) endif ! RETURN - END + end function clf + end module rascnv diff --git a/physics/rascnv.meta b/physics/rascnv.meta index 7d93886c0..7201888bc 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -9,6 +9,15 @@ type = integer intent = in optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -77,6 +86,14 @@ type = integer intent = in optional = F +[ntr] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer + intent = in + optional = F [dt] standard_name = time_step_for_physics long_name = physics time step @@ -87,14 +104,102 @@ intent = in optional = F [dtf] - standard_name = time_step_for_physics - long_name = physics time step + standard_name = time_step_for_dynamics + long_name = dynamics timestep units = s dimensions = () type = real kind = kind_phys intent = in optional = F +[ccwf] + standard_name = multiplication_factor_for_critical_cloud_workfunction + long_name = multiplication factor for tical_cloud_workfunction + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dxmin] + standard_name = minimum_scaling_factor_for_critical_relative_humidity + long_name = minimum scaling factor for critical relative humidity + units = m2 rad-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dxinv] + standard_name = inverse_scaling_factor_for_critical_relative_humidity + long_name = inverse scaling factor for critical relative humidity + units = rad2 m-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[psauras] + standard_name = coefficient_from_cloud_ice_to_snow_ras + long_name = conversion coefficient from cloud ice to snow in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[prauras] + standard_name = coefficient_from_cloud_water_to_rain_ras + long_name = conversion coefficient from cloud water to rain in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[wminras] + standard_name = cloud_condensed_water_ice_conversion_threshold_ras + long_name = conversion coefficient from cloud liquid and ice to precipitation in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[dlqf] + standard_name = condensate_fraction_detrained_in_updraft_layers + long_name = condensate fraction detrained with in a updraft layers + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[flipv] + standard_name = flag_flip + long_name = vertical flip logical + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [rannum] standard_name = random_number_array long_name = random number array (0-1) @@ -104,6 +209,71 @@ kind = kind_phys intent = in optional = F +[nrcm] + standard_name = array_dimension_of_random_number + long_name = second dimension of random number stream for RAS + units = count + dimensions = () + type = integer + intent = in + optional = F +[mp_phys] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[mp_phys_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ntk] + standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer + long_name = index for turbulent kinetic energy in the convectively transported tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[rhc] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [tin] standard_name = air_temperature_updated_by_physics long_name = updated temperature @@ -144,19 +314,11 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + dimensions = (horizontal_dimension,vertical_dimension,tracer_dimension) type = real kind = kind_phys intent = inout optional = F -[trac] - standard_name = number_tracers - long_name = number on tracers transported by convection - units = count - dimensions = () - type = integer - intent = in - optional = F [fscav] standard_name = coefficients_for_aerosol_scavenging long_name = array of aerosol scavenging coefficients @@ -167,8 +329,8 @@ intent = in optional = F [prsi] - standard_name = interface_air_pressure - long_name = layer interface pressure + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces units = Pa dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -185,26 +347,26 @@ intent = in optional = F [prsik] - standard_name = interface_exner_function - long_name = layer interface exner function - units = ratio + standard_name = dimensionless_exner_function_at_model_interfaces + long_name = dimensionless Exner function at model layer interfaces + units = none dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [prslk] - standard_name = layer_exner_function - long_name = mean layer exner function - units = ratio + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [phil] - standard_name = layer_geopotential - long_name = layer geopotential + standard_name = geopotential + long_name = geopotential at model layer centers units = m2 s-2 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -212,17 +374,17 @@ intent = in optional = F [phii] - standard_name = interface_geopotential - long_name = layer interface geopotential + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,vertical_dimension_plus_one) type = real kind = kind_phys intent = in optional = F [kpbl] - standard_name = vertical_index_at_pbl_top - long_name = index for pbl top + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer units = index dimensions = (horizontal_dimension) type = integer @@ -271,74 +433,14 @@ intent = inout optional = F [ddvel] - standard_name = downdraft_induced_surface_wind - long_name = downdraft induced surface wind + standard_name = surface_wind_enhancement_due_to_convection + long_name = surface wind enhancement due to convection units = m s-1 dimensions = (horizontal_dimension) type = real kind = kind_phys intent = out optional = F -[flipv] - standard_name = flag_flip - long_name = vertical flip logical - units = flag - dimensions = () - type = logical - intent = in - optional = F -[facmb] - standard_name = pressure_conversion_factor - long_name = conversion factor from input pressure to hPa - units = ratio - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[garea] - standard_name = cell_area - long_name = grid cell area - units = m2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ccwfac] - standard_name = critical_work_function_factor - long_name = factor mupltiplying critical work function - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[nrcm] - standard_name = number_of_random_numbers - long_name = number of random numbers - units = count - dimensions = () - type = integer - intent = in - optional = F -[rhc] - standard_name = critical_relative_humidity - long_name = critical relative humidity - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [ud_mf] standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * dt @@ -357,7 +459,7 @@ kind = kind_phys intent = out optional = F -[det_mf] +[dt_mf] standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * dt units = kg m-2 @@ -366,83 +468,6 @@ kind = kind_phys intent = out optional = F -[c00] - standard_name = rain_auto_conversion_coefficient - long_name = rain auto conversion coefficient - units = m-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[qw0] - standard_name = liquid_water_threshold_in_autoconversion - long_name = liquid water threshold in autoconversion - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[c00i] - standard_name = snow_auto_conversion_coefficient - long_name = snow auto conversion coefficient - units = m-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[qi0] - standard_name = ice_water_threshold_in_autoconversion - long_name = ice water threshold in autoconversion - units = kg kg-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dlqfac] - standard_name = condensate_fraction_detrained_in_updraft_layer - long_name = condensate fraction detrained with in a updraft layer - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[lprnt] - standard_name = flag_debug_print - long_name = debug print logical - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ipr] - standard_name = horizontal_grid_index - long_name = horizontal grid index - units = count - dimensions = () - type = integer - intent = in - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current time step index - units = index - dimensions = () - type = integer - intent = in - optional = F -[revap] - standard_name = flag_rain_revap - long_name = rain reevaporation logical - units = flag - dimensions = () - type = logical - intent = in - optional = F [qlcn] standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water @@ -533,39 +558,6 @@ kind = kind_phys intent = inout optional = F -[mp_phys] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[mp_phys_mg] - standard_name = flag_for_morrison_gettelman_microphysics_scheme - long_name = choice of Morrison-Gettelman microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[trcmin] - standard_name = floor_value_for_tracers - long_name = minimum tracer value - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[ntk] - standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer - long_name = index for turbulent kinetic energy in the convectively transported tracer array - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 9e906cc1ffa93fc22eda95715ba73b3d63546a30 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 1 Nov 2019 11:05:51 +0000 Subject: [PATCH 008/141] bug fix in rascnv.F90 --- physics/rascnv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 8273bd3af..6354f826a 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -453,7 +453,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & enddo DO IPT=1,IM - tem1 = (log(area(i)) - dxmin) * dxinv + tem1 = (log(area(ipt)) - dxmin) * dxinv tem2 = one - tem1 ccwfac = ccwf(1)*tem1 + ccwf(2)*tem2 dlq_fac = dlqf(1)*tem1 + dlqf(2)*tem2 From 51c13beef8b36036b5a9ac34b7951fe20b1d4eb2 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 6 Nov 2019 00:22:21 +0000 Subject: [PATCH 009/141] after merging with ccpp/physics master on nom04 --- physics/GFS_debug.F90 | 43 ++--------------------------- physics/GFS_suite_interstitial.F90 | 32 ++++++++++++++++----- physics/GFS_suite_interstitial.meta | 41 +++++++++++++++++++++++++++ physics/rrtmg_lw_pre.F90 | 12 +------- physics/rrtmg_sw_pre.F90 | 19 +------------ 5 files changed, 71 insertions(+), 76 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 1a13b3649..df56cc069 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -41,23 +41,7 @@ subroutine GFS_diagtoscreen_finalize () end subroutine GFS_diagtoscreen_finalize !> \section arg_table_GFS_diagtoscreen_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type in FV3 | DDT | 0 | GFS_control_type | | in | F | -!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type in FV3 | DDT | 0 | GFS_statein_type | | in | F | -!! | Stateout | GFS_stateout_type_instance | instance of derived type GFS_stateout_type | DDT | 0 | GFS_stateout_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | instance of type GFS_sfcprop_type in FV3 | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Coupling | GFS_coupling_type_instance | instance of type GFS_coupling_type in FV3 | DDT | 0 | GFS_coupling_type | | in | F | -!! | Grid | GFS_grid_type_instance | instance of type GFS_grid_type in FV3 | DDT | 0 | GFS_grid_type | | in | F | -!! | Tbd | GFS_tbd_type_instance | instance of type GFS_tbd_type in FV3 | DDT | 0 | GFS_tbd_type | | in | F | -!! | Cldprop | GFS_cldprop_type_instance | instance of type GFS_cldprop_type in FV3 | DDT | 0 | GFS_cldprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | instance of type GFS_radtend_type in FV3 | DDT | 0 | GFS_radtend_type | | in | F | -!! | Diag | GFS_diag_type_instance | instance of type GFS_diag_type in FV3 | DDT | 0 | GFS_diag_type | | in | F | -!! | Interstitial | GFS_interstitial_type_instance | instance of type GFS_interstitial_type in FV3 | DDT | 0 | GFS_interstitial_type | | in | F | -!! | nthreads | omp_threads | number of OpenMP threads or fast physics schemes | count | 0 | integer | | in | F | -!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_diagtoscreen_run.html !! subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & @@ -765,23 +749,7 @@ subroutine GFS_interstitialtoscreen_finalize () end subroutine GFS_interstitialtoscreen_finalize !> \section arg_table_GFS_interstitialtoscreen_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type | DDT | 0 | GFS_control_type | | in | F | -!! | Statein | GFS_statein_type_instance | instance of derived type GFS_statein_type | DDT | 0 | GFS_statein_type | | in | F | -!! | Stateout | GFS_stateout_type_instance | instance of derived type GFS_stateout_type | DDT | 0 | GFS_stateout_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | instance of derived type GFS_sfcprop_type | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Coupling | GFS_coupling_type_instance | instance of derived type GFS_coupling_type | DDT | 0 | GFS_coupling_type | | in | F | -!! | Grid | GFS_grid_type_instance | instance of derived type GFS_grid_type | DDT | 0 | GFS_grid_type | | in | F | -!! | Tbd | GFS_tbd_type_instance | instance of derived type GFS_tbd_type | DDT | 0 | GFS_tbd_type | | in | F | -!! | Cldprop | GFS_cldprop_type_instance | instance of derived type GFS_cldprop_type | DDT | 0 | GFS_cldprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | instance of derived type GFS_radtend_type | DDT | 0 | GFS_radtend_type | | in | F | -!! | Diag | GFS_diag_type_instance | instance of derived type GFS_diag_type | DDT | 0 | GFS_diag_type | | in | F | -!! | Interstitial | GFS_interstitial_type_instance | instance of derived type GFS_interstitial_type | DDT | 0 | GFS_interstitial_type | | in | F | -!! | nthreads | omp_threads | number of OpenMP threads or fast physics schemes | count | 0 | integer | | in | F | -!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_interstitialtoscreen_run.html !! subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & @@ -893,12 +861,7 @@ subroutine GFS_abort_finalize () end subroutine GFS_abort_finalize !> \section arg_table_GFS_abort_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|---------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | instance of derived type GFS_control_type | DDT | 0 | GFS_control_type | | in | F | -!! | blkno | ccpp_block_number | number of block for explicit data blocking in CCPP | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude GFS_abort_run.html !! subroutine GFS_abort_run (Model, blkno, errmsg, errflg) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 379589b3c..d88992c64 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -459,10 +459,10 @@ end subroutine GFS_suite_interstitial_3_finalize !! \htmlinclude GFS_suite_interstitial_3_run.html !! #endif - subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & - ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, xlat, gq0, imp_physics, imp_physics_mg, imp_physics_zhao_carr,& - imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, prsi, prsl, prslk, rhcbot, & - rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, kinver, ras, & + subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & + ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, xlon, xlat, gq0, imp_physics, imp_physics_mg, & + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, prsi, prsl, & + prslk, rhcbot, rhcpbl, rhctop, rhcmax, islmsk, work1, work2, kpbl, kinver, ras, lprnt, ipt, kdt, me, & clw, rhc, save_qc, save_qi, errmsg, errflg) use machine, only: kind_phys @@ -472,7 +472,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr ! interface variables integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntclamt, ntrw, & ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, kdt, me integer, dimension(im), intent(in) :: islmsk, kpbl, kinver logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras @@ -480,13 +480,15 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr real(kind=kind_phys), dimension(im), intent(in) :: work1, work2 real(kind=kind_phys), dimension(im, levs), intent(in) :: prsl, prslk real(kind=kind_phys), dimension(im, levs+1), intent(in) :: prsi - real(kind=kind_phys), dimension(im), intent(in) :: xlat + real(kind=kind_phys), dimension(im), intent(in) :: xlon, xlat real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 real(kind=kind_phys), dimension(im, levs), intent(inout) :: rhc, save_qc ! save_qi is not allocated for Zhao-Carr MP real(kind=kind_phys), dimension(:, :), intent(inout) :: save_qi real(kind=kind_phys), dimension(im, levs, nn), intent(inout) :: clw + logical, intent(inout) :: lprnt + integer, intent(inout) :: ipt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -500,12 +502,28 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, satmedmf, trans_tr ! turnrhcrit = 0.900, turnrhcrit_upper = 0.150 ! in the following inverse of slope_mg and slope_upmg are specified real(kind=kind_phys),parameter :: slope_mg = 50.0_kind_phys, & - slope_upmg = 25.0_kind_phys + slope_upmg = 25.0_kind_phys, & + rad2dg = 180.0/3.14159265359 ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + do i=1,im + lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-29.55) < 0.201 & + .and. abs(xlat(i)*rad2dg+59.62) < 0.201 +! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-169.453) < 0.501 & +! .and. abs(xlat(i)*rad2dg-72.96) < 0.501 +! if (kdt == 1) & +! write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & +! ' xlat=',xlat(i)*rad2dg,' me=',me + if (lprnt) then + ipt = i + write(0,*)' ipt=',ipt,'xlon=',xlon(i)*rad2dg,' xlat=',xlat(i)*rad2dg,' me=',me + exit + endif + enddo +! !GF* The following section (initializing convective variables) is already executed in GFS_typedefs%interstitial_phys_reset ! do k=1,levs ! do i=1,im diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 1523219ae..0e322a819 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1201,6 +1201,15 @@ type = integer intent = in optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [xlat] standard_name = latitude long_name = latitude @@ -1388,6 +1397,38 @@ type = logical intent = in optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipt] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [clw] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index ca0bc408b..5f128a79a 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -12,17 +12,7 @@ subroutine rrtmg_lw_pre_init () end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rrtmg_lw_pre_run.html !! subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errmsg, errflg) diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 41919b1a2..8eeb16430 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -12,24 +12,7 @@ subroutine rrtmg_sw_pre_init () end subroutine rrtmg_sw_pre_init !> \section arg_table_rrtmg_sw_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | -!! | idxday | daytime_points | daytime points | index | 1 | integer | | out | F | -!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb3 | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb4 | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | out | F | -!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! \htmlinclude rrtmg_sw_pre_run.html !! subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & nday, idxday, tsfg, tsfa, sfcalb1, sfcalb2, sfcalb3, sfcalb4, & From af996a7fb3253dd5e0e78160c97e81d423653464 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 12 Nov 2019 12:59:33 +0000 Subject: [PATCH 010/141] 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 011/141] 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 b7a35311940736efe39de9c62f22e3a28b024f4e Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 13 Dec 2019 11:44:17 -0700 Subject: [PATCH 012/141] 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 013/141] 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 014/141] 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 289f834f94154724a6222910cf1efc15b64b61f7 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Fri, 27 Dec 2019 16:44:56 -0500 Subject: [PATCH 015/141] passed compliation ccpp/physics --- physics/m_micro.F90 | 3 ++- physics/m_micro.meta | 12 ++---------- physics/micro_mg2_0.F90 | 3 ++- physics/micro_mg3_0.F90 | 3 ++- 4 files changed, 8 insertions(+), 13 deletions(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index d57139701..7ac887a3b 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -183,7 +183,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & integer, parameter :: ncolmicro = 1 integer,intent(in) :: im, ix,lm, ipr, kdt, fprcp, pdfflag - logical,intent(in) :: flipv, skip_macro, lprnt, iccn + logical,intent(in) :: flipv, skip_macro, lprnt + integer,intent(in) :: iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) real (kind=kind_phys), dimension(ix,lm),intent(in) :: & diff --git a/physics/m_micro.meta b/physics/m_micro.meta index d649edebf..6406755e2 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -781,14 +781,6 @@ kind = kind_phys intent = in optional = F -[iaerclm] - standard_name = flag_for_aerosol_input_MG - long_name = flag for using aerosols in Morrison-Gettelman microphysics - units = flag - dimensions = () - type = logical - intent = in - optional = F [naai_i] standard_name = in_number_concentration long_name = IN number concentration @@ -810,9 +802,9 @@ [iccn] standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics long_name = flag for IN and CCN forcing for morrison gettelman microphysics - units = flag + units = none dimensions = () - type = logical + type = integer intent = in optional = F [skip_macro] diff --git a/physics/micro_mg2_0.F90 b/physics/micro_mg2_0.F90 index b3f7d19b3..90bf48054 100644 --- a/physics/micro_mg2_0.F90 +++ b/physics/micro_mg2_0.F90 @@ -464,7 +464,8 @@ subroutine micro_mg_tend ( & 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 + logical, intent(in) :: lprnt + integer, intent(in) :: iccn ! used for scavenging diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 4043c0737..215d3516b 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -583,7 +583,8 @@ subroutine micro_mg_tend ( & 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 + integer, intent(in) :: iccn !< flag for IN and CCN forcing for Morrison-Gettelman microphysics + ! used for scavenging From 62fb748a3cacaa78e34dea5f1791eaed91af9094 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 28 Dec 2019 01:25:54 +0000 Subject: [PATCH 016/141] 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 017/141] 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 16ead436cc5e9bdf1bce2a3a5565799f8d8e2efb Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 30 Dec 2019 16:35:51 -0500 Subject: [PATCH 018/141] changes in meta data --- physics/m_micro.meta | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/physics/m_micro.meta b/physics/m_micro.meta index d649edebf..baba6c617 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -781,14 +781,6 @@ kind = kind_phys intent = in optional = F -[iaerclm] - standard_name = flag_for_aerosol_input_MG - long_name = flag for using aerosols in Morrison-Gettelman microphysics - units = flag - dimensions = () - type = logical - intent = in - optional = F [naai_i] standard_name = in_number_concentration long_name = IN number concentration @@ -810,11 +802,11 @@ [iccn] standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics long_name = flag for IN and CCN forcing for morrison gettelman microphysics - units = flag + units = none dimensions = () - type = logical + type = integer intent = in - optional = F + optional = 0 [skip_macro] standard_name = flag_skip_macro long_name = flag to skip cloud macrophysics in Morrison scheme From b30d0ce83f25e80616770dd433451b99eccb3a57 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Tue, 31 Dec 2019 21:53:55 -0500 Subject: [PATCH 019/141] fixed an error in m_micro.meta --- physics/m_micro.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/m_micro.meta b/physics/m_micro.meta index baba6c617..6406755e2 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -806,7 +806,7 @@ dimensions = () type = integer intent = in - optional = 0 + optional = F [skip_macro] standard_name = flag_skip_macro long_name = flag to skip cloud macrophysics in Morrison scheme From e9e685055dd95ddcac721e1eaf4a878658e12749 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Thu, 2 Jan 2020 14:06:51 -0500 Subject: [PATCH 020/141] passed ccpp compilation and testing ipd compilation --- CMakeLists.txt | 174 ++++++++++++++++-------- physics/GFS_MP_generic.F90 | 48 ++++--- physics/GFS_phys_time_vary.fv3.F90 | 10 +- physics/GFS_phys_time_vary.scm.F90 | 10 +- physics/cires_ugwp_post.F90 | 20 +-- physics/cs_conv.F90 | 40 ++---- physics/drag_suite.F90 | 19 ++- physics/gwdps.f | 8 +- physics/module_gfdl_cloud_microphys.F90 | 8 +- physics/mp_thompson.F90 | 2 +- physics/sfc_drv_ruc.F90 | 31 ++--- physics/sfc_drv_ruc.meta | 45 ++---- 12 files changed, 221 insertions(+), 194 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 443d7ea51..b8d3c3e18 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 @@ -109,13 +123,28 @@ 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(./physics/module_SF_JSFC.F90 ./physics/module_BL_MYJPBL.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") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.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 # that are executed in the dynamics (fast physics part) @@ -126,10 +155,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 @@ -145,30 +174,30 @@ 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 - ./physics/module_SF_JSFC.F90 - ./physics/module_BL_MYJPBL.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 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 PROPERTIES COMPILE_FLAGS "-r8 -ftz") # Replace -xHost or -xCORE-AVX2 with -xCORE-AVX-I for certain files @@ -182,10 +211,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) # Remove files with special compiler flags from list of files with standard compiler flags list(REMOVE_ITEM SCHEMES ${SCHEMES_SFX_OPT}) @@ -200,10 +229,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 @@ -216,22 +245,52 @@ 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(./physics/module_mp_thompson_make_number_concentrations.F90 PROPERTIES COMPILE_FLAGS "-r8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_SF_JSFC.F90 ./physics/module_BL_MYJPBL.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") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.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(./physics/module_SF_JSFC.F90 ./physics/module_BL_MYJPBL.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") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.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) @@ -240,10 +299,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 @@ -291,9 +350,10 @@ 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}) + list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${module_f90}) endforeach() else(STATIC) add_library(ccppphys SHARED ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 66357844f..512257258 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,26 +280,34 @@ 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 - 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) - if (tsfc(i) >= 273.15) then - crain = rainc(i) - csnow = 0.0 - else - crain = 0.0 - csnow = rainc(i) - endif -! if (snow0(i,1)+ice0(i,1)+graupel0(i,1)+csnow > rain0(i,1)+crain) then -! if (snow0(i)+ice0(i)+graupel0(i)+csnow > 0.0) then -! Sfcprop%srflag(i) = 1. ! clu: set srflag to 'snow' (i.e. 1) -! endif + + 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) + if (tsfc(i) >= 273.15) then + crain = rainc(i) + csnow = 0.0 + else + crain = 0.0 + csnow = rainc(i) + endif +! if (snow0(i,1)+ice0(i,1)+graupel0(i,1)+csnow > rain0(i,1)+crain) then +! 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 - endif - enddo + 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 + endif + enddo + else + ! only for RUC LSM + do i=1,im + srflag(i) = sr(i) + enddo + endif ! lsm==lsm_ruc elseif( .not. cal_pre) then if (imp_physics == imp_physics_mg) then ! MG microphysics do i=1,im diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 4ad699529..f9e2369cd 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -164,7 +164,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%aero_in is .true., then ntrcaer == ntrcaerm + ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm ntrcaer = size(Data(1)%Tbd%aer_nm, dim=3) ! Read aerosol climatology call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate) @@ -172,13 +172,13 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%aero_in is .false., then ntrcaer == 1 + ! If Model%iaerclm is .false., then ntrcaer == 1 ntrcaer = size(Data(1)%Tbd%aer_nm, dim=3) endif !$OMP section !> - Call read_cidata() to read IN and CCN data - if (Model%iccn == 1) then + if (Model%iccn) then call read_cidata ( Model%me, Model%master) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 @@ -242,7 +242,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e endif !> - Call setindxci() to initialize IN and CCN data - if (Model%iccn == 1) then + if (Model%iccn) then !$OMP do schedule (dynamic,1) do nb = 1, nblks call setindxci (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_ci, & @@ -451,7 +451,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, endif !> - Call ciinterpol() to make IN and CCN data interpolation - if (Model%iccn == 1) then + if (Model%iccn) then !$OMP do schedule (dynamic,1) do nb = 1, nblks call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 34a04192a..5e60f667f 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -107,7 +107,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%aero_in is .true., then ntrcaer == ntrcaerm + ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm ntrcaer = size(Tbd%aer_nm, dim=3) ! Read aerosol climatology call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate) @@ -115,11 +115,11 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%aero_in is .false., then ntrcaer == 1 + ! If Model%iaerclm is .false., then ntrcaer == 1 ntrcaer = size(Tbd%aer_nm, dim=3) endif - if (Model%iccn == 1) then + if (Model%iccn) then call read_cidata ( Model%me, Model%master) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 @@ -156,7 +156,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf Model%me, Model%master) endif !--- read in and initialize IN and CCN - if (Model%iccn == 1) then + if (Model%iccn) then call setindxci (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_ci, & Grid%jindx2_ci, Grid%ddy_ci, Grid%xlon_d, & Grid%iindx1_ci, Grid%iindx2_ci, Grid%ddx_ci) @@ -331,7 +331,7 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Tbd%aer_nm) endif !--- ICCN interpolation - if (Model%iccn == 1) then + if (Model%iccn) then call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & Grid%jindx1_ci, Grid%jindx2_ci, & Grid%ddy_ci,Grid%iindx1_ci, & 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 diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index f9d7518ef..956d5a1d0 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -181,10 +181,9 @@ module cs_conv ! spblcrit=0.03, & !< minimum cloudbase height in p/ps ! spblcrit=0.035,& !< minimum cloudbase height in p/ps ! spblcrit=0.025,& !< minimum cloudbase height in p/ps - cincrit=-10.0, & - capecrit=0.0 -! cincrit=-120.0 -! cincrit=-100.0 + cincrit= -150.0 +! cincrit= -120.0 +! cincrit= -100.0 !DD precz0 and preczh control partitioning of water between detrainment !DD and precipitation. Decrease for more precip @@ -1080,22 +1079,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions DO I=ISTS,IENS CAPE(i) = zero CIN(i) = zero -! JBUOY(i) = 0 + JBUOY(i) = 0 enddo - -!Anning Cheng, CIN from the cloud base to positive buoy layer only - DO I=ISTS,IENS - if (kb(i) > 0) then - DO K=kb(i),KMAX - BUOY = (GDH(I,1)-GDHS(I,K)) / ((one+ELOCP*FDQS(I,K)) * CP*GDT(I,K)) - if (BUOY < 0.) then - CIN(I) = CIN(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) - else - cycle - end if - ENDDO - end if - ENDDO DO K=2,KMAX DO I=ISTS,IENS if (kb(i) > 0) then @@ -1104,22 +1089,21 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ELSE BUOY = (GDS(I,1)-GDS(I,K)) / (CP*GDT(I,K)) END IF - IF (BUOY > zero) THEN + IF (BUOY > zero .AND. JBUOY(I) >= -1) THEN CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) -! IF (BUOY > zero .AND. JBUOY(I) /= 0) THEN -! CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) -! JBUOY(I) = 2 -! ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN -! CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) -! JBUOY(I) = 1 + JBUOY(I) = 2 + ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN + CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) + JBUOY(I) = -1 ENDIF endif ENDDO ENDDO DO I=ISTS,IENS -! IF (JBUOY(I) /= 2) CIN(I) = -999.D0 - if (cin(i) < cincrit .or. cape(i) -# Initialize variables before summing over cloud types do k=1,kmax ! Moorthi 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 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) :: & 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 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 !>@} diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 64e4d4597..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, & + & 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, & @@ -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: @@ -215,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 @@ -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 @@ -471,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)) @@ -897,7 +890,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) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 8d06e4785..dac459405 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 @@ -377,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 @@ -404,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 @@ -468,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 47ecb07ac0e7dfee9537fa5a013b7bf1e9ed9b7c Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 6 Jan 2020 16:08:16 -0500 Subject: [PATCH 021/141] regression test for iccn=1 and iccn=2 --- physics/GFS_phys_time_vary.fv3.F90 | 6 +++--- physics/GFS_phys_time_vary.scm.F90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index f9e2369cd..16f84e4c7 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -178,7 +178,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !$OMP section !> - Call read_cidata() to read IN and CCN data - if (Model%iccn) then + if (Model%iccn == 1) then call read_cidata ( Model%me, Model%master) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 @@ -242,7 +242,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e endif !> - Call setindxci() to initialize IN and CCN data - if (Model%iccn) then + if (Model%iccn == 1) then !$OMP do schedule (dynamic,1) do nb = 1, nblks call setindxci (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_ci, & @@ -451,7 +451,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, endif !> - Call ciinterpol() to make IN and CCN data interpolation - if (Model%iccn) then + if (Model%iccn == 1) then !$OMP do schedule (dynamic,1) do nb = 1, nblks call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 5e60f667f..095dac2c7 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -119,7 +119,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf ntrcaer = size(Tbd%aer_nm, dim=3) endif - if (Model%iccn) then + if (Model%iccn == 1) then call read_cidata ( Model%me, Model%master) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 @@ -156,7 +156,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf Model%me, Model%master) endif !--- read in and initialize IN and CCN - if (Model%iccn) then + if (Model%iccn == 1) then call setindxci (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_ci, & Grid%jindx2_ci, Grid%ddy_ci, Grid%xlon_d, & Grid%iindx1_ci, Grid%iindx2_ci, Grid%ddx_ci) @@ -331,7 +331,7 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Tbd%aer_nm) endif !--- ICCN interpolation - if (Model%iccn) then + if (Model%iccn == 1) then call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & Grid%jindx1_ci, Grid%jindx2_ci, & Grid%ddy_ci,Grid%iindx1_ci, & From 15ca41814c28f91b9a4db86fe4f50c85b38de323 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Fri, 17 Jan 2020 14:16:25 -0500 Subject: [PATCH 022/141] MERRA2 consistent radiation pass regression tests --- physics/GFS_rrtmg_pre.F90 | 7 +- physics/aerclm_def.F | 21 +- physics/aerinterp.F90 | 323 ++-- physics/radiation_aerosols.f | 3128 +++++++++++----------------------- 4 files changed, 1139 insertions(+), 2340 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index f6e683bff..7845165a6 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -473,9 +473,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input !check print *,' in grrad : calling setaer ' call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & ! --- inputs - tracer1, Grid%xlon, Grid%xlat, IM, LMK, LMP, & - Model%lsswr, Model%lslwr, & - faersw, faerlw, aerodp) ! --- outputs + tracer1, Tbd%aer_nm, & + Grid%xlon, Grid%xlat, IM, LMK, LMP, & + Model%lsswr,Model%lslwr, & + faersw,faerlw,aerodp) ! --- outputs ! CCPP do j = 1,NBDSW diff --git a/physics/aerclm_def.F b/physics/aerclm_def.F index ec2366b43..84852a1de 100644 --- a/physics/aerclm_def.F +++ b/physics/aerclm_def.F @@ -1,28 +1,23 @@ -!>\file aerclm_def.F -!! This file contains aerosol climatology definition in MG microphysics - -!>\ingroup mod_GFS_phys_time_vary -!! This module defines aerosol arrays in MG microphysics. module aerclm_def use machine , only : kind_phys implicit none -! only read monthly merra2 data for m-1, m, m+1 - integer, parameter :: levsaer=45, latsaer=91, lonsaer=144 - integer, parameter :: lmerra=72, ntrcaerm=15, timeaer=12 + integer, parameter :: levsaer=50, ntrcaerm=15, timeaer=12 + integer :: latsaer, lonsaer, ntrcaer - integer :: ntrcaer character*10 :: specname(ntrcaerm) - real (kind=kind_phys):: aer_lat(latsaer), aer_lon(lonsaer) - & ,aer_time(13) - real (kind=4), allocatable, dimension(:,:,:,:,:) :: aerin + real (kind=kind_phys):: aer_time(13) + + real (kind=kind_phys), allocatable, dimension(:) :: aer_lat + real (kind=kind_phys), allocatable, dimension(:) :: aer_lon real (kind=kind_phys), allocatable, dimension(:,:,:,:) :: aer_pres + real (kind=kind_phys), allocatable, dimension(:,:,:,:,:) :: aerin data aer_time/15.5, 45., 74.5, 105., 135.5, 166., 196.5, & 227.5, 258., 288.5, 319., 349.5, 380.5/ data specname /'DU001','DU002','DU003','DU004','DU005', & 'SS001','SS002','SS003','SS004','SS005','SO4', - & 'BCPHOBIC','BCPHILIC','OCPHILIC','OCPHOBIC'/ + & 'BCPHOBIC','BCPHILIC','OCPHOBIC','OCPHILIC'/ end module aerclm_def diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index d47baacc9..8c7046d37 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -16,169 +16,185 @@ module aerinterp contains SUBROUTINE read_aerdata (me, master, iflip, idate ) - - use machine, only: kind_phys + use machine, only: kind_phys, kind_io4, kind_io8 use aerclm_def use netcdf !--- in/out integer, intent(in) :: me, master, iflip, idate(4) - !--- locals - integer :: ncid, varid - integer :: i, j, k, n, ii, ijk, imon, klev - character :: fname*50, mn*2, fldname*10 + integer :: ncid, varid, ndims, dim1, dim2, dim3, hmx + integer :: i, j, k, n, ii, imon, klev + character :: fname*50, mn*2, vname*10 logical :: file_exist - real(kind=4), allocatable, dimension(:,:,:) :: ps_clm - real(kind=4), allocatable, dimension(:,:,:,:) :: delp_clm - real(kind=4), allocatable, dimension(:,:,:,:) :: aer_clm - real(kind=4), allocatable, dimension(:,:,:,:) :: airden_clm - real(kind=4), allocatable, dimension(:) :: pres_tmp - - allocate (delp_clm(lonsaer,latsaer,lmerra,1)) - allocate (aer_clm(lonsaer,latsaer,lmerra,1)) - allocate (airden_clm(lonsaer,latsaer,lmerra,1)) - allocate (ps_clm(lonsaer,latsaer,1)) - allocate (pres_tmp(lmerra)) - -! allocate aerclm_def arrays: aerin and aer_pres - allocate (aerin(lonsaer,latsaer,levsaer,ntrcaer,timeaer)) - allocate (aer_pres(lonsaer,latsaer,levsaer,timeaer)) + integer, allocatable :: invardims(:) + real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff + real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx + real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp + real(kind=kind_io8),allocatable,dimension(:) :: aer_lati + real(kind=kind_io8),allocatable,dimension(:) :: aer_loni +! +!! =================================================================== if (me == master) then if ( iflip == 0 ) then ! data from toa to sfc - print *, "EJ, GFS is top-down" + print *, "GFS is top-down" else - print *, "EJ, GFS is bottom-up" + print *, "GFS is bottom-up" endif endif +! +!! =================================================================== +!! fetch dim spec and lat/lon from m01 data set +!! =================================================================== + fname=trim("aeroclim.m"//'01'//".nc") + inquire (file = fname, exist = file_exist) + if (.not. file_exist ) then + print *, 'fname not found, abort' + stop 8888 + endif + call nf_open(fname , nf90_NOWRITE, ncid) + + vname = trim(specname(1)) + call nf_inq_varid(ncid, vname, varid) + call nf_inq_varndims(ncid, varid, ndims) + + if(.not. allocated(invardims)) allocate(invardims(3)) + call nf_inq_vardimid(ncid,varid,invardims) + call nf_inq_dimlen(ncid, invardims(1), dim1) + call nf_inq_dimlen(ncid, invardims(2), dim2) + call nf_inq_dimlen(ncid, invardims(3), dim3) + +! specify latsaer, lonsaer, hmx + lonsaer = dim1 + latsaer = dim2 + hmx = int(dim1/2) ! to swap long from W-E to E-W + + if(me==master) then + print *, 'MERRA2 dim: ',dim1, dim2, dim3 + endif + +! allocate arrays + if (.not. allocated(aer_loni)) then + allocate (aer_loni(lonsaer)) + allocate (aer_lati(latsaer)) + endif + + if (.not. allocated(aer_lat)) then + allocate(aer_lat(latsaer)) + allocate(aer_lon(lonsaer)) + allocate(aerin(lonsaer,latsaer,levsaer,ntrcaerm,timeaer)) + allocate(aer_pres(lonsaer,latsaer,levsaer,timeaer)) + endif + +! construct lat/lon array + call nf_inq_varid(ncid, 'lat', varid) + call nf_get_var(ncid, varid, aer_lati) + call nf_inq_varid(ncid, 'lon', varid) + call nf_get_var(ncid, varid, aer_loni) + + do i = 1, hmx ! flip from (-180,180) to (0,360) + if(aer_loni(i)<0.) aer_loni(i)=aer_loni(i)+360. + aer_lon(i+hmx) = aer_loni(i) + aer_lon(i) = aer_loni(i+hmx) + enddo + + do i = 1, latsaer + aer_lat(i) = aer_lati(i) + enddo + + call nf_close(ncid) + +! allocate local working arrays + if (.not. allocated(buff)) then + allocate (buff(lonsaer, latsaer, dim3)) + allocate (pres_tmp(lonsaer,dim3)) + endif + if (.not. allocated(buffx)) then + allocate (buffx(lonsaer, latsaer, dim3,1)) + endif +!! =================================================================== +!! loop thru m01 - m12 for aer/pres array +!! =================================================================== do imon = 1, timeaer - !ijk = imon + idate(2)+int(idate(3)/16)-2 - !if ( ijk .le. 0 ) ijk = 12 - !if ( ijk .eq. 13 ) ijk = 1 - !if ( ijk .eq. 14 ) ijk = 2 write(mn,'(i2.2)') imon - fname=trim("merra2C.aerclim.2003-2014.m"//mn//".nc") - if (me == master) print *, "EJ,aerosol climo:", fname, & + fname=trim("aeroclim.m"//mn//".nc") + if (me == master) print *, "aerosol climo:", fname, & "for imon:",imon,idate inquire (file = fname, exist = file_exist) if ( file_exist ) then if (me == master) print *, & - "EJ, aerosol climo found; proceed the run" + "aerosol climo found; proceed the run" else - print *,"EJ, Error! aerosol climo not found; abort the run" + print *,"Error! aerosol climo not found; abort the run" stop 555 endif - call nf_open(fname, NF90_NOWRITE, ncid) + call nf_open(fname , nf90_NOWRITE, ncid) -! merra2 data is top down -! for GFS, iflip 0: toa to sfc; 1: sfc to toa - -! read aerosol mixing ratio arrays (kg/kg) -! construct 4-d aerosol mass concentration (kg/m3) - call nf_inq_varid(ncid, 'AIRDENS', varid) - call nf_get_var(ncid, varid, airden_clm) -! if(me==master) print *, "EJ, read airdens", airden_clm(1,1,:,1) - - do ii = 1, ntrcaer - fldname=specname(ii) - call nf_inq_varid(ncid, fldname, varid) - call nf_get_var(ncid, varid, aer_clm) -! if(me==master) print *, "EJ, read ", fldname, aer_clm(1,1,:,1) - do i = 1, lonsaer - do j = 1, latsaer - do k = 1, levsaer -! input is from toa to sfc - if ( iflip == 0 ) then ! data from toa to sfc - klev = k - else ! data from sfc to top - klev = ( lmerra - k ) + 1 - endif - aerin(i,j,k,ii,imon) = aer_clm(i,j,klev,1)*airden_clm(i,j,klev,1) - enddo !k-loop (lev) - enddo !j-loop (lat) - enddo !i-loop (lon) - enddo !ii-loop (ntrac) - -! aer_clm is top-down (following MERRA2) -! aerin is bottom-up (following GFS) - -! if ( imon == 1 .and. me == master ) then -! print *, 'EJ, du1(1,1) :', aerin(1,1,:,1,imon) -! endif - -! construct 3-d pressure array (Pa) - call nf_inq_varid(ncid, "PS", varid) - call nf_get_var(ncid, varid, ps_clm) +! ====> construct 3-d pressure array (Pa) call nf_inq_varid(ncid, "DELP", varid) - call nf_get_var(ncid, varid, delp_clm) - -! if ( imon == 1 .and. me == master ) then -! print *, 'EJ, ps_clm:', ps_clm(1,1,1) -! print *, 'EJ, delp_clm:', delp_clm(1,1,:,1) -! endif + call nf_get_var(ncid, varid, buff) - do i = 1, lonsaer do j = 1, latsaer + do i = 1, lonsaer +! constract pres_tmp (top-down), note input is top-down + pres_tmp(i,1) = 0. + do k=2, dim3 + pres_tmp(i,k) = pres_tmp(i,k-1)+buff(i,j,k) + enddo !k-loop + enddo !i-loop (lon) -! constract pres_tmp (top-down) - pres_tmp(1) = 0. - do k=2, lmerra - pres_tmp(k) = pres_tmp(k-1) + delp_clm(i,j,k,1) - enddo -! if (imon==1 .and. me==master .and. i==1 .and. j==1 ) then -! print *, 'EJ, pres_tmp:', pres_tmp(:) -! endif - -! extract pres_tmp to fill aer_pres +! extract pres_tmp to fill aer_pres (in Pa) do k = 1, levsaer if ( iflip == 0 ) then ! data from toa to sfc klev = k else ! data from sfc to top - klev = ( lmerra - k ) + 1 + klev = ( dim3 - k ) + 1 endif - aer_pres(i,j,k,imon)= pres_tmp(klev) + do i = 1, hmx + aer_pres(i+hmx,j,k,imon)= 1.d0*pres_tmp(i,klev) + aer_pres(i,j,k,imon) = 1.d0*pres_tmp(i+hmx,klev) + enddo !i-loop (lon) enddo !k-loop (lev) -! if (imon==1 .and. me==master .and. i==1 .and. j==1 ) then -! print *, 'EJ, aer_pres:', aer_pres(i,j,:,imon) -! endif - enddo !j-loop (lat) - enddo !i-loop (lon) -! if (imon==1 .and. me==master ) then -! print *, 'EJx, aer_pres_i1:',(aer_pres(1,1:180,levsaer,imon) ) -! endif +! ====> construct 4-d aerosol array (kg/kg) +! merra2 data is top down +! for GFS, iflip 0: toa to sfc; 1: sfc to toa + DO ii = 1, ntrcaerm + vname=trim(specname(ii)) + call nf_inq_varid(ncid, vname, varid) + call nf_get_var(ncid, varid, buffx) -! construct lat/lon array - if (imon == 1 ) then - call nf_inq_varid(ncid, "lat", varid) - call nf_get_var(ncid, varid, aer_lat) - call nf_inq_varid(ncid, "lon", varid) - call nf_get_var(ncid, varid, aer_lon) - do i = 1, lonsaer - if(aer_lon(i) < 0.) aer_lon(i) = aer_lon(i) + 360. - enddo -! if (imon==1 .and. me == master) then -! print *, "EJ, lat:", aer_lat(:) -! print *, "EJ, lon:", aer_lon(:) -! endif - endif + do j = 1, latsaer + do k = 1, levsaer +! input is from toa to sfc + if ( iflip == 0 ) then ! data from toa to sfc + klev = k + else ! data from sfc to top + klev = ( dim3 - k ) + 1 + endif + do i = 1, hmx + aerin(i+hmx,j,k,ii,imon) = 1.d0*buffx(i,j,klev,1) + aerin(i,j,k,ii,imon) = 1.d0*buffx(i+hmx,j,klev,1) + enddo !i-loop (lon) + enddo !k-loop (lev) + enddo !j-loop (lat) + + ENDDO ! ii-loop (ntracaerm) ! close the file call nf_close(ncid) enddo !imon-loop - !--- - deallocate (ps_clm, delp_clm, pres_tmp, aer_clm, airden_clm ) - if (me == master) then - write(*,*) 'Reading in GOCART aerosols data' - endif + deallocate (aer_loni, aer_lati) + deallocate (buff, pres_tmp) + deallocate (buffx) - END SUBROUTINE read_aerdata + END SUBROUTINE read_aerdata ! !********************************************************************** ! @@ -214,11 +230,6 @@ SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & ddy(j) = 1.0 endif -! if (me == master .and. j<= 3) then -! print *,'EJj,',j,' dlat=',dlat(j),' jindx12=',jindx1(j),& -! jindx2(j),' aer_lat=',aer_lat(jindx1(j)), & -! aer_lat(jindx2(j)),' ddy=',ddy(j) -! endif ENDDO DO J=1,npts @@ -237,11 +248,6 @@ SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & else ddx(j) = 1.0 endif -! if (me == master .and. j<= 3) then -! print *,'EJi,',j,' dlon=',dlon(j),' iindx12=',iindx1(j),& -! iindx2(j),' aer_lon=',aer_lon(iindx1(j)), & -! aer_lon(iindx2(j)),' ddx=',ddx(j) -! endif ENDDO RETURN @@ -265,7 +271,8 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & integer IDAT(8),JDAT(8) ! real(kind=kind_phys) DDY(npts), ddx(npts),ttt - real(kind=kind_phys) aerout(npts,lev,ntrcaer),aerpm(npts,levsaer,ntrcaer) + real(kind=kind_phys) aerout(npts,lev,ntrcaer) + real(kind=kind_phys) aerpm(npts,levsaer,ntrcaer) real(kind=kind_phys) prsl(npts,lev), aerpres(npts,levsaer) real(kind=kind_phys) RINC(5), rjday integer jdow, jdoy, jday @@ -286,7 +293,6 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & else CALL W3MOVDAT(RINC,IDAT,JDAT) endif -! if(me==master) print *,'EJ, IDAT ',IDAT(1:3), IDAT(5) ! jdow = 0 jdoy = 0 @@ -307,15 +313,8 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & tx1 = (aer_time(n2) - rjday) / (aer_time(n2) - aer_time(n1)) tx2 = 1.0 - tx1 if (n2 > 12) n2 = n2 -12 -! if(me==master)print *,'EJ,rjday=',rjday, ';aer_time,tx1,tx=' & -! , aer_time(n1),aer_time(n2),tx1,tx2,n1,n2 -! -! if(me==master) then -! DO L=1,levsaer -! print *,'EJ,aerin(n1,n2)=',L,aerin(1,1,L,1,n1),aerin(1,1,L,1,n2) -! ENDDO -! endif +! DO L=1,levsaer DO J=1,npts J1 = JINDX1(J) @@ -338,51 +337,41 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & +tx2*(TEMI*TEMJ*aer_pres(I1,J1,L,n2)+DDX(j)*DDY(J)*aer_pres(I2,J2,L,n2) & +TEMI*DDY(j)*aer_pres(I1,J2,L,n2)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n2)) -! IF(me==master .and. j==1) THEN -! print *, 'EJ,aer/ps:',L,aerpm(j,L,1),aerpres(j,L) -! if(L==1) then -! print *, 'EJ, wgt:',TEMI*TEMJ,DDX(j)*DDY(J),TEMI*DDY(j),DDX(j)*TEMJ -! print *, 'EJ, aerx:',aerin(I1,J1,L,ii,n1), & -! aerin(I2,J2,L,ii,n1), aerin(I1,J2,L,ii,n1), aerin(I2,J1,L,ii,n1) -! print *, 'EJ, aery:',aerin(I1,J1,L,ii,n2), & -! aerin(I2,J2,L,ii,n2), aerin(I1,J2,L,ii,n2), aerin(I2,J1,L,ii,n2) -! endif -! ENDIF ENDDO ENDDO -! note: input is set to be same as GFS +! don't flip, input is the same direction as GFS (bottom-up) DO J=1,npts DO L=1,lev - if(prsl(j,l).ge.aerpres(j,levsaer)) then + if(prsl(j,L).ge.aerpres(j,1)) then DO ii=1, ntrcaer - aerout(j,l,ii)=aerpm(j,levsaer,ii) + aerout(j,L,ii)=aerpm(j,1,ii) !! sfc level ENDDO - else if(prsl(j,l).le.aerpres(j,1)) then + else if(prsl(j,L).le.aerpres(j,levsaer)) then DO ii=1, ntrcaer - aerout(j,l,ii)=aerpm(j,1,ii) + aerout(j,L,ii)=aerpm(j,levsaer,ii) !! toa top ENDDO else - DO k=levsaer-1,1,-1 - IF(prsl(j,l)>aerpres(j,k)) then + DO k=1, levsaer-1 !! from sfc to toa + IF(prsl(j,L)aerpres(j,k+1)) then i1=k i2=min(k+1,levsaer) exit - end if - end do + ENDIF + ENDDO + temi = prsl(j,L)-aerpres(j,i2) + temj = aerpres(j,i1) - prsl(j,L) + tx1 = temi/(aerpres(j,i1) - aerpres(j,i2)) + tx2 = temj/(aerpres(j,i1) - aerpres(j,i2)) DO ii = 1, ntrcaer - aerout(j,l,ii)=aerpm(j,i1,ii)+(aerpm(j,i2,ii)-aerpm(j,i1,ii))& - /(aerpres(j,i2)-aerpres(j,i1))*(prsl(j,l)-aerpres(j,i1)) -! IF(me==master .and. j==1 .and. ii==1) then -! print *, 'EJ, aerout:',aerout(j,l,ii), aerpm(j,i1,ii), & -! aerpm(j,i2,ii), aerpres(j,i2), aerpres(j,i1), prsl(j,l) -! ENDIF + aerout(j,L,ii)= aerpm(j,i1,ii)*tx1 + aerpm(j,i2,ii)*tx2 ENDDO - endif - ENDDO - ENDDO + endif + ENDDO !L-loop + ENDDO !J-loop ! - RETURN + RETURN END SUBROUTINE aerinterpol end module aerinterp + diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index 60bb50d34..339b991f0 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -1,6 +1,6 @@ !> \file radiation_aerosols.f !! This file contains climatological atmospheric aerosol schemes for -!! radiation computations. +!! radiation computations ! ========================================================== !!!!! ! 'module_radiation_aerosols' description !!!!! @@ -25,11 +25,10 @@ ! ! ! 'setaer' -- mapping aeros profile, compute aeros opticals ! ! inputs: ! -! (prsi,prsl,prslk,tvly,rhlay,slmsk,tracer,xlon,xlat, ! +! (prsi,prsl,prslk,tvly,rhlay,slmsk,tracer,aerfld,xlon,xlat, ! ! IMAX,NLAY,NLP1, lsswr,lslwr, ! ! outputs: ! -! (aerosw,aerolw,tau_gocart) ! -!! (aerosw,aerolw,aerodp) ! +! (aerosw,aerolw,aerodp) ! ! ! ! ! ! external modules referenced: ! @@ -100,6 +99,9 @@ ! jun 2018 --- h-m lin and y-t hou updated spectral band ! ! mapping method for aerosol optical properties. controled by ! ! internal variable lmap_new through namelist variable iaer. ! +! may 2019 --- sarah lu, restore the gocart option, allowing ! +! aerosol ext, ssa, asy determined from MERRA2 monthly climo ! +! with new spectral band mapping method ! ! ! ! references for opac climatological aerosols: ! ! hou et al. 2002 (ncep office note 441) ! @@ -107,6 +109,11 @@ ! ! ! references for gocart interactive aerosols: ! ! chin et al., 2000 - jgr, v105, 24671-24687 ! +! colarco et al., 2010 - jgr, v115, D14207 ! +! ! +! references for merra2 aerosol reanalysis: ! +! randles et al., 2017 - jclim, v30, 6823-6850 ! +! buchard et al., 2017 - jclim, v30, 6851-6871 ! ! ! ! references for stratosperic volcanical aerosols: ! ! sato et al. 1993 - jgr, v98, d12, 22987-22994 ! @@ -118,12 +125,12 @@ -!> \ingroup RRTMG -!! \defgroup module_radiation_aerosols RRTMG Aerosols Module -!! \brief This module contains climatological atmospheric aerosol schemes for +!> \ingroup rad +!! \defgroup module_radiation_aerosols module_radiation_aerosols +!> @{ +!! This module contains climatological atmospheric aerosol schemes for !! radiation computations. !! -!! !!\version NCEP-Radiation_aerosols v5.2 Jan 2013 !! !!\n This module has three externally callable subroutines: @@ -134,14 +141,22 @@ !! - setaer() -- mapping aeros profile, compute aeros opticals !! !!\n References: -!! - OPAC climatological aerosols: Hou et al. (2002) \cite hou_et_al_2002; -!! Hess et al. (1998) \cite hess_et_al_1998 -!! - GOCART interactive aerosols: Chin et al.(2000) \cite chin_et_al_2000 -!! - Stratospheric volcanical aerosols: Sato et al. (1993) \cite sato_et_al_1993 - -!> This module contains climatological atmospheric aerosol schemes for -!! radiation computations. - module module_radiation_aerosols +!! - OPAC climatological aerosols: +!! Hou et al. 2002 \cite hou_et_al_2002; Hess et al. 1998 +!! \cite hess_et_al_1998 +!! - GOCART interactive aerosols: +!! Chin et al., 2000 \cite chin_et_al_2000 +!! Colarco et al., 2010 - jgr, v115, D14207\cite colarco_et_al_2010 +!! +!! - MERRA2 aerosol reanalysis: +!! Randles et al., 2017 - jclim, v30, 6823-6850\cite randles_et_al_2017 +!! Buchard et al., 2017 - jclim, v30, 6851-6871\cite buchard_et_al_2017 +!! +!! - Stratospheric volcanical aerosols: +!! Sato et al. 1993 \cite sato_et_al_1993 +!========================================! + module module_radiation_aerosols ! +!........................................! ! use physparam,only : iaermdl, iaerflg, lalw1bd, aeros_file, & & ivflip, kind_phys, kind_io4, kind_io8 @@ -154,7 +169,8 @@ module module_radiation_aerosols use module_radlw_parameters, only : NBDLW, wvnlw1, wvnlw2 ! use funcphys, only : fpkap - use gfs_phy_tracer_config, only : gfs_phy_tracer, trcindx + use aerclm_def, only : ntrcaer + ! implicit none ! @@ -167,29 +183,29 @@ module module_radiation_aerosols ! & VTAGAER='NCEP-Radiation_aerosols v5.0 Aug 2012 ' ! --- general use parameter constants: -! num of output fields for SW rad - integer, parameter, public :: NF_AESW = 3 !< number of output fields for SW rad -! num of output fields for LW rad - integer, parameter, public :: NF_AELW = 3 !< number of output fields for LW rad -! starting band number in ir region - integer, parameter, public :: NLWSTR = 1 !< starting band number in IR region -! num of species for output aod (opnl) +!> num of output fields for SW rad + integer, parameter, public :: NF_AESW = 3 +!> num of output fields for LW rad + integer, parameter, public :: NF_AELW = 3 +!> starting band number in ir region + integer, parameter, public :: NLWSTR = 1 +!> num of species for output aod (opnl) integer, parameter, public :: NSPC = 5 -! total+species +!> total+species integer, parameter, public :: NSPC1 = NSPC + 1 real (kind=kind_phys), parameter :: f_zero = 0.0 real (kind=kind_phys), parameter :: f_one = 1.0 ! --- module control parameters set in subroutine "aer_init" -! number of actual bands for sw aerosols; calculated according to +!> number of actual bands for sw aerosols; calculated according to !! laswflg setting - integer, save :: NSWBND = NBDSW -! number of actual bands for lw aerosols; calculated according to + integer, save :: NSWBND = NBDSW +!> number of actual bands for lw aerosols; calculated according to !! lalwflg and lalw1bd settings - integer, save :: NLWBND = NBDLW -! total number of bands for sw+lw aerosols - integer, save :: NSWLWBD = NBDSW+NBDLW + integer, save :: NLWBND = NBDLW +!> total number of bands for sw+lw aerosols + integer, save :: NSWLWBD = NBDSW+NBDLW ! LW aerosols effect control flag ! =.true.:aerosol effect is included in LW radiation ! =.false.:aerosol effect is not included in LW radiation @@ -212,15 +228,15 @@ module module_radiation_aerosols ! --------------------------------------------------------------------- ! ! --- parameter constants: -! num of wvnum regions where solar flux is constant +!> num of wvnum regions where solar flux is constant integer, parameter, public :: NWVSOL = 151 -! total num of wvnum included +!> total num of wvnum included integer, parameter, public :: NWVTOT = 57600 -! total num of wvnum in ir range +!> total num of wvnum in ir range integer, parameter, public :: NWVTIR = 4000 -! number of wavenumbers in each region where the solar flux is constant +!> number of wavenumbers in each region where the solar flux is constant integer, dimension(NWVSOL), save :: nwvns0 data nwvns0 / 100, 11, 14, 18, 24, 33, 50, 83, 12, 12, & @@ -236,7 +252,7 @@ module module_radiation_aerosols & 483, 505, 529, 554, 580, 610, 641, 675, 711, 751, 793, 841, 891, & & 947,1008,1075,1150,1231,1323,1425,1538,1667,1633,14300 / -! solar flux \f$w/m^2\f$ in each wvnumb region where it is constant +!> solar flux \f$w/m^2\f$ in each wvnumb region where it is constant real (kind=kind_phys), dimension(NWVSOL), save :: s0intv data s0intv( 1: 50) / & @@ -281,22 +297,22 @@ module module_radiation_aerosols ! --------------------------------------------------------------------- ! ! --- parameter constants: -! lower limit (year) data available +!> lower limit (year) data available integer, parameter :: MINVYR = 1850 -! upper limit (year) data available +!> upper limit (year) data available integer, parameter :: MAXVYR = 1999 -! monthly, 45-deg lat-zone aerosols data set in subroutine 'aer_init' +!> monthly, 45-deg lat-zone aerosols data set in subroutine 'aer_init' integer, allocatable, save :: ivolae(:,:,:) ! --- static control variables: -! starting year of data in the input file +!> starting year of data in the input file integer :: kyrstr -! ending year of data in the input file +!> ending year of data in the input file integer :: kyrend -! the year of data in use in the input file +!> the year of data in use in the input file integer :: kyrsav -! the month of data in use in the input file +!> the month of data in use in the input file integer :: kmonsav ! --------------------------------------------------------------------- ! @@ -305,27 +321,27 @@ module module_radiation_aerosols ! --------------------------------------------------------------------- ! ! --- parameters and constants: -! num of max componets in a profile - integer, parameter :: NXC = 5 !< num of max componets in a profile -! num of aerosols profile structures +!> num of max componets in a profile + integer, parameter :: NXC = 5 +!> num of aerosols profile structures integer, parameter :: NAE = 7 -! num of atmos aerosols domains +!> num of atmos aerosols domains integer, parameter :: NDM = 5 -! num of lon-points in glb aeros data set +!> num of lon-points in glb aeros data set integer, parameter :: IMXAE = 72 -! num of lat-points in glb aeros data set +!> num of lat-points in glb aeros data set integer, parameter :: JMXAE = 37 -! num of bands for clim aer data (opac) +!> num of bands for clim aer data (opac) integer, parameter :: NAERBND=61 -! num of rh levels for rh-dep components +!> num of rh levels for rh-dep components integer, parameter :: NRHLEV =8 -! num of rh independent aeros species +!> num of rh independent aeros species integer, parameter :: NCM1 = 6 -! num of rh dependent aeros species +!> num of rh dependent aeros species integer, parameter :: NCM2 = 4 integer, parameter :: NCM = NCM1+NCM2 -! predefined relative humidity levels +!> predefined relative humidity levels real (kind=kind_phys), dimension(NRHLEV), save :: rhlev data rhlev (:) / 0.0, 0.5, 0.7, 0.8, 0.9, 0.95, 0.98, 0.99 / @@ -336,11 +352,11 @@ module module_radiation_aerosols ! prsref(NDM,NAE) - ref pressure lev (sfc to toa) in mb (100Pa) ! sigref(NDM,NAE) - ref sigma lev (sfc to toa) -! scale height of aerosols (km) +!> scale height of aerosols (km) real (kind=kind_phys), save, dimension(NDM,NAE) :: haer -! ref pressure lev (sfc to toa) in mb (100Pa) +!> ref pressure lev (sfc to toa) in mb (100Pa) real (kind=kind_phys), save, dimension(NDM,NAE) :: prsref -! ref sigma lev (sfc to toa) +!> ref sigma lev (sfc to toa) real (kind=kind_phys), save, dimension(NDM,NAE) :: sigref ! --- the following arrays are allocate and setup in subr 'clim_aerinit' @@ -377,274 +393,77 @@ module module_radiation_aerosols ! cmixg (NXC*IMXAE*JMXAE) - aeros component mixing ratio ! denng ( 2 *IMXAE*JMXAE) - aerosols number density -! \name topospheric aerosol profile distribution +!> \name topospheric aerosol profile distribution -! aeros component mixing ratio +!> aeros component mixing ratio real (kind=kind_phys), dimension(NXC,IMXAE,JMXAE), save :: cmixg -! aeros number density +!> aeros number density real (kind=kind_phys), dimension( 2 ,IMXAE,JMXAE), save :: denng -! aeros component index +!> aeros component index integer, dimension(NXC,IMXAE,JMXAE), save :: idxcg -! aeros profile index +!> aeros profile index integer, dimension( IMXAE,JMXAE), save :: kprfg ! --------------------------------------------------------------------- ! ! section-4 : module variables for gocart aerosol optical properties ! ! --------------------------------------------------------------------- ! - -! \name module variables for gocart aerosol optical properties +!> \name module variables for gocart aerosol optical properties ! --- parameters and constants: -! - KCM, KCM1, KCM2 are determined from subroutine 'set_aerspc' -! num of bands for aer data (gocart) - integer, parameter :: KAERBND=61 -! num of rh levels for rh-dep components +!> num of bands for aer data (gocart) + integer, parameter :: KAERBNDD=61 + integer, parameter :: KAERBNDI=56 +!> num of rh levels for rh-dep components integer, parameter :: KRHLEV =36 -!* integer, parameter :: KCM1 = 8 ! num of rh independent aer !species -!* integer, parameter :: KCM2 = 5 ! num of rh dependent aer species -!* integer, parameter :: KCM = KCM1 + KCM2 -! num of rh indep aerosols (set in subr set_aerspc) - integer, save :: KCM1 = 0 -! num of rh dep aerosols (set in subr set_aerspc) - integer, save :: KCM2 = 0 -! =KCM1+KCM2 (set in subr set_aerspc) - integer, save :: KCM - - real (kind=kind_phys), dimension(KRHLEV) :: rhlev_grt +!> num of gocart rh indep aerosols + integer, parameter :: KCM1 = 5 +!> num of gocart rh dep aerosols + integer, parameter :: KCM2 = 10 +!> num of gocart aerosols + integer, parameter :: KCM = KCM1 + KCM2 + + real (kind=kind_phys), dimension(KRHLEV) :: rhlev_grt & data rhlev_grt (:)/ .00, .05, .10, .15, .20, .25, .30, .35, & & .40, .45, .50, .55, .60, .65, .70, .75, .80, .81, .82, & & .83, .84, .85, .86, .87, .88, .89, .90, .91, .92, .93, & & .94, .95, .96, .97, .98, .99 / -! --- the following arrays are allocate and setup in subr 'gocrt_aerinit' -! ------ gocart aerosol specification ------ -! => transported aerosol species: -! DU (5-bins) -! SS (4 bins for climo mode and 5 bins for fcst mode) -! SU (dms, so2, so4, msa) -! OC (phobic, philic) and BC (phobic, philic) -! => species and lumped species for aerosol optical properties -! DU (5-bins, with 4 sub-groups in the submicron bin ) -! SS (ssam for submicron, sscm for coarse mode) -! SU (so4) -! OC (phobic, philic) and BC (phobic, philic) -! => specification used for aerosol optical properties luts -! DU (8 bins) -! SS (ssam, sscm) -! SU (suso) -! OC (waso) and BC (soot) -! -! - spectral band structure: -! iendwv_grt(KAERBND) - ending wavenumber (cm**-1) for each band -! - relative humidity independent aerosol optical properties: -! ===> species : dust (8 bins) -! rhidext0_grt(KAERBND,KCM1) - extinction coefficient -! rhidssa0_grt(KAERBND,KCM1) - single scattering albedo -! rhidasy0_grt(KAERBND,KCM1) - asymmetry parameter -! - relative humidity dependent aerosol optical properties: -! ===> species : soot, suso, waso, ssam, sscm -! rhdpext0_grt(KAERBND,KRHLEV,KCM2) - extinction coefficient -! rhdpssa0_grt(KAERBND,KRHLEV,KCM2) - single scattering albedo -! rhdpasy0_grt(KAERBND,KRHLEV,KCM2) - asymmetry parameter - -! spectral band structure: ending wavenumber (\f$cm^-1\f$) for each band - integer, allocatable, dimension(:) :: iendwv_grt -! relative humidity independent aerosol optical properties: -!! species : dust (8 bins) - -! \name relative humidity independent aerosol optical properties: -! species : dust (8 bins) - -! extinction coefficient - real (kind=kind_phys),allocatable, dimension(:,:) :: rhidext0_grt -! single scattering albedo - real (kind=kind_phys),allocatable, dimension(:,:) :: rhidssa0_grt -! asymmetry parameter - real (kind=kind_phys), allocatable, dimension(:,:) :: rhidasy0_grt -! -! relative humidity dependent aerosol optical properties: -! species : soot, suso, waso, ssam, sscm - -! \name relative humidity dependent aerosol optical properties: -! species : soot, suso, waso, ssam, sscm - -! extinction coefficient - real (kind=kind_phys),allocatable,dimension(:,:,:) :: rhdpext0_grt -! single scattering albedo - real (kind=kind_phys),allocatable,dimension(:,:,:) :: rhdpssa0_grt -! asymmetry parameter - real (kind=kind_phys),allocatable,dimension(:,:,:) :: rhdpasy0_grt - -! - relative humidity independent aerosol optical properties: -! extrhi_grt(KCM1,NSWLWBD) - extinction coefficient for sw+lw spectral band -! ssarhi_grt(KCM1,NSWLWBD) - single scattering albedo for sw+lw spectral band -! asyrhi_grt(KCM1,NSWLWBD) - asymmetry parameter for sw+lw spectral band -! - relative humidity dependent aerosol optical properties: -! extrhd_grt(KRHLEV,KCM2,NSWLWBD) - extinction coefficient for sw+lw band -! ssarhd_grt(KRHLEV,KCM2,NSWLWBD) - single scattering albedo for sw+lw band -! asyrhd_grt(KRHLEV,KCM2,NSWLWBD) - asymmetry parameter for sw+lw band - -!\name relative humidity independent aerosol optical properties - -! extinction coefficient for SW+LW spectral band - real (kind=kind_phys),allocatable,save,dimension(:,:) :: & - & extrhi_grt -! single scattering albedo for SW+LW spectral band +!> \name relative humidity independent aerosol optical properties: +!! species: du001, du002, du003, du004, du005 +! extrhi_grt(KCM1,NSWLWBD) - extinction coefficient for sw+lw band +! scarhi_grt(KCM1,NSWLWBD) - scattering coefficient for sw+lw band +! ssarhi_grt(KCM1,NSWLWBD) - single scattering albedo for sw+lw band +! asyrhi_grt(KCM1,NSWLWBD) - asymmetry parameter for sw+lw band real (kind=kind_phys),allocatable,save,dimension(:,:) :: & - & ssarhi_grt -! asymmetry parameter for SW+LW spectral band - real (kind=kind_phys),allocatable,save,dimension(:,:) :: & - & asyrhi_grt - -! \name relative humidity dependent aerosol optical properties - -! extinction coefficient for SW+LW spectral band - real (kind=kind_phys),allocatable,save,dimension(:,:,:) :: & - & extrhd_grt -! single scattering albedo for SW+LW band - real (kind=kind_phys),allocatable,save,dimension(:,:,:) :: & - & ssarhd_grt -! asymmetry parameter for SW+LW band + & extrhi_grt, scarhi_grt, ssarhi_grt, asyrhi_grt +! +!> \name relative humidity dependent aerosol optical properties: +!! species : ss001, ss002, ss003, ss004, ss005, so4, +!! bcphobic, bcphilic, ocphobic, ocphilic +! extrhd_grt(KRHLEV,KCM2,NSWLWBD) - extinction coefficient for sw+lw band +! scarhd_grt(KRHLEV,KCM2,NSWLWBD) - scattering coefficient for sw+lw band +! ssarhd_grt(KRHLEV,KCM2,NSWLWBD) - single scattering albedo for sw+lw band +! asyrhd_grt(KRHLEV,KCM2,NSWLWBD) - asymmetry parameter for sw+lw band + +!> extinction coefficient real (kind=kind_phys),allocatable,save,dimension(:,:,:) :: & - & asyrhd_grt + & extrhd_grt, scarhd_grt, ssarhd_grt, asyrhd_grt -! \name module variables for gocart aerosol clim data set +!> gocart species + integer, parameter :: num_gc = 5 + character*2 :: gridcomp(num_gc) + integer, dimension (num_gc):: num_radius, radius_lower + integer, dimension (num_gc):: trc_to_aod -! --------------------------------------------------------------------- ! -! section-5 : module variables for gocart aerosol climo data set ! -! --------------------------------------------------------------------- ! -! This version only supports geos3-gocart data set (Jan 2010) -! Modified to support geos4-gocart data set (May 2010) -! -! geos3-gocart vs geos4-gocart -! (1) Use the same module variables -! IMXG,JMXG,KMXG,NMXG,psclmg,dmclmg,geos_rlon,geos_rlat -! (2) Similarity between geos3 and geos 4: -! identical lat/lon grids and aerosol specification; -! direction of vertical index is bottom-up (sfc to toa) -! (3) Difference between geos3 and geos4 -! vertical coordinate (sigma for geos3/hybrid_sigma_pressure for geos4) -! aerosol units (mass concentration for geos3/mixing ratio for geos4) - -! num of lon-points in geos dataset - integer, parameter :: IMXG = 144 -! num of lat-points in geos dataset - integer, parameter :: JMXG = 91 -! num of vertical layers in geos dataset - integer, parameter :: KMXG = 30 -!* integer, parameter :: NMXG = 12 -! to be determined by set_aerspc - integer, save :: NMXG - - real (kind=kind_phys), parameter :: dltx = 360.0 / float(IMXG) - real (kind=kind_phys), parameter :: dlty = 180.0 / float(JMXG-1) - -! --- the following arrays are allocated and setup in 'rd_gocart_clim' -! - geos-gocart climo data (input dataset) -! psclmg - pressure in cb IMXG*JMXG*KMXG -! dmclmg - aerosol dry mass in g/m3 IMXG*JMXG*KMXG*NMXG -! or aerosol mixing ratio in mol/mol or Kg/Kg - -! pressure in cb - real (kind=kind_phys),allocatable, save:: psclmg(:,:,:) -! aerosol dry mass in g/m3 or aerosol mixing ration in mol/mol or Kg/Kg - real (kind=kind_phys),allocatable, save:: dmclmg(:,:,:,:) - -! - geos-gocart lat/lon arrays - real (kind=kind_phys), allocatable, save, dimension(:):: geos_rlon - real (kind=kind_phys), allocatable, save, dimension(:):: geos_rlat - -! control flag for gocart climo data set: xxxx as default; ver3 for geos3; -!! ver4 for geos4; 0000 for unknown data - character*4, save :: gocart_climo = 'xxxx' - -! molecular wght of gocart aerosol species - real (kind=kind_io4), allocatable :: molwgt(:) - -! --------------------------------------------------------------------- -! ! -! section-6 : module variables for gocart aerosol scheme options -! ! -! --------------------------------------------------------------------- -! ! - -! logical parameter for gocart initialization control - logical, save :: lgrtint = .true. - -! logical parameter for gocart debug print control -! logical, save :: lckprnt = .true. - logical, save :: lckprnt = .false. - -! --- the following index/flag/weight are set up in 'set_aerspc' - -! merging coefficients for fcst/clim; determined from fdaer - real (kind=kind_phys), save :: ctaer = f_zero ! user specified wgt - -! option to get fcst gocart aerosol field - logical, save :: get_fcst = .true. -! option to get clim gocart aerosol field - logical, save :: get_clim = .true. - -! ------ gocart aerosol specification ------ -! => transported aerosol species: -! DU (5-bins) -! SS (4 bins for climo mode and 5 bins for fcst mode) -! SU (dms, so2, so4, msa) -! OC (phobic, philic) and BC (phobic, philic) -! => species and lumped species for aerosol optical properties -! DU (5-bins, with 4 sub-groups in the submicron bin ) -! SS (ssam for submicron, sscm for coarse mode) -! SU (so4) -! OC (phobic, philic) and BC (phobic, philic) -! => specification used for aerosol optical properties luts -! DU (8 bins) -! SS (ssam, sscm) -! SU (suso) -! OC (waso) and BC (soot) -! + data gridcomp /'DU', 'SS', 'SU', 'BC', 'OC'/ + data num_radius /5, 5, 1, 2, 2 / + data radius_lower /1, 6, 11, 12, 14 / + data trc_to_aod /1, 5, 4, 2, 3/ ! dust, soot, waso, suso, ssam -! index for rh dependent aerosol optical properties (2nd -! dimension for extrhd_grt, ssarhd_grt, and asyrhd_grt) - integer, save :: isoot, iwaso, isuso, issam, isscm - -! - index for rh independent aerosol optical properties (1st -! dimension for extrhi_grt, ssarhi_grt, and asyrhi_grt) is -! not needed ===> hardwired to 8-bin dust - - type gocart_index_type !< index for gocart aerosol species to be included in the - !! calculations of aerosol optical properties (ext, ssa, asy) - integer :: dust1, dust2, dust3, dust4, dust5 !< dust - integer :: ssam, sscm !< sea salt - integer :: suso !< sulfate - integer :: waso_phobic, waso_philic !< oc - integer :: soot_phobic, soot_philic !< bc - endtype - type (gocart_index_type), save :: dm_indx !< index for aer spec to be included in - !!aeropt calculations - - type tracer_index_type !< index for gocart aerosols from prognostic tracer fields - integer :: du001, du002, du003, du004, du005 !< dust - integer :: ss001, ss002, ss003, ss004, ss005 !< sea salt - integer :: so4 !< sulfate - integer :: ocphobic, ocphilic !< oc - integer :: bcphobic, bcphilic !< bc - endtype - type (tracer_index_type), save :: dmfcs_indx !< index for prognostic aerosol fields - -! - grid components to be included in the aeropt calculations - integer, save :: num_gridcomp = 0 !< number of aerosol grid components - character, allocatable , save :: gridcomp(:)*2 !< aerosol grid components - -! default full-package setting - integer, parameter :: max_num_gridcomp = 5 !< default full-package setting -! data max_gridcomp /'DU', 'BC', 'OC', 'SU', 'SS'/ - character*2 :: max_gridcomp(max_num_gridcomp) - data max_gridcomp /'DU', 'BC', 'OC', 'SU', 'SS'/ - -! GOCART code modification end here (Sarah Lu) -! ------------------------! ! ======================================================================= - +! --------------------------------------------------------------------- ! +! section-5 : module variables for aod diagnostic ! +! --------------------------------------------------------------------- ! !! --- the following are for diagnostic purpose to output aerosol optical depth ! aod from 10 components are grouped into 5 major different species: ! 1:dust (inso,minm,miam,micm,mitr); 2:black carbon (soot) @@ -653,32 +472,32 @@ module module_radiation_aerosols ! idxspc (NCM) - index conversion array ! lspcaod - logical flag for aod from individual species ! - integer, dimension(NCM) :: idxspc !< index conversion array +!> index conversion array:data idxspc / 1, 2, 1, 1, 1, 1, 3, 5, 5, 4 / + integer, dimension(NCM) :: idxspc data idxspc / 1, 2, 1, 1, 1, 1, 3, 5, 5, 4 / ! ! - wvn550 is the wavenumber (1/cm) of wavelenth 550nm for diagnostic aod output ! nv_aod is the sw spectral band covering wvn550 (comp in aer_init) ! - real (kind=kind_phys), parameter :: wvn550 = 1.0e4/0.55 !< the wavenumber (\f$cm^-1\f$) of - !! wavelength 550nm for diagnostic aod output - integer, save :: nv_aod = 1 !< the SW spectral band covering wvn550 (comp in aer_init) +!> the wavenumber (\f$cm^-1\f$) of wavelength 550nm for diagnostic aod output + real (kind=kind_phys), parameter :: wvn550 = 1.0e4/0.55 +!> the sw spectral band covering wvn550 (comp in aer_init) + integer, save :: nv_aod = 1 ! --- public interfaces public aer_init, aer_update, setaer - ! ================= contains ! ================= -!>\ingroup module_radiation_aerosols !> The initialization program is to set up necessary parameters and !! working arrays. !! !>\param NLAY number of model vertical layers (not used) !>\param me print message control flag -!>\section aer_init_gen_al aer_init General Algorithm +!>\section gen_al General Algorithm !! @{ !----------------------------------- subroutine aer_init & @@ -719,7 +538,7 @@ subroutine aer_init & ! ! ! usage: call aer_init ! ! ! -! subprograms called: clim_aerinit, gcrt_aerinit, ! +! subprograms called: clim_aerinit, gocart_aerinit, ! ! wrt_aerlog, set_volcaer, set_spectrum, ! ! ! ! ================================================================== ! @@ -814,14 +633,13 @@ subroutine aer_init & ! --- outputs: & ) -! elseif ( iaermdl == 1 ) then ! gocart-climatology scheme -! elseif ( iaermdl==1 .or. iaermdl==2 ) then ! gocart-clim/prog scheme + elseif ( iaermdl==1 .or. iaermdl==2 ) then ! gocart clim/prog scheme -! call gcrt_climinit - -! elseif ( iaermdl == 2 ) then ! gocart-prognostic scheme - -! call gcrt_aerinit + call gocart_aerinit & +! --- inputs: + & ( solfwv, eirfwv, me & +! --- outputs: + & ) else if ( me == 0 ) then @@ -849,10 +667,7 @@ subroutine aer_init & contains ! ================= -!>\ingroup module_radiation_aerosols !> This subroutine writes aerosol parameter configuration to run log file. -!>\section wrt_aerlog_gen wrt_aerlog General Algorithm -!! @{ !-------------------------------- subroutine wrt_aerlog !................................ @@ -946,15 +761,12 @@ subroutine wrt_aerlog return !................................ end subroutine wrt_aerlog -!! @} !-------------------------------- -!>\ingroup module_radiation_aerosols !> This subroutine defines the one wavenumber solar fluxes based on toa !! solar spectral distribution, and define the one wavenumber IR fluxes !! based on black-body emission distribution at a predefined temperature. -!>\section gel_set_spec set_spectrum General Algorithm -!! @{ +!>\section gel_set_spec General Algorithm !-------------------------------- subroutine set_spectrum !................................ @@ -971,11 +783,11 @@ subroutine set_spectrum ! ! ! ==================== defination of variables =================== ! ! ! -!> - inputs: (module constants) -!! - NWVTOT: total num of wave numbers used in sw spectrum -!! - NWVTIR: total num of wave numbers used in the ir region -!! -!> - outputs: (in-scope variables) +!> - inputs: (module constants) +!! - NWVTOT: total num of wave numbers used in sw spectrum +!! - NWVTIR: total num of wave numbers used in the ir region +!! +!> - outputs: (in-scope variables) !! - solfwv(NWVTOT): solar flux for each individual wavenumber !! (\f$W/m^2\f$) !! - eirfwv(NWVTIR): ir flux(273k) for each individual wavenumber @@ -1045,12 +857,9 @@ subroutine set_spectrum !................................ end subroutine set_spectrum !-------------------------------- -!! @} -!>\ingroup module_radiation_aerosols + !> The initialization program for stratospheric volcanic aerosols. -!>\section set_volcaer_gen set_volcaer General Algorithm -!! @{ !----------------------------- subroutine set_volcaer !............................. @@ -1088,7 +897,6 @@ subroutine set_volcaer return !................................ end subroutine set_volcaer -!! @} !-------------------------------- ! !................................... @@ -1096,8 +904,8 @@ end subroutine aer_init !----------------------------------- !!@} -!>\ingroup module_radiation_aerosols -!> This subroutine is the opac-climatology aerosol initialization + +!> This subroutine is the opac-climatology aerosol initialization !! program to set up necessary parameters and working arrays. !>\param solfwv (NWVTOT), solar flux for each individual wavenumber !! \f$(w/m^2)\f$ @@ -1105,7 +913,7 @@ end subroutine aer_init !! \f$(w/m^2)\f$ !!\param me print message control flag !! -!!\section gen_clim_aerinit clim_aerinit General Algorithm +!!\section gen_clim_aerinit General Algorithm !!@{ !----------------------------------- subroutine clim_aerinit & @@ -1193,11 +1001,10 @@ subroutine clim_aerinit & contains ! ================= -!>\ingroup module_radiation_aerosols !> The initialization program for climatological aerosols. The program !! reads and maps the pre-tabulated aerosol optical spectral data onto !! corresponding SW radiation spectral bands. -!!\section det_set_aercoef set_aercoef General Algorithm +!!\section det_set_aercoef General Algorithm !! @{ !-------------------------------- subroutine set_aercoef @@ -1291,7 +1098,7 @@ subroutine set_aercoef ! !===> ... begin here ! -!> -# Reading climatological aerosols optical data from aeros_file, +!> -# Reading climatological aerosols optical data from aeros_file, !! including: inquire (file=aeros_file, exist=file_exist) @@ -1336,56 +1143,56 @@ subroutine set_aercoef endif !> - ending wave num for 61 aerosol spectral bands - read(NIAERCM,21) cline + read(NIAERCM,21) cline 21 format(a80) read(NIAERCM,22) iendwv(:) 22 format(13i6) !> - atmos scale height for 5 domains, 7 profs - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,24) haer(:,:) 24 format(20f4.1) !> - reference pressure for 5 domains, 7 profs - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,26) prsref(:,:) 26 format(10f7.2) !> - rh independent ext coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidext0(:,:) 28 format(8e10.3) !> - rh independent sca coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidsca0(:,:) !> - rh independent ssa coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidssa0(:,:) !> - rh independent asy coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidasy0(:,:) !> - rh dependent ext coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpext0(:,:,:) !> - rh dependent sca coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpsca0(:,:,:) !> - rh dependent ssa coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpssa0(:,:,:) !> - rh dependent asy coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpasy0(:,:,:) !> - stratospheric background aeros for 61 bands - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) straext0(:) close (NIAERCM) @@ -1442,7 +1249,7 @@ subroutine set_aercoef if ( lmap_new ) then if (ib == ibs) then - sumsol = f_zero + sumsol = f_zero else sumsol = -0.5 * solfwv(iw1) endif @@ -1536,7 +1343,7 @@ subroutine set_aercoef if ( lmap_new ) then if (ib == ibs) then - sumir = f_zero + sumir = f_zero else sumir = -0.5 * eirfwv(iw1) endif @@ -1635,13 +1442,10 @@ end subroutine set_aercoef !-------------------------------- !! @} -!>\ingroup module_radiation_aerosols !> This subroutine computes mean aerosols optical properties over each !! SW radiation spectral band for each of the species components. This !! program follows GFDL's approach for thick cloud optical property in !! SW radiation scheme (2000). -!>\section optave_gen optavg General Algorithm -!! @{ !-------------------------------- subroutine optavg !................................ @@ -1894,7 +1698,6 @@ subroutine optavg return !................................ end subroutine optavg -!! @} !-------------------------------- ! !................................... @@ -1902,13 +1705,14 @@ end subroutine clim_aerinit !----------------------------------- !!@} -!>\ingroup module_radiation_aerosols + !> This subroutine checks and updates time varying climatology aerosol !! data sets. +!! !>\param iyear 4-digit calender year !!\param imon month of the year !!\param me print message control flag -!>\section gen_aer_upd aer_update General Algorithm +!>\section gen_aer_upd General Algorithm !! @{ !----------------------------------- subroutine aer_update & @@ -1955,12 +1759,16 @@ subroutine aer_update & endif !> -# Call trop_update() to update monthly tropospheric aerosol data. - if ( lalwflg .or. laswflg ) then + if ( lalwflg .or. laswflg ) then + + if ( iaermdl == 0 .or. iaermdl==5 ) then ! opac-climatology scheme call trop_update + endif + endif !> -# Call volc_update() to update yearly stratospheric volcanic aerosol data. - if ( lavoflg ) then + if ( lavoflg ) then call volc_update endif @@ -1969,11 +1777,8 @@ subroutine aer_update & contains ! ================= -!>\ingroup module_radiation_aerosols !> This subroutine updates the monthly global distribution of aerosol !! profiles in five degree horizontal resolution. -!>\section trop_update_gen trop_update General Algorithm -!! @{ !-------------------------------- subroutine trop_update !................................ @@ -2130,14 +1935,11 @@ subroutine trop_update return !................................ end subroutine trop_update -!! @} !-------------------------------- -!>\ingroup module_radiation_aerosols + !> This subroutine searches historical volcanic data sets to find and !! read in monthly 45-degree lat-zone band of optical depth. -!>\section volc_update_gen volc_update General Algorithm -!! @{ !-------------------------------- subroutine volc_update !................................ @@ -2258,7 +2060,6 @@ subroutine volc_update return !................................ end subroutine volc_update -!! @} !-------------------------------- ! !................................... @@ -2267,7 +2068,6 @@ end subroutine aer_update !! @} -!>\ingroup module_radiation_aerosols !> This subroutine computes aerosols optical properties. !>\param prsi (IMAX,NLP1), pressure at interface in mb !!\param prsl (IMAX,NLAY), layer mean pressure in mb @@ -2292,11 +2092,11 @@ end subroutine aer_update !!\n (:,:,:,2): single scattering albedo !!\n (:,:,:,3): asymmetry parameter !!\param aerodp (IMAX,NSPC1), vertically integrated optical depth -!>\section general_setaer setaer General Algorithm +!>\section general_setaer General Algorithm !> @{ !----------------------------------- subroutine setaer & - & ( prsi,prsl,prslk,tvly,rhlay,slmsk,tracer,xlon,xlat, & ! --- inputs + & ( prsi,prsl,prslk,tvly,rhlay,slmsk,tracer,aerfld,xlon,xlat, & ! --- inputs & IMAX,NLAY,NLP1, lsswr,lslwr, & & aerosw,aerolw & ! --- outputs &, aerodp & @@ -2314,6 +2114,7 @@ subroutine setaer & ! rhlay - layer mean relative humidity IMAX*NLAY ! ! slmsk - sea/land mask (sea:0,land:1,sea-ice:2) IMAX ! ! tracer - aerosol tracer concentration IMAX*NLAY*NTRAC ! +! aerfld - prescribed aerosol mixing rat IMAX*NLAY*NTRCAER! ! xlon - longitude of given points in radiance IMAX ! ! ok for both 0->2pi or -pi->+pi ranges ! ! xlat - latitude of given points in radiance IMAX ! @@ -2364,6 +2165,7 @@ subroutine setaer & real (kind=kind_phys), dimension(:), intent(in) :: xlon, xlat, & & slmsk real (kind=kind_phys), dimension(:,:,:),intent(in):: tracer + real (kind=kind_phys), dimension(:,:,:),intent(in):: aerfld logical, intent(in) :: lsswr, lslwr @@ -2421,7 +2223,6 @@ subroutine setaer & enddo enddo - if ( .not. (lsswr .or. lslwr) ) then return endif @@ -2497,8 +2298,6 @@ subroutine setaer & !! subroutine computes sw + lw aerosol optical properties for gocart !! aerosol species (merged from fcst and clim fields). -!SARAH -! if ( iaerflg == 1 ) then ! use opac aerosol climatology if ( iaermdl==0 .or. iaermdl==5 ) then ! use opac aerosol climatology call aer_property & @@ -2511,6 +2310,20 @@ subroutine setaer & & aerosw,aerolw,aerodp & & ) +! + elseif ( iaermdl==1 .or. iaermdl==2) then ! use gocart aerosols + + call aer_property_gocart & +! --- inputs: + & ( prsi,prsl,prslk,tvly,rhlay,dz,hz,tracer,aerfld, & + & alon,alat,slmsk,laersw,laerlw, & + & IMAX,NLAY,NLP1, & +! --- outputs: + & aerosw,aerolw,aerodp & + & ) + endif ! end if_iaerflg_block + + ! --- check print ! do m = 1, NBDSW ! print *,' *** CHECK AEROSOLS PROPERTIES FOR SW BAND =',m, & @@ -2546,27 +2359,12 @@ subroutine setaer & ! print *,' ASYAER:',aerolw(:,k,m,3) ! enddo ! enddo -! SARAH -! elseif ( iaerflg == 2 ) then ! use gocart aerosol scheme - elseif ( iaermdl == 1 ) then ! use gocart aerosol scheme - - call setgocartaer & - -! --- inputs: - & ( alon,alat,prslk,rhlay,dz,hz,NSWLWBD, & - & prsl,tvly,tracer, & - & IMAX,NLAY,NLP1, ivflip, lsswr,lslwr, & -! --- outputs: - & aerosw,aerolw & - & ) - - endif ! end if_iaerflg_block endif ! end if_laswflg_or_lalwflg_block !> -# Compute stratosphere volcanic forcing: !! - select data in 4 lat bands, interpolation at the boundaries -!! - Find lower boundary of stratosphere: polar, fixed at 25000pa +!! - Find lower boundary of stratosphere: polar, fixed at 25000pa !! (250mb); tropic, fixed at 15000pa (150mb); mid-lat, interpolation !! - SW: add volcanic aerosol optical depth to the background value !! - Smoothing profile at boundary if needed @@ -2854,7 +2652,6 @@ end subroutine setaer !> @} -!>\ingroup module_radiation_aerosols !> This subroutine maps the 5 degree global climatological aerosol data !! set onto model grids, and compute aerosol optical properties for SW !! and LW radiations. @@ -2871,6 +2668,7 @@ end subroutine setaer !!\param laersw,laerlw logical flag for sw/lw aerosol calculations !!\param IMAX horizontal dimension of arrays !!\param NLAY,NLP1 vertical dimensions of arrays +!!\param NSPC num of species for optional aod output fields !!\param aerosw (IMAX,NLAY,NBDSW,NF_AESW), aeros opt properties for sw !!\n (:,:,:,1): optical depth !!\n (:,:,:,2): single scattering albedo @@ -2880,13 +2678,13 @@ end subroutine setaer !!\n (:,:,:,2): single scattering albedo !!\n (:,:,:,3): asymmetry parameter !!\param aerodp (IMAX,NSPC+1), vertically integrated aer-opt-depth -!!\section gel_aer_pro aer_property General Algorithm +!!\section gel_aer_pro General Algorithm !> @{ !----------------------------------- - subroutine aer_property & + subroutine aer_property & & ( prsi,prsl,prslk,tvly,rhlay,dz,hz,tracer, & ! --- inputs: - & alon,alat,slmsk, laersw,laerlw, & - & IMAX,NLAY,NLP1, & + & alon,alat,slmsk, laersw,laerlw, & + & IMAX,NLAY,NLP1, & & aerosw,aerolw,aerodp & ! --- outputs: & ) @@ -3269,11 +3067,9 @@ subroutine aer_property & enddo ! --- for diagnostic output (optional) -! if ( lspcaod ) then - do m = 1, NSPC - aerodp(i,m+1) = spcodp(m) - enddo -! endif + do m = 1, NSPC + aerodp(i,m+1) = spcodp(m) + enddo endif ! end if_larsw_block @@ -3307,12 +3103,10 @@ subroutine aer_property & contains ! ================= -!>\ingroup module_radiation_aerosols -!> This subroutine computes aerosols optical properties in NSWLWBD +!> This subroutine computes aerosols optical properties in NSWLWBD !! bands. there are seven different vertical profile structures. in the -!! troposphere, aerosol distribution at each grid point is composed +!! troposphere, aerosol distribution at each grid point is composed !! from up to six components out of ten different substances. -!\section radclimaer_gen radclimaer General Algorithm !-------------------------------- subroutine radclimaer !................................ @@ -3617,1517 +3411,824 @@ end subroutine aer_property !----------------------------------- !> @} -! ======================================================================= -! GOCART code modification starts here (Sarah lu) ---------------------! -!! -!! gocart_init : set_aerspc, rd_gocart_clim, rd_gocart_luts, optavg_grt -!! setgocartaer: aeropt_grt, map_aermr - -!>\ingroup module_radiation_aerosols -!> The initialization program for gocart aerosols -!! - determine weight and index for aerosol composition/luts -!! - read in monthly global distribution of gocart aerosols -!! - read and map the tabulated aerosol optical spectral data onto -!! corresponding SW/LW radiation spectral bands. +!> This subroutine is the gocart aerosol initialization +!! program to set up necessary parameters and working arrays. +!>\param solfwv (NWVTOT), solar flux for each individual wavenumber +!! \f$(w/m^2)\f$ +!!\param eirfwv (NWVTIR), IR flux(273k) for each individual wavenumber +!! \f$(w/m^2)\f$ +!!\param me print message control flag !! -!>\param NWVTOT total num of wave numbers used in sw spectrum -!!\param solfwv (NWVTOT), solar flux for each individual -!! wavenumber (w/m2) -!!\param soltot total solar flux for the spectrual range (w/m2) -!!\param NWVTIR total num of wave numbers used in the ir region -!!\param eirfwv (NWVTIR), ir flux(273k) for each individual -!! wavenumber (w/m2) -!!\param NBDSW num of bands calculated for sw aeros opt prop -!!\param NLWBND num of bands calculated for lw aeros opt prop -!!\param NSWLWBD total num of bands calc for sw+lw aeros opt prop -!!\param imon month of the year -!!\param me print message control flag -!!\param raddt radiation time step -!!\param fdaer -!>\section gel_go_ini gocart_init General Algorithm +!>\section gel_go_ini General Algorithm !! @{ !----------------------------------- - subroutine gocart_init & - & ( NWVTOT,solfwv,soltot,NWVTIR,eirfwv, & ! --- inputs: - & NBDSW,NLWBND,NSWLWBD,imon,me,raddt,fdaer & ! --- outputs: ( none ) + subroutine gocart_aerinit & + & ( solfwv, eirfwv, me & & ) ! ================================================================== ! ! ! -! subprogram : gocart_init ! -! ! -! this is the initialization program for gocart aerosols ! -! ! -! - determine weight and index for aerosol composition/luts ! -! - read in monthly global distribution of gocart aerosols ! -! - read and map the tabulated aerosol optical spectral data ! -! onto corresponding sw/lw radiation spectral bands. ! +! subprogram : gocart_aerinit ! ! ! -! ==================== defination of variables =================== ! +! gocart_aerinit is the gocart aerosol initialization program ! +! to set up necessary parameters and working arrays. ! ! ! ! inputs: ! -! NWVTOT - total num of wave numbers used in sw spectrum ! ! solfwv(NWVTOT) - solar flux for each individual wavenumber (w/m2)! -! soltot - total solar flux for the spectrual range (w/m2)! -! NWVTIR - total num of wave numbers used in the ir region ! ! eirfwv(NWVTIR) - ir flux(273k) for each individual wavenum (w/m2)! -! NBDSW - num of bands calculated for sw aeros opt prop ! -! NLWBND - num of bands calculated for lw aeros opt prop ! -! NSWLWBD - total num of bands calc for sw+lw aeros opt prop! -! imon - month of the year ! ! me - print message control flag ! ! ! -! outputs: (to the module variables) ! +! outputs: (to module variables) ! ! ! ! module variables: ! -! NBDSW - total number of sw spectral bands ! -! wvnum1,wvnum2 (NSWSTR:NSWEND) ! -! - start/end wavenumbers for each of sw bands ! -! NBDLW - total number of lw spectral bands ! -! wvnlw1,wvnlw2 (NBDLW) ! -! - start/end wavenumbers for each of lw bands ! -! NSWLWBD - total number of sw+lw bands used in this version ! -! extrhi_grt - extinction coef for rh-indep aeros KCM1*NSWLWBD ! -! ssarhi_grt - single-scat-alb for rh-indep aeros KCM1*NSWLWBD ! -! asyrhi_grt - asymmetry factor for rh-indep aeros KCM1*NSWLWBD ! -! extrhd_grt - extinction coef for rh-dep aeros KRHLEV*KCM2*NSWLWBD! -! ssarhd_grt - single-scat-alb for rh-dep aeros KRHLEV*KCM2*NSWLWBD! -! asyrhd_grt - asymmetry factor for rh-dep aerosKRHLEV*KCM2*NSWLWBD! -! ctaer - merging coefficients for fcst/clim fields ! -! get_fcst - option to get fcst aerosol fields ! -! get_clim - option to get clim aerosol fields ! -! dm_indx - index for aer spec to be included in aeropt calculations ! -! dmfcs_indx - index for prognostic aerosol fields ! -! psclmg - geos3/4-gocart pressure IMXG*JMXG*KMXG ! -! dmclmg - geos3-gocart aerosol dry mass IMXG*JMXG*KMXG*NMXG! -! or geos4-gocart aerosol mixing ratio ! +! NWVSOL - num of wvnum regions where solar flux is constant ! +! NWVTOT - total num of wave numbers used in sw spectrum ! +! NWVTIR - total num of wave numbers used in the ir region ! +! NSWBND - total number of sw spectral bands ! +! NLWBND - total number of lw spectral bands ! +! NAERBND - number of bands for climatology aerosol data ! +! KCM1 - number of rh independent aeros species ! +! KCM2 - number of rh dependent aeros species ! ! ! ! usage: call gocart_init ! ! ! -! subprograms called: set_aerspc, rd_gocart_clim, ! -! rd_gocart_luts, optavg_grt ! +! subprograms called: rd_gocart_luts, optavg_gocart ! ! ! ! ================================================================== ! implicit none ! --- inputs: - integer, intent(in) :: NWVTOT,NWVTIR,NBDSW,NLWBND,NSWLWBD,imon,me + real (kind=kind_phys), dimension(:) :: solfwv ! one wvn sol flux + real (kind=kind_phys), dimension(:) :: eirfwv ! one wvn ir flux - real (kind=kind_phys), intent(in) :: raddt, fdaer - - real (kind=kind_phys), intent(in) :: solfwv(:),soltot, eirfwv(:) + integer, intent(in) :: me ! --- output: ( none ) ! --- locals: + real (kind=kind_phys), dimension(kaerbndi,kcm1) :: & + & rhidext0_grt, rhidsca0_grt, rhidssa0_grt, rhidasy0_grt + real (kind=kind_phys), dimension(kaerbndd,krhlev,kcm2):: & + & rhdpext0_grt, rhdpsca0_grt, rhdpssa0_grt, rhdpasy0_grt - real (kind=kind_phys), dimension(NBDSW,KAERBND) :: solwaer - real (kind=kind_phys), dimension(NBDSW) :: solbnd - real (kind=kind_phys), dimension(NLWBND,KAERBND) :: eirwaer - real (kind=kind_phys), dimension(NLWBND) :: eirbnd - real (kind=kind_phys) :: sumsol, sumir, fac, tmp, wvs, wve - - integer, dimension(NBDSW) :: nv1, nv2 - integer, dimension(NLWBND) :: nr1, nr2 - - integer :: i, mb, ib, ii, iw, iw1, iw2, ik, ibs, ibe - -!===> ... begin here - -!-------------------------------------------------------------------------- -! (1) determine aerosol specification index and merging coefficients -!-------------------------------------------------------------------------- - - if ( .not. lgrtint ) then - -! --- ... already done aerspc initialization, continue + real (kind=kind_phys), dimension(nswbnd,kaerbndd) :: solwaer + real (kind=kind_phys), dimension(nswbnd) :: solbnd + real (kind=kind_phys), dimension(nlwbnd,kaerbndd) :: eirwaer + real (kind=kind_phys), dimension(nlwbnd) :: eirbnd - continue + real (kind=kind_phys), dimension(nswbnd,kaerbndi) :: solwaer_du + real (kind=kind_phys), dimension(nswbnd) :: solbnd_du + real (kind=kind_phys), dimension(nlwbnd,kaerbndi) :: eirwaer_du + real (kind=kind_phys), dimension(nlwbnd) :: eirbnd_du - else - -! --- ... set aerosol specification index and merging coefficients + integer, dimension(nswbnd) :: nv1, nv2, nv1_du, nv2_du + integer, dimension(nlwbnd) :: nr1, nr2, nr1_du, nr2_du - call set_aerspc(raddt,fdaer) -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + integer, dimension(kaerbndd) :: iendwv + integer, dimension(kaerbndi) :: iendwv_du + real (kind=kind_phys), dimension(kaerbndd) :: wavelength + real (kind=kind_phys), dimension(kaerbndi) :: wavelength_du + real (kind=kind_phys) :: sumsol, sumir, sumsol_du, sumir_du - endif ! end if_lgrtinit_block + integer :: i, j, k, mb, ib, ii, iix, iw, iw1, iw2 ! -!-------------------------------------------------------------------------- -! (2) read gocart climatological data -!-------------------------------------------------------------------------- - -! --- ... read gocart climatological data, if needed - - if ( get_clim ) then +!===> ... begin here +! +! --- ... invoke gocart aerosol initialization - call rd_gocart_clim -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + if (KCM /= ntrcaer ) then + print *, 'ERROR in # of gocart aer species',KCM + stop 3000 endif -! -!-------------------------------------------------------------------------- -! (3) read and map the tabulated aerosol optical spectral data -! onto corresponding radiation spectral bands -!-------------------------------------------------------------------------- - - if ( .not. lgrtint ) then +! --- ... aloocate and input aerosol optical data -! --- ... already done optical property interpolation, exit + if ( .not. allocated( extrhi_grt ) ) then + allocate ( extrhi_grt ( kcm1,nswlwbd) ) + allocate ( scarhi_grt ( kcm1,nswlwbd) ) + allocate ( ssarhi_grt ( kcm1,nswlwbd) ) + allocate ( asyrhi_grt ( kcm1,nswlwbd) ) + allocate ( extrhd_grt (krhlev,kcm2,nswlwbd) ) + allocate ( scarhd_grt (krhlev,kcm2,nswlwbd) ) + allocate ( ssarhd_grt (krhlev,kcm2,nswlwbd) ) + allocate ( asyrhd_grt (krhlev,kcm2,nswlwbd) ) + endif - return +! --- ... read tabulated GOCART aerosols optical data - else + call rd_gocart_luts +! --- inputs: (in scope variables, module variables) +! --- outputs: (in scope variables) -! --- ... reset lgrtint +! --- ... convert wavelength to wavenumber +! wavelength and wavelength_du are read-in by rd_gocart_luts - lgrtint = .false. + do i = 1, kaerbndd + iendwv(i) = int(10000. / wavelength(i)) + enddo -! --- ... read tabulated aerosol optical input data - call rd_gocart_luts -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + do i = 1, kaerbndi + iendwv_du(i) = int(10000. / wavelength_du(i)) + enddo ! --- ... compute solar flux weights and interval indices for mapping ! spectral bands between sw radiation and aerosol data + if ( laswflg ) then solbnd (:) = f_zero - solwaer(:,:) = f_zero + solbnd_du (:)= f_zero + do i=1,nswbnd + do j=1,kaerbndd + solwaer(i,j) = f_zero + enddo + do j=1,kaerbndi + solwaer_du(i,j) = f_zero + enddo + enddo - nv_aod = 1 + do ib = 1, nswbnd + mb = ib + nswstr - 1 + ii = 1 + iix = 1 + iw1 = nint(wvnsw1(mb)) + iw2 = nint(wvnsw2(mb)) - ibs = 1 - ibe = 1 - wvs = wvn_sw1(1) - wve = wvn_sw1(1) - do ib = 2, NBDSW - mb = ib + NSWSTR - 1 - if ( wvn_sw2(mb) >= wvn550 .and. wvn550 >= wvn_sw1(mb) ) then + if ( wvnsw2(mb)>=wvn550 .and. wvn550>=wvnsw1(mb) ) then nv_aod = ib ! sw band number covering 550nm wavelenth endif - if ( wvn_sw1(mb) < wvs ) then - wvs = wvn_sw1(mb) - ibs = ib - endif - if ( wvn_sw1(mb) > wve ) then - wve = wvn_sw1(mb) - ibe = ib - endif - enddo - - do ib = 1, NBDSW - mb = ib + NSWSTR - 1 - ii = 1 - iw1 = nint(wvn_sw1(mb)) - iw2 = nint(wvn_sw2(mb)) - - Lab_swdowhile : do while ( iw1 > iendwv_grt(ii) ) - if ( ii == KAERBND ) exit Lab_swdowhile +! -- for rd-dependent + do while ( iw1 > iendwv(ii) ) + if ( ii == kaerbndd ) exit ii = ii + 1 - enddo Lab_swdowhile - - if ( lmap_new ) then - if (ib == ibs) then + enddo sumsol = f_zero - else - sumsol = -0.5 * solfwv(iw1) - endif - if (ib == ibe) then - fac = f_zero - else - fac = -0.5 - endif - solbnd(ib) = sumsol - else - sumsol = f_zero - endif nv1(ib) = ii +! -- for rd-independent + do while ( iw1 > iendwv_du(iix) ) + if ( iix == kaerbndi ) exit + iix = iix + 1 + enddo + sumsol_du = f_zero + nv1_du(ib) = iix + do iw = iw1, iw2 +! -- for rd-dependent solbnd(ib) = solbnd(ib) + solfwv(iw) sumsol = sumsol + solfwv(iw) - if ( iw == iendwv_grt(ii) ) then + if ( iw == iendwv(ii) ) then solwaer(ib,ii) = sumsol - - if ( ii < KAERBND ) then + if ( ii < kaerbndd ) then sumsol = f_zero ii = ii + 1 endif endif + +! -- for rd-independent + solbnd_du(ib) = solbnd_du(ib) + solfwv(iw) + sumsol_du = sumsol_du + solfwv(iw) + + if ( iw == iendwv_du(iix) ) then + solwaer_du(ib,iix) = sumsol_du + if ( iix < kaerbndi ) then + sumsol_du = f_zero + iix = iix + 1 + endif + endif enddo - if ( iw2 /= iendwv_grt(ii) ) then + if ( iw2 /= iendwv(ii) ) then solwaer(ib,ii) = sumsol endif - - if ( lmap_new ) then - tmp = fac * solfwv(iw2) - solwaer(ib,ii) = solwaer(ib,ii) + tmp - solbnd(ib) = solbnd(ib) + tmp + if ( iw2 /= iendwv_du(iix) ) then + solwaer_du(ib,iix) = sumsol_du endif nv2(ib) = ii - - if((me==0) .and. lckprnt) print *,'RAD-nv1,nv2:', & - & ib,iw1,iw2,nv1(ib),iendwv_grt(nv1(ib)), & - & nv2(ib),iendwv_grt(nv2(ib)), & - & 10000./iw1, 10000./iw2 + nv2_du(ib) = iix enddo ! end do_ib_block for sw + endif ! end if_laswflg_block -! --- check the spectral range for the nv_550 band - if((me==0) .and. lckprnt) then - mb = nv_aod + NSWSTR - 1 - iw1 = nint(wvn_sw1(mb)) - iw2 = nint(wvn_sw2(mb)) - print *,'RAD-nv_aod:', & - & nv_aod, iw1, iw2, 10000./iw1, 10000./iw2 - endif -! -! --- ... compute ir flux weights and interval indices for mapping +! --- ... compute lw flux weights and interval indices for mapping ! spectral bands between lw radiation and aerosol data - eirbnd (:) = f_zero - eirwaer(:,:) = f_zero - - ibs = 1 - ibe = 1 - if (NLWBND > 1 ) then - wvs = wvn_lw1(1) - wve = wvn_lw1(1) - do ib = 2, NLWBND - if ( wvn_lw1(ib) < wvs ) then - wvs = wvn_lw1(ib) - ibs = ib - endif - if ( wvn_lw1(ib) > wve ) then - wve = wvn_lw1(ib) - ibe = ib - endif + if ( lalwflg ) then + eirbnd (:) = f_zero + eirbnd_du (:) = f_zero + do i=1,nlwbnd + do j=1,kaerbndd + eirwaer(i,j) = f_zero enddo - endif + do j=1,kaerbndi + eirwaer_du(i,j) = f_zero + enddo + enddo - do ib = 1, NLWBND + do ib = 1, nlwbnd ii = 1 - if ( NLWBND == 1 ) then + iix = 1 + if ( nlwbnd == 1 ) then iw1 = 400 ! corresponding 25 mu iw2 = 2500 ! corresponding 4 mu else - iw1 = nint(wvn_lw1(ib)) - iw2 = nint(wvn_lw2(ib)) + mb = ib + nlwstr - 1 + iw1 = nint(wvnlw1(mb)) + iw2 = nint(wvnlw2(mb)) endif - Lab_lwdowhile : do while ( iw1 > iendwv_grt(ii) ) - if ( ii == KAERBND ) exit Lab_lwdowhile +! -- for rd-dependent + do while ( iw1 > iendwv(ii) ) + if ( ii == kaerbndd ) exit ii = ii + 1 - enddo Lab_lwdowhile - - if ( lmap_new ) then - if (ib == ibs) then + enddo sumir = f_zero - else - sumir = -0.5 * eirfwv(iw1) - endif - if (ib == ibe) then - fac = f_zero - else - fac = -0.5 - endif - eirbnd(ib) = sumir - else - sumir = f_zero - endif nr1(ib) = ii +! -- for rd-independent + do while ( iw1 > iendwv_du(iix) ) + if ( iix == kaerbndi ) exit + iix = iix + 1 + enddo + sumir_du = f_zero + nr1_du(ib) = iix + do iw = iw1, iw2 +! -- for rd-dependent eirbnd(ib) = eirbnd(ib) + eirfwv(iw) sumir = sumir + eirfwv(iw) - if ( iw == iendwv_grt(ii) ) then + if ( iw == iendwv(ii) ) then eirwaer(ib,ii) = sumir - if ( ii < KAERBND ) then + if ( ii < kaerbndd ) then sumir = f_zero ii = ii + 1 endif endif + +! -- for rd-independent + eirbnd_du(ib) = eirbnd_du(ib) + eirfwv(iw) + sumir_du = sumir_du + eirfwv(iw) + + if ( iw == iendwv_du(iix) ) then + eirwaer_du(ib,iix) = sumir_du + + if ( iix < kaerbndi ) then + sumir_du = f_zero + iix = iix + 1 + endif + endif enddo - if ( iw2 /= iendwv_grt(ii) ) then + if ( iw2 /= iendwv(ii) ) then eirwaer(ib,ii) = sumir endif - - nr2(ib) = ii - - if ( lmap_new ) then - tmp = fac * eirfwv(iw2) - eirwaer(ib,ii) = eirwaer(ib,ii) + tmp - eirbnd(ib) = eirbnd(ib) + tmp + if ( iw2 /= iendwv_du(iix) ) then + eirwaer_du(ib,iix) = sumir_du endif - if(me==0 .and. lckprnt) print *,'RAD-nr1,nr2:', & - & ib,iw1,iw2,nr1(ib),iendwv_grt(nr1(ib)), & - & nr2(ib),iendwv_grt(nr2(ib)), & - & 10000./iw1, 10000./iw2 + nr2(ib) = ii + nr2_du(ib) = iix enddo ! end do_ib_block for lw + endif ! end if_lalwflg_block ! --- compute spectral band mean properties for each species - call optavg_grt -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) - - if(me==0 .and. lckprnt) then - print *, 'RAD -After optavg_grt, sw band info' - do ib = 1, NBDSW - mb = ib + NSWSTR - 1 - print *,'RAD -wvnsw1,wvnsw2: ',ib,wvn_sw1(mb),wvn_sw2(mb) - print *,'RAD -lamda1,lamda2: ',ib,10000./wvn_sw1(mb), & - & 10000./wvn_sw2(mb) - print *,'RAD -extrhi_grt:', extrhi_grt(:,ib) -! do i = 1, KRHLEV - do i = 1, KRHLEV, 10 - print *, 'RAD -extrhd_grt:',i,rhlev_grt(i), & - & extrhd_grt(i,:,ib) - enddo - enddo - print *, 'RAD -After optavg_grt, lw band info' - do ib = 1, NLWBND - ii = NBDSW + ib - print *,'RAD -wvnlw1,wvnlw2: ',ib,wvn_lw1(ib),wvn_lw2(ib) - print *,'RAD -lamda1,lamda2: ',ib,10000./wvn_lw1(ib), & - & 10000./wvn_lw2(ib) - print *,'RAD -extrhi_grt:', extrhi_grt(:,ii) -! do i = 1, KRHLEV - do i = 1, KRHLEV, 10 - print *, 'RAD -extrhd_grt:',i,rhlev_grt(i), & - & extrhd_grt(i,:,ii) - enddo - enddo - endif + call optavg_gocart +! --- inputs: (in-scope variables, module variables) +! --- outputs: (module variables) -! --- ... dealoocate input data arrays no longer needed - deallocate ( iendwv_grt ) - if ( allocated(rhidext0_grt) ) then - deallocate ( rhidext0_grt ) - deallocate ( rhidssa0_grt ) - deallocate ( rhidasy0_grt ) - endif - if ( allocated(rhdpext0_grt) ) then - deallocate ( rhdpext0_grt ) - deallocate ( rhdpssa0_grt ) - deallocate ( rhdpasy0_grt ) - endif - endif ! end if_lgrtinit_block +! --- check print +! if (me == 0) then +! do ib = 1, NSWBND +! mb = ib + NSWSTR - 1 +! print *, ' wvnsw1,wvnsw2 :',wvnsw1(mb),wvnsw2(mb) +! print *, ' After optavg_gocart, for sw band:',ib +! print *, ' extrhi:', extrhi_grt(:,ib) +! print *, ' scarhi:', scarhi_grt(:,ib) +! print *, ' ssarhi:', ssarhi_grt(:,ib) +! print *, ' asyrhi:', asyrhi_grt(:,ib) +! do i = 1, KRHLEV +! print *, ' extrhd for rhlev:',i +! print *, extrhd_grt(i,:,ib) +! print *, ' scarhd for rhlev:',i +! print *, scarhd_grt(i,:,ib) +! print *, ' ssarhd for rhlev:',i +! print *, ssarhd_grt(i,:,ib) +! print *, ' asyrhd for rhlev:',i +! print *, asyrhd_grt(i,:,ib) +! enddo +! enddo +! print *, ' wvnlw1 :',wvnlw1 +! print *, ' wvnlw2 :',wvnlw2 +! do ib = 1, NLWBND +! ii = NSWBND + ib +! print *,' After optavg_gocart, for lw band:',ib +! print *,' extrhi_grt:', extrhi_grt(:,ii) +! print *,' scarhi_grt:', scarhi_grt(:,ii) +! print *,' ssarhi_grt:', ssarhi_grt(:,ii) +! print *,' asyrhi_grt:', asyrhi_grt(:,ii) +! do i = 1, KRHLEV +! print *,' extrhd for rhlev:',i +! print *, extrhd_grt(i,:,ib) +! print *,' scarhd for rhlev:',i +! print *, scarhd_grt(i,:,ib) +! print *,' ssarhd for rhlev:',i +! print *, ssarhd_grt(i,:,ib) +! print *,' asyrhd for rhlev:',i +! print *, asyrhd_grt(i,:,ib) +! enddo +! enddo +! endif ! ================= contains ! ================= -!>\ingroup module_radiation_aerosols -!> This subroutine determines merging coefficients ctaer; setup aerosol -!! specification. The current version only supports prognostic aerosols -!! (from GOCART in-line calculations) and climo aerosols (from GEOS-GOCART -!! runs). -!!\section set_aerspc_gen set_aerspc General Algorithm -!! place holder !----------------------------- - subroutine set_aerspc(raddt,fdaer) + subroutine rd_gocart_luts !............................. -! --- inputs: (in scope variables) +! --- inputs: (in scope variables, module variables) ! --- outputs: (in scope variables) ! ==================================================================== ! ! ! -! subprogram: set_aerspc ! -! ! -! determine merging coefficients ctaer; ! -! set up aerosol specification: num_gridcomp, gridcomp, dm_indx, ! -! dmfcs_indx, isoot, iwaso, isuso, issam, isscm ! -! ! -! Aerosol optical properties (ext, ssa, asy) are determined from ! -! NMGX (<=12) aerosol species ! -! ==> DU: dust1 (4 sub-micron bins), dust2, dust3, dust4, dust5 ! -! BC: soot_phobic, soot_philic ! -! OC: waso_phobic, waso_philic ! -! SU: suso (=so4) ! -! SS: ssam (accumulation mode), sscm (coarse mode) ! +! subprogram: rd_gocart_luts ! +! read GMAO pre-tabultaed aerosol optical data for dust, seasalt, ! +! sulfate, black carbon, and organic carbon aerosols ! ! ! -! The current version only supports prognostic aerosols (from GOCART ! -! in-line calculations) and climo aerosols (from GEOS-GOCART runs) ! +! major local variables: ! +! for handling spectral band structures ! +! iendwv - ending wvnum (cm**-1) for each band kaerbndd ! +! iendwv_du - ending wvnum (cm**-1) for each band kaerbndi ! +! for handling optical properties of rh independent species (kcm1) ! +! 1=du001, 2=du002, 3=du003, 4=du004, 5=du005 ! +! rhidext0_grt - extinction coefficient kaerbndi*kcm1 ! +! rhidsca0_grt - scattering coefficient kaerbndi*kcm1 ! +! rhidssa0_grt - single scattering albedo kaerbndi*kcm1 ! +! rhidasy0_grt - asymmetry parameter kaerbndi*kcm1 ! +! for handling optical properties of rh ndependent species (kcm2) ! +! 1=ss001, 2=ss002, 3=ss003, 4=ss004, 5=ss005, 6=so4, ! +! 7=bcphobic, 8=bcphilic, 9=ocphobic, 10=ocphilic ! +! rhdpext0_grt - extinction coefficient kaerbndd*krhlev*kcm2! +! rhdpsca0_grt - scattering coefficient kaerbndd*krhlev*kcm2! +! rhdpssa0_grt - single scattering albedo kaerbndd*krhlev*kcm2! +! rhdpasy0_grt - asymmetry parameter kaerbndd*krhlev*kcm2! +! ! +! usage: call rd_gocart_luts ! ! ! ! ================================================================== ! ! implicit none -! --- inputs: - real (kind=kind_phys), intent(in) :: raddt, fdaer -! --- output: - -! --- local: -! real (kind=kind_phys) :: raddt - integer :: i, indxr - character*2 :: tp, gridcomp_tmp(max_num_gridcomp) - -!! ===> determine ctaer (user specified weight for fcst fields) -! raddt = min(fhswr,fhlwr) / 24. - if( fdaer >= 99999. ) ctaer = f_one - if((fdaer>0.).and.(fdaer<99999.)) ctaer=exp(-raddt/fdaer) - - if(me==0 .and. lckprnt) then - print *, 'RAD -raddt, fdaer,ctaer: ', raddt, fdaer, ctaer - if (ctaer == f_one ) then - print *, 'LU -aerosol fields determined from fcst' - elseif (ctaer == f_zero) then - print *, 'LU -aerosol fields determined from clim' - else - print *, 'LU -aerosol fields determined from fcst/clim' - endif - endif +! --- inputs: (none) +! --- output: (none) -!! ===> determine get_fcst and get_clim -!! if fcst is chosen (ctaer == f_one ), set get_clim to F -!! if clim is chosen (ctaer == f_zero), set get_fcst to F - if ( ctaer == f_one ) get_clim = .false. - if ( ctaer == f_zero ) get_fcst = .false. - -!! ===> determine aerosol species to be included in the calculations -!! of aerosol optical properties (ext, ssa, asy) - -!* If climo option is chosen, the aerosol composition is hardwired -!* to full package. If not, the composition is determined from -!* tracer_config on-the-fly (full package or subset) - lab_if_fcst : if ( get_fcst ) then - -!! use tracer_config to determine num_gridcomp and gridcomp - if ( gfs_phy_tracer%doing_GOCART ) then - if ( gfs_phy_tracer%doing_DU ) then - num_gridcomp = num_gridcomp + 1 - gridcomp_tmp(num_gridcomp) = 'DU' - endif - if ( gfs_phy_tracer%doing_SU ) then - num_gridcomp = num_gridcomp + 1 - gridcomp_tmp(num_gridcomp) = 'SU' - endif - if ( gfs_phy_tracer%doing_SS ) then - num_gridcomp = num_gridcomp + 1 - gridcomp_tmp(num_gridcomp) = 'SS' - endif - if ( gfs_phy_tracer%doing_OC ) then - num_gridcomp = num_gridcomp + 1 - gridcomp_tmp(num_gridcomp) = 'OC' - endif - if ( gfs_phy_tracer%doing_BC ) then - num_gridcomp = num_gridcomp + 1 - gridcomp_tmp(num_gridcomp) = 'BC' - endif +! --- locals: + integer :: iradius, ik, ibeg + integer, parameter :: numspc = 5 ! # of aerosol species + +! - input tabulated aerosol optical spectral data from GSFC + real, dimension(kaerbndd) :: lambda ! wavelength (m) for non-dust + real, dimension(kaerbndi) :: lambda_du ! wavelength (m) for dust + real, dimension(krhlev) :: rh ! relative humidity (fraction) + real, dimension(kaerbndd,krhlev,numspc) :: bext! extinction efficiency (m2/kg) + real, dimension(kaerbndd,krhlev,numspc) :: bsca! scattering efficiency (m2/kg) + real, dimension(kaerbndd,krhlev,numspc) :: g ! asymmetry factor (dimensionless) + real, dimension(kaerbndi,krhlev,numspc) :: bext_du! extinction efficiency (m2/kg) + real, dimension(kaerbndi,krhlev,numspc) :: bsca_du! scattering efficiency (m2/kg) + real, dimension(kaerbndi,krhlev,numspc) :: g_du ! asymmetry factor (dimensionless) ! - if ( num_gridcomp > 0 ) then - allocate ( gridcomp(num_gridcomp) ) - gridcomp(1:num_gridcomp) = gridcomp_tmp(1:num_gridcomp) - else - print *,'ERROR: prognostic aerosols not found,abort',me - stop 1000 - endif - - else ! gfs_phy_tracer%doing_GOCART=F - - print *,'ERROR: prognostic aerosols option off, abort',me - stop 1001 - - endif ! end_if_gfs_phy_tracer%doing_GOCART_if_ - - else lab_if_fcst - -!! set to full package (max_num_gridcomp and max_gridcomp) - num_gridcomp = max_num_gridcomp - allocate ( gridcomp(num_gridcomp) ) - gridcomp(1:num_gridcomp) = max_gridcomp(1:num_gridcomp) - - endif lab_if_fcst - -!! -!! Aerosol specification is determined as such: -!! A. For radiation-aerosol feedback, the specification is based on the aeropt -!! routine from Mian Chin and Hongbin Yu (hydrophobic and hydrophilic for -!! OC/BC; submicron and supermicron for SS, 8-bins (with 4 subgroups for the -!! the submicron bin) for DU, and SO4 for SU) -!! B. For transport, the specification is determined from GOCART in-line module -!! C. For LUTS, (waso, soot, ssam, sscm, suso, dust) is used, based on the -!! the OPAC climo aerosol scheme (implemented by Yu-Tai Hou) - -!!=== determine dm_indx and NMXG - indxr = 0 - dm_indx%waso_phobic = -999 ! OC - dm_indx%soot_phobic = -999 ! BC - dm_indx%ssam = -999 ! SS - dm_indx%suso = -999 ! SU - dm_indx%dust1 = -999 ! DU - do i = 1, num_gridcomp - tp = gridcomp(i) - select case ( tp ) - case ( 'OC') ! consider hydrophobic and hydrophilic - dm_indx%waso_phobic = indxr + 1 - dm_indx%waso_philic = indxr + 2 - indxr = indxr + 2 - case ( 'BC') ! consider hydrophobic and hydrophilic - dm_indx%soot_phobic = indxr + 1 - dm_indx%soot_philic = indxr + 2 - indxr = indxr + 2 - case ( 'SS') ! consider submicron and supermicron - dm_indx%ssam = indxr + 1 - dm_indx%sscm = indxr + 2 - indxr = indxr + 2 - case ( 'SU') ! consider SO4 only - dm_indx%suso = indxr + 1 - indxr = indxr + 1 - case ( 'DU') ! consider all 5 bins - dm_indx%dust1 = indxr + 1 - dm_indx%dust2 = indxr + 2 - dm_indx%dust3 = indxr + 3 - dm_indx%dust4 = indxr + 4 - dm_indx%dust5 = indxr + 5 - indxr = indxr + 5 - case default - print *,'ERROR: aerosol species not supported, abort',me - stop 1002 - end select - enddo -!! - NMXG = indxr ! num of gocart aer spec for opt cal -!! - -!!=== determine dmfcs_indx -!! SS: 5-bins are considered for transport while only two groups -!! (accumulation/coarse modes) are considered for radiation -!! DU: 5-bins are considered for transport while 8 bins (with the -!! submicorn bin exptended to 4 bins) are considered for radiation -!! SU: DMS, SO2, and MSA are not considered for radiation - - if ( get_fcst ) then - if ( gfs_phy_tracer%doing_OC ) then - dmfcs_indx%ocphobic = trcindx ('ocphobic', gfs_phy_tracer) - dmfcs_indx%ocphilic = trcindx ('ocphilic', gfs_phy_tracer) - endif - if ( gfs_phy_tracer%doing_BC ) then - dmfcs_indx%bcphobic = trcindx ('bcphobic', gfs_phy_tracer) - dmfcs_indx%bcphilic = trcindx ('bcphilic', gfs_phy_tracer) - endif - if ( gfs_phy_tracer%doing_SS ) then - dmfcs_indx%ss001 = trcindx ('ss001', gfs_phy_tracer) - dmfcs_indx%ss002 = trcindx ('ss002', gfs_phy_tracer) - dmfcs_indx%ss003 = trcindx ('ss003', gfs_phy_tracer) - dmfcs_indx%ss004 = trcindx ('ss004', gfs_phy_tracer) - dmfcs_indx%ss005 = trcindx ('ss005', gfs_phy_tracer) - endif - if ( gfs_phy_tracer%doing_SU ) then - dmfcs_indx%so4 = trcindx ('so4', gfs_phy_tracer) - endif - if ( gfs_phy_tracer%doing_DU ) then - dmfcs_indx%du001 = trcindx ('du001', gfs_phy_tracer) - dmfcs_indx%du002 = trcindx ('du002', gfs_phy_tracer) - dmfcs_indx%du003 = trcindx ('du003', gfs_phy_tracer) - dmfcs_indx%du004 = trcindx ('du004', gfs_phy_tracer) - dmfcs_indx%du005 = trcindx ('du005', gfs_phy_tracer) - endif - endif + logical :: file_exist + character*50 :: fin, dummy + +! --- read LUTs for dust aerosols + fin='optics_'//gridcomp(1)//'.dat' + inquire (file=trim(fin), exist=file_exist) + if ( file_exist ) then + close(niaercm) + open (unit=niaercm, file=fin, status='OLD') + rewind(niaercm) + else + print *,' Requested luts file ',trim(fin),' not found' + print *,' ** Stopped in rd_gocart_luts ** ' + stop 1220 + endif ! end if_file_exist_block + + iradius = 5 +! read lambda and compute mpwavelength (m) + read(niaercm,'(a40)') dummy + read(niaercm,*) (lambda_du(i), i=1, kaerbndi) +! read rh, relative humidity (fraction) + read(niaercm,'(a40)') dummy + read(niaercm,*) (rh(i), i=1, krhlev) +! read bext (m2 (kg dry mass)-1) + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (bext_du(i,j,k), i=1,kaerbndi) + enddo + enddo +! read bsca (m2 (kg dry mass)-1) + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (bsca_du(i,j,k), i=1, kaerbndi) + enddo + enddo +! read g (dimensionless) + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (g_du(i,j,k), i=1, kaerbndi) + enddo + enddo -!! -!!=== determin KCM, KCM1, KCM2 -!! DU: submicron bin (dust1) contains 4 sub-groups (e.g., hardwire -!! 8 bins for aerosol optical properties luts) -!! OC/BC: while hydrophobic aerosols are rh-independent, the luts -!! for hydrophilic aerosols are used (e.g., use the coeff -!! corresponding to rh=0) -!! - indxr = 1 - isoot = -999 - iwaso = -999 - isuso = -999 - issam = -999 - isscm = -999 - do i = 1, num_gridcomp - tp = gridcomp(i) - if ( tp /= 'DU' ) then !<--- non-dust aerosols - select case ( tp ) - case ( 'OC ') - iwaso = indxr - case ( 'BC ') - isoot = indxr - case ( 'SU ') - isuso = indxr - case ( 'SS ') - issam = indxr - isscm = indxr + 1 - end select - if ( tp /= 'SS' ) then - indxr = indxr + 1 +! fill rhidext0 local arrays for dust aerosols (flip i-index) + do i = 1, kaerbndi ! convert from m to micron + j = kaerbndi -i + 1 ! flip i-index + wavelength_du(j) = 1.e6 * lambda_du(i) + enddo + do k = 1, iradius + do i = 1, kaerbndi + ii = kaerbndi -i + 1 + rhidext0_grt(ii,k) = bext_du(i,1,k) + rhidsca0_grt(ii,k) = bsca_du(i,1,k) + if ( bext_du(i,1,k) /= f_zero) then + rhidssa0_grt(ii,k) = bsca_du(i,1,k)/bext_du(i,1,k) else - indxr = indxr + 2 + rhidssa0_grt(ii,k) = f_one endif - else !<--- dust aerosols - KCM1 = 8 ! num of rh independent aer species - endif - enddo - KCM2 = indxr - 1 ! num of rh dependent aer species - KCM = KCM1 + KCM2 ! total num of aer species - -!! -!! check print starts here - if( me == 0 .and. lckprnt) then - print *, 'RAD -num_gridcomp:', num_gridcomp - print *, 'RAD -gridcomp :', gridcomp(:) - print *, 'RAD -NMXG:', NMXG - print *, 'RAD -dm_indx ===> ' - print *, 'RAD -aerspc: dust1=', dm_indx%dust1 - print *, 'RAD -aerspc: dust2=', dm_indx%dust2 - print *, 'RAD -aerspc: dust3=', dm_indx%dust3 - print *, 'RAD -aerspc: dust4=', dm_indx%dust4 - print *, 'RAD -aerspc: dust5=', dm_indx%dust5 - print *, 'RAD -aerspc: ssam=', dm_indx%ssam - print *, 'RAD -aerspc: sscm=', dm_indx%sscm - print *, 'RAD -aerspc: suso=', dm_indx%suso - print *, 'RAD -aerspc: waso_phobic=',dm_indx%waso_phobic - print *, 'RAD -aerspc: waso_philic=',dm_indx%waso_philic - print *, 'RAD -aerspc: soot_phobic=',dm_indx%soot_phobic - print *, 'RAD -aerspc: soot_philic=',dm_indx%soot_philic - - print *, 'RAD -KCM1 =', KCM1 - print *, 'RAD -KCM2 =', KCM2 - print *, 'RAD -KCM =', KCM - if ( KCM2 > 0 ) then - print *, 'RAD -aerspc: issam=', issam - print *, 'RAD -aerspc: isscm=', isscm - print *, 'RAD -aerspc: isuso=', isuso - print *, 'RAD -aerspc: iwaso=', iwaso - print *, 'RAD -aerspc: isoot=', isoot - endif - - if ( get_fcst ) then - print *, 'RAD -dmfcs_indx ===> ' - print *, 'RAD -trc_du001=',dmfcs_indx%du001 - print *, 'RAD -trc_du002=',dmfcs_indx%du002 - print *, 'RAD -trc_du003=',dmfcs_indx%du003 - print *, 'RAD -trc_du004=',dmfcs_indx%du004 - print *, 'RAD -trc_du005=',dmfcs_indx%du005 - print *, 'RAD -trc_so4 =',dmfcs_indx%so4 - print *, 'RAD -trc_ocphobic=',dmfcs_indx%ocphobic - print *, 'RAD -trc_ocphilic=',dmfcs_indx%ocphilic - print *, 'RAD -trc_bcphobic=',dmfcs_indx%bcphobic - print *, 'RAD -trc_bcphilic=',dmfcs_indx%bcphilic - print *, 'RAD -trc_ss001=',dmfcs_indx%ss001 - print *, 'RAD -trc_ss002=',dmfcs_indx%ss002 - print *, 'RAD -trc_ss003=',dmfcs_indx%ss003 - print *, 'RAD -trc_ss004=',dmfcs_indx%ss004 - print *, 'RAD -trc_ss005=',dmfcs_indx%ss005 - endif - endif -!! check print ends here - - return -! ! - end subroutine set_aerspc - -!----------------------------------- -!>\ingroup module_radiation_aerosols -!> This subroutine reads input gocart aerosol optical data from Mie -!! code calculations. -!\section rd_gocart_luts_gen rd_gocart_luts General Algorithm -!----------------------------- - subroutine rd_gocart_luts -!............................. -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) - -! ==================================================================== ! -! subprogram: rd_gocart_luts ! -! read input gocart aerosol optical data from Mie code calculations ! -! ! -! Remarks (Quanhua (Mark) Liu, JCSDA, June 2008) ! -! The LUT is for NCEP selected 61 wave numbers and 6 aerosols ! -! (dust, soot, suso, waso, ssam, and sscm) and 36 aerosol effective ! -! size in microns. ! -! ! -! The LUT is computed using Mie code with a logorithm size ! -! distribution for each of 36 effective sizes. The standard deviation ! -! sigma of the size, and min/max size follows Chin et al. 2000 ! -! For each effective size, it corresponds a relative humidity value. ! -! ! -! The LUT contains the density, sigma, relative humidity, mean mode ! -! radius, effective size, mass extinction coefficient, single ! -! scattering albedo, asymmetry factor, and phase function ! -! ! -! ================================================================== ! -! - implicit none - -! --- inputs: -! --- output: - -! --- locals: - INTEGER, PARAMETER :: NP = 100, NP2 = 2*NP, nWave=100, & - & nAero=6, n_p=36 - INTEGER :: NW, NS, nH, n_bin - real (kind=kind_io8), Dimension( NP2 ) :: Angle, Cos_Angle, & - & Cos_Weight - real (kind=kind_io8), Dimension(n_p,nAero) :: RH, rm, reff - real (kind=kind_io8), Dimension(nWave,n_p,nAero) :: & - & ext0, sca0, asy0 - real (kind=kind_io8), Dimension(NP2,n_p,nWave,nAero) :: ph0 - real (kind=kind_io8) :: wavelength(nWave), density(nAero), & - & sigma(nAero), wave,n_fac,PI,t1,s1,g1 - CHARACTER(len=80) :: AerosolName(nAero) - INTEGER :: i, j, k, l, ij - - character :: aerosol_file*30 - logical :: file_exist - integer :: indx_dust(8) ! map 36 dust bins to gocart size bins - - data aerosol_file /"NCEP_AEROSOL.bin"/ - data AerosolName/ ' Dust ', ' Soot ', ' SUSO ', ' WASO ', & - & ' SSAM ', ' SSCM '/ - -!! 8 dust bins -!! 1 2 3 4 5 6 7 8 -!! .1-.18, .18-.3, .3-.6, 0.6-1.0, 1.0-1.8, 1.8-3, 3-6, 6-10 <-- def -!! 0.1399 0.2399 0.4499 0.8000 1.3994 2.3964 4.4964 7.9887 <-- reff - data indx_dust/4, 8, 12, 18, 21, 24, 30, 36/ - -! PI = acos(-1.d0) - -! -- allocate aerosol optical data - if ( .not. allocated( iendwv_grt ) ) then - allocate ( iendwv_grt (KAERBND) ) - endif - if (.not. allocated(rhidext0_grt) .and. KCM1 > 0 ) then - allocate ( rhidext0_grt(KAERBND,KCM1)) - allocate ( rhidssa0_grt(KAERBND,KCM1)) - allocate ( rhidasy0_grt(KAERBND,KCM1)) - endif - if (.not. allocated(rhdpext0_grt) .and. KCM2 > 0 ) then - allocate ( rhdpext0_grt(KAERBND,KRHLEV,KCM2)) - allocate ( rhdpssa0_grt(KAERBND,KRHLEV,KCM2)) - allocate ( rhdpasy0_grt(KAERBND,KRHLEV,KCM2)) - endif - -! -- read luts - inquire (file = aerosol_file, exist = file_exist) - - if ( file_exist ) then - if(me==0 .and. lckprnt) print *,'RAD -open :',aerosol_file - close (NIAERCM) - open (unit=NIAERCM,file=aerosol_file,status='OLD', & - & action='read',form='UNFORMATTED') - else - print *,' Requested aerosol data file "',aerosol_file, & - & '" not found!', me - print *,' *** Stopped in subroutine RD_GOCART_LUTS !!' - stop 1003 - endif ! end if_file_exist_block - - READ(NIAERCM) (Cos_Angle(i),i=1,NP) - READ(NIAERCM) (Cos_Weight(i),i=1,NP) - READ(NIAERCM) - READ(NIAERCM) - READ(NIAERCM) NW,NS - READ(NIAERCM) - READ(NIAERCM) (wavelength(i),i=1,NW) - -! --- check nAero and NW - if (NW /= KAERBND) then - print *, "Incorrect spectral band, abort ", NW - stop 1004 - endif - -! --- convert wavelength to wavenumber - do i = 1, KAERBND - iendwv_grt(i) = 10000. / wavelength(i) - if(me==0 .and. lckprnt) print *,'RAD -wn,lamda:', & - & i,iendwv_grt(i),wavelength(i) - enddo + rhidasy0_grt(ii,k) = g_du(i,1,k) + enddo + enddo - DO j = 1, nAero - if(me==0 .and. lckprnt) print *,'RAD -read LUTs:', & - & j,AerosolName(j) - READ(NIAERCM) - READ(NIAERCM) - READ(NIAERCM) n_bin, density(j), sigma(j) - READ(NIAERCM) - READ(NIAERCM) (RH(i,j),i=1, n_bin) - READ(NIAERCM) - READ(NIAERCM) (rm(i,j),i=1, n_bin) - READ(NIAERCM) - READ(NIAERCM) (reff(i,j),i=1, n_bin) - -! --- check n_bin - if (n_bin /= KRHLEV ) then - print *, "Incorrect rh levels, abort ", n_bin - stop 1005 - endif +! --- read LUTs for non-dust aerosols + do ib = 2, num_gc ! loop thru SS, SU, BC, OC + fin='optics_'//gridcomp(ib)//'.dat' + inquire (file=trim(fin), exist=file_exist) + if ( file_exist ) then + close(niaercm) + open (unit=niaercm, file=fin, status='OLD') + rewind(niaercm) + else + print *,' Requested luts file ',trim(fin),' not found' + print *,' ** Stopped in rd_gocart_luts ** ' + stop 1222 + endif ! end if_file_exist_block + + ibeg = radius_lower(ib) - kcm1 + iradius = num_radius(ib) + +! read lambda and compute mpwavelength (m) + read(niaercm,'(a40)') dummy + read(niaercm,*) (lambda(i), i=1, kaerbndd) +! read rh, relative humidity (fraction) + read(niaercm,'(a40)') dummy + read(niaercm,*) (rh(i), i=1, krhlev) +! read bext + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (bext(i,j,k), i=1,kaerbndd) + enddo + enddo +! read bsca + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (bsca(i,j,k), i=1, kaerbndd) + enddo + enddo +! read g + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (g(i,j,k), i=1, kaerbndd) + enddo + enddo -! --- read luts - DO k = 1, NW - READ(NIAERCM) wave,(ext0(k,L,j),L=1,n_bin) - READ(NIAERCM) (sca0(k,L,j),L=1,n_bin) - READ(NIAERCM) (asy0(k,L,j),L=1,n_bin) - READ(NIAERCM) (ph0(1:NP2,L,k,j),L=1,n_bin) - END DO - -! --- map luts input to module variables - if (AerosolName(j) == ' Dust ' ) then - if ( KCM1 > 0) then !<-- only if rh independent aerosols are needed - do i = 1, KCM1 - rhidext0_grt(1:KAERBND,i)=ext0(1:KAERBND,indx_dust(i),j) - rhidssa0_grt(1:KAERBND,i)=sca0(1:KAERBND,indx_dust(i),j) - rhidasy0_grt(1:KAERBND,i)=asy0(1:KAERBND,indx_dust(i),j) +! fill rhdpext0 local arrays for non-dust aerosols (flip i-index) + do i = 1, kaerbndd ! convert from m to micron + j = kaerbndd -i + 1 ! flip i-index + wavelength(j) = 1.e6 * lambda(i) + enddo + do k = 1, iradius + ik = ibeg + k - 1 + do i = 1, kaerbndd + ii = kaerbndd -i + 1 + do j = 1, krhlev + rhdpext0_grt(ii,j,ik) = bext(i,j,k) + rhdpsca0_grt(ii,j,ik) = bsca(i,j,k) + if ( bext(i,j,k) /= f_zero) then + rhdpssa0_grt(ii,j,ik) = bsca(i,j,k)/bext(i,j,k) + else + rhdpssa0_grt(ii,j,ik) = f_one + endif + rhdpasy0_grt(ii,j,ik) = g(i,j,k) enddo - endif - else - if ( KCM2 > 0) then !<-- only if rh dependent aerosols are needed - if (AerosolName(j) == ' Soot ') ij = isoot - if (AerosolName(j) == ' SUSO ') ij = isuso - if (AerosolName(j) == ' WASO ') ij = iwaso - if (AerosolName(j) == ' SSAM ') ij = issam - if (AerosolName(j) == ' SSCM ') ij = isscm - if ( ij .ne. -999 ) then - rhdpext0_grt(1:KAERBND,1:KRHLEV,ij) = & - & ext0(1:KAERBND,1:KRHLEV,j) - rhdpssa0_grt(1:KAERBND,1:KRHLEV,ij) = & - & sca0(1:KAERBND,1:KRHLEV,j) - rhdpasy0_grt(1:KAERBND,1:KRHLEV,ij) = & - & asy0(1:KAERBND,1:KRHLEV,j) - endif ! if_ij - endif ! if_KCM2 - endif - END DO + enddo + enddo + + enddo !! ib-loop return !................................... end subroutine rd_gocart_luts !----------------------------------- -! ! -!>\ingroup module_radiation_aerosols -!> This subroutine computes mean aerosols optical properties over each -!! SW/LW radiation spectral band for each of the species components. -!! This program follows GFDL's approach for thick cloud optical property -!! in SW radiation scheme (2000). -!>\section optavg_grt_gen optavg_grt General Algorithm -!! @{ -!----------------------------- - subroutine optavg_grt -!............................. -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + +!-------------------------------- + subroutine optavg_gocart +!................................ +! --- inputs: (in-scope variables, module variables) +! --- outputs: (module variables) ! ==================================================================== ! ! ! -! subprogram: optavg_grt ! +! subprogram: optavg_gocart ! ! ! -! compute mean aerosols optical properties over each sw/lw radiation ! +! compute mean aerosol optical properties over each sw radiation ! ! spectral band for each of the species components. This program ! -! follows gfdl's approach for thick cloud opertical property in ! -! sw radiation scheme (2000). ! +! follows optavg routine (in turn follows gfdl's approach for thick ! +! cloud opertical property in sw radiation scheme (2000). ! ! ! ! ==================== defination of variables =================== ! ! ! -! input arguments: ! -! nv1,nv2 (NBDSW) - start/end spectral band indices of aerosol data ! +! major input variables: ! +! nv1,nv2 (nswbnd) - start/end spectral band indices of aerosol data ! +! for each sw radiation spectral band ! +! nr1,nr2 (nlwbnd) - start/end spectral band indices of aerosol data ! +! for each ir radiation spectral band ! +! nv1_du,nv2_du(nswbnd) - start/end spectral band indices of aer data! ! for each sw radiation spectral band ! -! nr1,nr2 (NLWBND) - start/end spectral band indices of aerosol data ! +! nr1_du,nr2_du(nlwbnd) - start/end spectral band indices of aer data! ! for each ir radiation spectral band ! -! solwaer (NBDSW,KAERBND) ! +! solwaer (nswbnd,kaerbndd) ! ! - solar flux weight over each sw radiation band ! ! vs each aerosol data spectral band ! -! eirwaer (NLWBND,KAERBND) ! +! eirwaer (nlwbnd,kaerbndd) ! ! - ir flux weight over each lw radiation band ! ! vs each aerosol data spectral band ! -! solbnd (NBDSW) - solar flux weight over each sw radiation band ! -! eirbnd (NLWBND) - ir flux weight over each lw radiation band ! -! NBDSW - total number of sw spectral bands ! -! NLWBND - total number of lw spectral bands ! -! NSWLWBD - total number of sw+lw spectral bands ! +! solwaer_du (nswbnd,kaerbndi) ! +! - solar flux weight over each sw radiation band ! +! vs each aerosol data spectral band ! +! eirwaer_du (nlwbnd,kaerbndi) ! +! - ir flux weight over each lw radiation band ! +! vs each aerosol data spectral band ! +! solbnd (nswbnd) - solar flux weight over each sw radiation band ! +! eirbnd (nlwbnd) - ir flux weight over each lw radiation band ! +! solbnd_du(nswbnd) - solar flux weight over each sw radiation band ! +! eirbnd_du(nlwbnd) - ir flux weight over each lw radiation band ! +! nswbnd - total number of sw spectral bands ! +! nlwbnd - total number of lw spectral bands ! ! ! -! output arguments: (to module variables) ! +! external module variables: (in physparam) ! +! laswflg - control flag for sw spectral region ! +! lalwflg - control flag for lw spectral region ! +! ! +! output variables: (to module variables) ! ! ! ! ================================================================== ! -! - implicit none ! --- inputs: ! --- output: ! --- locals: - real (kind=kind_phys) :: sumk, sumok, sumokg, sumreft, & + real (kind=kind_phys) :: sumk, sums, sumok, sumokg, sumreft, & & sp, refb, reft, rsolbd, rirbd integer :: ib, nb, ni, nh, nc ! !===> ... begin here - -! --- ... allocate aerosol optical data - if (.not. allocated(extrhd_grt) .and. KCM2 > 0 ) then - allocate ( extrhd_grt(KRHLEV,KCM2,NSWLWBD) ) - allocate ( ssarhd_grt(KRHLEV,KCM2,NSWLWBD) ) - allocate ( asyrhd_grt(KRHLEV,KCM2,NSWLWBD) ) - endif - if (.not. allocated(extrhi_grt) .and. KCM1 > 0 ) then - allocate ( extrhi_grt(KCM1,NSWLWBD) ) - allocate ( ssarhi_grt(KCM1,NSWLWBD) ) - allocate ( asyrhi_grt(KCM1,NSWLWBD) ) - endif ! ! --- ... loop for each sw radiation spectral band - - do nb = 1, NBDSW - rsolbd = f_one / solbnd(nb) - -! --- for rh independent aerosol species - - lab_rhi: if (KCM1 > 0 ) then - do nc = 1, KCM1 - sumk = f_zero - sumok = f_zero - sumokg = f_zero - sumreft = f_zero - - do ni = nv1(nb), nv2(nb) - sp = sqrt( (f_one - rhidssa0_grt(ni,nc)) & - & / (f_one - rhidssa0_grt(ni,nc)*rhidasy0_grt(ni,nc)) ) - reft = (f_one - sp) / (f_one + sp) - sumreft = sumreft + reft*solwaer(nb,ni) - - sumk = sumk + rhidext0_grt(ni,nc)*solwaer(nb,ni) - sumok = sumok + rhidssa0_grt(ni,nc)*solwaer(nb,ni) & - & * rhidext0_grt(ni,nc) - sumokg = sumokg + rhidssa0_grt(ni,nc)*solwaer(nb,ni) & - & * rhidext0_grt(ni,nc)*rhidasy0_grt(ni,nc) - enddo - - refb = sumreft * rsolbd - - extrhi_grt(nc,nb) = sumk * rsolbd - asyrhi_grt(nc,nb) = sumokg / (sumok + 1.0e-10) - ssarhi_grt(nc,nb) = 4.0*refb & - & / ( (f_one+refb)**2 - asyrhi_grt(nc,nb)*(f_one-refb)**2 ) - - enddo ! end do_nc_block for rh-ind aeros - endif lab_rhi - -! --- for rh dependent aerosols species - - lab_rhd: if (KCM2 > 0 ) then - do nc = 1, KCM2 - do nh = 1, KRHLEV + + if ( laswflg ) then + do nb = 1, nswbnd + rsolbd = f_one / solbnd_du(nb) + do nc = 1, kcm1 ! --- for rh independent aerosol species sumk = f_zero + sums = f_zero sumok = f_zero sumokg = f_zero sumreft = f_zero - do ni = nv1(nb), nv2(nb) - sp = sqrt( (f_one - rhdpssa0_grt(ni,nh,nc)) & - & /(f_one-rhdpssa0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc))) + do ni = nv1_du(nb), nv2_du(nb) + sp = sqrt( (f_one - rhidssa0_grt(ni,nc)) & + & / (f_one - rhidssa0_grt(ni,nc)*rhidasy0_grt(ni,nc)) ) reft = (f_one - sp) / (f_one + sp) - sumreft = sumreft + reft*solwaer(nb,ni) - - sumk = sumk + rhdpext0_grt(ni,nh,nc)*solwaer(nb,ni) - sumok = sumok + rhdpssa0_grt(ni,nh,nc)*solwaer(nb,ni) & - & * rhdpext0_grt(ni,nh,nc) - sumokg = sumokg + rhdpssa0_grt(ni,nh,nc)*solwaer(nb,ni) & - & * rhdpext0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc) + sumreft = sumreft + reft*solwaer_du(nb,ni) + + sumk = sumk + rhidext0_grt(ni,nc)*solwaer_du(nb,ni) + sums = sums + rhidsca0_grt(ni,nc)*solwaer_du(nb,ni) + sumok = sumok + rhidssa0_grt(ni,nc)*solwaer_du(nb,ni) & + & * rhidext0_grt(ni,nc) + sumokg = sumokg + rhidssa0_grt(ni,nc)*solwaer_du(nb,ni) & + & * rhidext0_grt(ni,nc)*rhidasy0_grt(ni,nc) enddo refb = sumreft * rsolbd - extrhd_grt(nh,nc,nb) = sumk * rsolbd - asyrhd_grt(nh,nc,nb) = sumokg / (sumok + 1.0e-10) - ssarhd_grt(nh,nc,nb) = 4.0*refb & - & /((f_one+refb)**2 - asyrhd_grt(nh,nc,nb)*(f_one-refb)**2) - enddo ! end do_nh_block - enddo ! end do_nc_block for rh-dep aeros - endif lab_rhd + extrhi_grt(nc,nb) = sumk * rsolbd + scarhi_grt(nc,nb) = sums * rsolbd + asyrhi_grt(nc,nb) = sumokg / (sumok + 1.0e-10) + ssarhi_grt(nc,nb) = 4.0*refb & + & / ( (f_one+refb)**2 - asyrhi_grt(nc,nb)*(f_one-refb)**2 ) + enddo ! end do_nc_block for rh-ind aeros + + rsolbd = f_one / solbnd(nb) + do nc = 1, kcm2 ! --- for rh dependent aerosol species + do nh = 1, krhlev + sumk = f_zero + sums = f_zero + sumok = f_zero + sumokg = f_zero + sumreft = f_zero - enddo ! end do_nb_block for sw + do ni = nv1(nb), nv2(nb) + sp = sqrt( (f_one - rhdpssa0_grt(ni,nh,nc)) & + & /(f_one-rhdpssa0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc))) + reft = (f_one - sp) / (f_one + sp) + sumreft = sumreft + reft*solwaer(nb,ni) -! --- ... loop for each lw radiation spectral band + sumk = sumk + rhdpext0_grt(ni,nh,nc)*solwaer(nb,ni) + sums = sums + rhdpsca0_grt(ni,nh,nc)*solwaer(nb,ni) + sumok = sumok + rhdpssa0_grt(ni,nh,nc)*solwaer(nb,ni) & + & * rhdpext0_grt(ni,nh,nc) + sumokg = sumokg + rhdpssa0_grt(ni,nh,nc)*solwaer(nb,ni)& + & * rhdpext0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc) + enddo - do nb = 1, NLWBND + refb = sumreft * rsolbd - ib = NBDSW + nb - rirbd = f_one / eirbnd(nb) + extrhd_grt(nh,nc,nb) = sumk * rsolbd + scarhd_grt(nh,nc,nb) = sums * rsolbd + asyrhd_grt(nh,nc,nb) = sumokg / (sumok + 1.0e-10) + ssarhd_grt(nh,nc,nb) = 4.0*refb & + & /((f_one+refb)**2 - asyrhd_grt(nh,nc,nb)*(f_one-refb)**2) -! --- for rh independent aerosol species + enddo ! end do_nh_block + enddo ! end do_nc_block for rh-dep aeros - lab_rhi_lw: if (KCM1 > 0 ) then - do nc = 1, KCM1 - sumk = f_zero - sumok = f_zero - sumokg = f_zero - sumreft = f_zero + enddo ! end do_nb_block for sw + endif ! end if_laswflg_block - do ni = nr1(nb), nr2(nb) - sp = sqrt( (f_one - rhidssa0_grt(ni,nc)) & - & / (f_one - rhidssa0_grt(ni,nc)*rhidasy0_grt(ni,nc)) ) - reft = (f_one - sp) / (f_one + sp) - sumreft = sumreft + reft*eirwaer(nb,ni) - - sumk = sumk + rhidext0_grt(ni,nc)*eirwaer(nb,ni) - sumok = sumok + rhidssa0_grt(ni,nc)*eirwaer(nb,ni) & - & * rhidext0_grt(ni,nc) - sumokg = sumokg + rhidssa0_grt(ni,nc)*eirwaer(nb,ni) & - & * rhidext0_grt(ni,nc)*rhidasy0_grt(ni,nc) - enddo +! --- ... loop for each lw radiation spectral band - refb = sumreft * rirbd + if ( lalwflg ) then - extrhi_grt(nc,ib) = sumk * rirbd - asyrhi_grt(nc,ib) = sumokg / (sumok + 1.0e-10) - ssarhi_grt(nc,ib) = 4.0*refb & - & / ( (f_one+refb)**2 - asyrhi_grt(nc,ib)*(f_one-refb)**2 ) - enddo ! end do_nc_block for rh-ind aeros - endif lab_rhi_lw + do nb = 1, nlwbnd -! --- for rh dependent aerosols species + ib = nswbnd + nb - lab_rhd_lw: if (KCM2 > 0 ) then - do nc = 1, KCM2 - do nh = 1, KRHLEV + rirbd = f_one / eirbnd_du(nb) + do nc = 1, kcm1 ! --- for rh independent aerosol species sumk = f_zero + sums = f_zero sumok = f_zero sumokg = f_zero sumreft = f_zero - do ni = nr1(nb), nr2(nb) - sp = sqrt( (f_one - rhdpssa0_grt(ni,nh,nc)) & - & /(f_one - rhdpssa0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc)) ) + do ni = nr1_du(nb), nr2_du(nb) + sp = sqrt( (f_one - rhidssa0_grt(ni,nc)) & + & / (f_one - rhidssa0_grt(ni,nc)*rhidasy0_grt(ni,nc)) ) reft = (f_one - sp) / (f_one + sp) - sumreft = sumreft + reft*eirwaer(nb,ni) - - sumk = sumk + rhdpext0_grt(ni,nh,nc)*eirwaer(nb,ni) - sumok = sumok + rhdpssa0_grt(ni,nh,nc)*eirwaer(nb,ni) & - & * rhdpext0_grt(ni,nh,nc) - sumokg = sumokg+ rhdpssa0_grt(ni,nh,nc)*eirwaer(nb,ni) & - & * rhdpext0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc) + sumreft = sumreft + reft*eirwaer_du(nb,ni) + + sumk = sumk + rhidext0_grt(ni,nc)*eirwaer_du(nb,ni) + sums = sums + rhidsca0_grt(ni,nc)*eirwaer_du(nb,ni) + sumok = sumok + rhidssa0_grt(ni,nc)*eirwaer_du(nb,ni) & + & * rhidext0_grt(ni,nc) + sumokg = sumokg + rhidssa0_grt(ni,nc)*eirwaer_du(nb,ni) & + & * rhidext0_grt(ni,nc)*rhidasy0_grt(ni,nc) enddo refb = sumreft * rirbd - extrhd_grt(nh,nc,ib) = sumk * rirbd - asyrhd_grt(nh,nc,ib) = sumokg / (sumok + 1.0e-10) - ssarhd_grt(nh,nc,ib) = 4.0*refb & - & /((f_one+refb)**2 - asyrhd_grt(nh,nc,ib)*(f_one-refb)**2 ) - enddo ! end do_nh_block - enddo ! end do_nc_block for rh-dep aeros - endif lab_rhd_lw - - enddo ! end do_nb_block for lw - -! - return -!................................ - end subroutine optavg_grt -!! @} -!-------------------------------- -! -!>\ingroup module_radiation_aerosols -!! -!! This subroutine: -!! - Read in aerosol dry mass and surface pressure from GEOS3-GOCART -!! C3.1 2000 monthly dataset or aerosol mixing ratio and surface -!! pressure from GEOS4-GOCART 2000-2007 averaged monthly data set. -!! - Compute goes lat/lon array (for horizontal mapping) -!\section rd_gocart_clim_gen rd_gocart_clim General Algorithm -! @{ -!----------------------------------- - subroutine rd_gocart_clim -!................................... -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + extrhi_grt(nc,ib) = sumk * rirbd + scarhi_grt(nc,ib) = sums * rirbd + asyrhi_grt(nc,ib) = sumokg / (sumok + 1.0e-10) + ssarhi_grt(nc,ib) = 4.0*refb & + & / ( (f_one+refb)**2 - asyrhi_grt(nc,ib)*(f_one-refb)**2 ) -! ================================================================== ! -! ! -! subprogram: rd_gocart_clim ! -! ! -! 1. read in aerosol dry mass and surface pressure from GEOS3-GOCART ! -! C3.1 2000 monthly data set ! -! or aerosol mixing ratio and surface pressure from GEOS4-GOCART ! -! 2000-2007 averaged monthly data set ! -! 2. compute goes lat/lon array (for horizontal mapping) ! -! ! -! ==================== defination of variables =================== ! -! ! -! inputs arguments: ! -! imon - month of the year ! -! me - print message control flag ! -! ! -! outputs arguments: (to the module variables) ! -! psclmg - pressure (sfc to toa) cb IMXG*JMXG*KMXG ! -! dmclmg - aerosol dry mass/mixing ratio IMXG*JMXG*KMXG*NMXG ! -! geos_rlon - goes longitude deg IMXG ! -! geos_rlat - goes latitude deg JMXG ! -! ! -! usage: call rd_gocart_clim ! -! ! -! program history: ! -! 05/18/2010 --- Lu Add the option to read GEOS4-GOCART climo ! -! ================================================================== ! -! - implicit none - -! --- inputs: -! --- output: - -! --- locals: - integer, parameter :: MAXSPC = 5 - real (kind=kind_io4), parameter :: PINT = 0.01 - real (kind=kind_io4), parameter :: EPSQ = 0.0 - - integer :: i, j, k, numspci, ii - integer :: icmp, nrecl, nt1, nt2, nn(MAXSPC) - character :: ymd*6, yr*4, mn*2, tp*2, & - & fname*30, fin*30, aerosol_file*40 - logical :: file_exist - - real (kind=kind_io4), dimension(KMXG) :: sig - real (kind=kind_io4), dimension(IMXG,JMXG) :: ps - real (kind=kind_io4), dimension(IMXG,JMXG,KMXG) :: temp - real (kind=kind_io4), dimension(IMXG,JMXG,KMXG,MAXSPC):: buff - real (kind=kind_phys) :: pstmp - -! Add the following variables for GEOS4-GOCART - real (kind=kind_io4), dimension(KMXG):: hyam, hybm - real (kind=kind_io4) :: p0 - - data yr /'2000'/ !!<=== use 2000 as the climo proxy - -!* sigma_coordinate for GEOS3-GOCART -!* P(i,j,k) = PINT + SIG(k) * (PS(i,j) - PINT) - data SIG / & - & 9.98547E-01,9.94147E-01,9.86350E-01,9.74300E-01,9.56950E-01, & - & 9.33150E-01,9.01750E-01,8.61500E-01,8.11000E-01,7.50600E-01, & - & 6.82900E-01,6.10850E-01,5.37050E-01,4.63900E-01,3.93650E-01, & - & 3.28275E-01,2.69500E-01,2.18295E-01,1.74820E-01,1.38840E-01, & - & 1.09790E-01,8.66900E-02,6.84150E-02,5.39800E-02,4.25750E-02, & - & 3.35700E-02,2.39900E-02,1.36775E-02,5.01750E-03,5.30000E-04 / - -!* hybrid_sigma_pressure_coordinate for GEOS4-GOCART -!* p(i,j,k) = a(k)*p0 + b(k)*ps(i,j) - data hyam/ & - & 0, 0.0062694, 0.02377049, 0.05011813, 0.08278809, 0.1186361, & - & 0.1540329, 0.1836373, 0.2043698, 0.2167788, 0.221193, & - & 0.217729, 0.2062951, 0.1865887, 0.1615213, 0.1372958, & - & 0.1167039, 0.09920014, 0.08432171, 0.06656809, 0.04765031, & - & 0.03382346, 0.0237648, 0.01435208, 0.00659734, 0.002826232, & - & 0.001118959, 0.0004086494, 0.0001368611, 3.750308e-05/ - - data hybm / & - & 0.992555, 0.9642, 0.90556, 0.816375, 0.703815, 0.576585, & - & 0.44445, 0.324385, 0.226815, 0.149165, 0.089375, & - & 0.045865, 0.017485, 0.00348, 0, 0, 0, 0, 0, & - & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 / - - data p0 /1013.25 / - -!===> ... begin here - -! --- allocate and initialize gocart climatological data - if ( .not. allocated (dmclmg) ) then - allocate ( dmclmg(IMXG,JMXG,KMXG,NMXG) ) - allocate ( psclmg(IMXG,JMXG,KMXG) ) - allocate ( molwgt(NMXG) ) - endif - - dmclmg(:,:,:,:) = f_zero - psclmg(:,:,:) = f_zero - molwgt(:) = f_zero + enddo ! end do_nc_block for rh-ind aeros -! --- allocate and initialize geos lat and lon arrays - if ( .not. allocated ( geos_rlon )) then - allocate (geos_rlon(IMXG)) - allocate (geos_rlat(JMXG)) - endif + rirbd = f_one / eirbnd(nb) + do nc = 1, kcm2 ! --- for rh dependent aerosol species + do nh = 1, krhlev + sumk = f_zero + sums = f_zero + sumok = f_zero + sumokg = f_zero + sumreft = f_zero - geos_rlon(:) = f_zero - geos_rlat(:) = f_zero - -! --- compute geos lat and lon arrays - do i = 1, IMXG - geos_rlon(i) = -180. + (i-1)* dltx - end do - do j = 2, JMXG-1 - geos_rlat(j) = -90. + (j-1)* dlty - end do - geos_rlat(1) = -89.5 - geos_rlat(JMXG) = 89.5 - -! --- determine whether GEOS3 or GEOS4 data set is provided - if ( gocart_climo == 'xxxx' ) then - gocart_climo='0000' -! check geos3-gocart climo - aerosol_file = '200001.PS.avg' - inquire (file = aerosol_file, exist = file_exist) - if ( file_exist ) gocart_climo='ver3' -! check geos4-gocart climo - aerosol_file = 'gocart_climo_2000x2007_ps_01.bin' - inquire (file = aerosol_file, exist = file_exist) - if ( file_exist ) gocart_climo='ver4' - endif -! -! -! --- read ps (sfc pressure) and compute 3d pressure field (psclmg) -! - write(mn,'(i2.2)') imon - ymd = yr//mn - aerosol_file = 'null' - if ( gocart_climo == 'ver3' ) then - aerosol_file = ymd//'.PS.avg' - elseif ( gocart_climo == 'ver4' ) then - aerosol_file = 'gocart_climo_2000x2007_ps_'//mn//'.bin' - endif -! - inquire (file = aerosol_file, exist = file_exist) - lab_if_ps : if ( file_exist ) then - - close(NIAERCM) - if ( gocart_climo == 'ver3' ) then - nrecl = 4 * (IMXG * JMXG) - open(NIAERCM, file=trim(aerosol_file), & - & action='read',access='direct',recl=nrecl) - read(NIAERCM, rec=1) ps - do j = 1, JMXG - do i = 1, IMXG - do k = 1, KMXG - pstmp = pint + sig(k) * (ps(i,j) - pint) - psclmg(i,j,k) = 0.1 * pstmp ! convert mb to cb - enddo - enddo - enddo + do ni = nr1(nb), nr2(nb) + sp = sqrt( (f_one - rhdpssa0_grt(ni,nh,nc)) & + & /(f_one-rhdpssa0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc))) + reft = (f_one - sp) / (f_one + sp) + sumreft = sumreft + reft*eirwaer(nb,ni) - elseif ( gocart_climo == 'ver4' ) then - open(NIAERCM, file=trim(aerosol_file), & - & action='read',status='old', form='unformatted') - read(NIAERCM) ps(:,:) - do j = 1, JMXG - do i = 1, IMXG - do k = 1, KMXG - pstmp = hyam(k)*p0 + hybm(k)*ps(i,j) - psclmg(i,j,k) = 0.1 * pstmp ! convert mb to cb - enddo - enddo - enddo + sumk = sumk + rhdpext0_grt(ni,nh,nc)*eirwaer(nb,ni) + sums = sums + rhdpsca0_grt(ni,nh,nc)*eirwaer(nb,ni) + sumok = sumok + rhdpssa0_grt(ni,nh,nc)*eirwaer(nb,ni) & + & * rhdpext0_grt(ni,nh,nc) + sumokg = sumokg+ rhdpssa0_grt(ni,nh,nc)*eirwaer(nb,ni) & + & * rhdpext0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc) + enddo - endif ! ---- end if_gocart_climo + refb = sumreft * rirbd - else lab_if_ps + extrhd_grt(nh,nc,ib) = sumk * rirbd + scarhd_grt(nh,nc,ib) = sums * rirbd + asyrhd_grt(nh,nc,ib) = sumokg / (sumok + 1.0e-10) + ssarhd_grt(nh,nc,ib) = 4.0*refb & + & /((f_one+refb)**2 - asyrhd_grt(nh,nc,ib)*(f_one-refb)**2) + enddo ! end do_nh_block + enddo ! end do_nc_block for rh-dep aeros - print *,' *** Requested aerosol data file "', & - & trim(aerosol_file), '" not found!' - print *,' *** Stopped in RD_GOCART_CLIM ! ', me - stop 1006 - endif lab_if_ps -! -! --- read aerosol dry mass (g/m3) or mixing ratios (mol/mol,kg/kg) -! - lab_do_icmp : do icmp = 1, num_gridcomp - - tp = gridcomp(icmp) - -! determine aerosol_file - aerosol_file = 'null' - if ( gocart_climo == 'ver3' ) then - if(tp == 'DU') fname='.DU.STD.tv20.g.avg' - if(tp == 'SS') fname='.SS.STD.tv17.g.avg' - if(tp == 'SU') fname='.SU.STD.tv15.g.avg' - if(tp == 'OC') fname='.CC.STD.tv15.g.avg' - if(tp == 'BC') fname='.CC.STD.tv15.g.avg' - aerosol_file=ymd//trim(fname) - elseif ( gocart_climo == 'ver4' ) then - fin = 'gocart_climo_2000x2007_' - if(tp == 'DU') fname=trim(fin)//'du_' - if(tp == 'SS') fname=trim(fin)//'ss_' - if(tp == 'SU') fname=trim(fin)//'su_' - if(tp == 'OC') fname=trim(fin)//'cc_' - if(tp == 'BC') fname=trim(fin)//'cc_' - aerosol_file=trim(fname)//mn//'.bin' - endif - - numspci = 4 - if(tp == 'DU') numspci = 5 - inquire (file=trim(aerosol_file), exist = file_exist) - lab_if_aer: if ( file_exist ) then + enddo ! end do_nb_block for lw + endif ! end if_lalwflg_block ! - close(NIAERCM) - if ( gocart_climo == 'ver3' ) then - nrecl = 4 * numspci * (IMXG * JMXG * KMXG + 3) - open (NIAERCM, file=trim(aerosol_file), & - & action='read',access='direct', recl=nrecl) - read(NIAERCM,rec=1)(nt1,nt2,nn(i),buff(:,:,:,i),i=1,numspci) - - elseif ( gocart_climo == 'ver4' ) then - open (NIAERCM, file=trim(aerosol_file), & - & action='read',status='old', form='unformatted') - do i = 1, numspci - do k = 1, KMXG - read(NIAERCM) temp(:,:,k) - buff(:,:,k,i) = temp(:,:,k) - enddo - enddo - endif - -!!===> fill dmclmg with working array buff - select case ( tp ) - -! fill in DU from DU: du1, du2, du3, du4, du5 - case ('DU' ) - if ( dm_indx%dust1 /= -999) then - do ii = 1, 5 - dmclmg(:,:,:,dm_indx%dust1+ii-1) = buff(:,:,:,ii) - enddo - else - print *, 'ERROR: invalid DU index, abort! ',me - stop 1007 - endif - -! fill in BC from CC: bc_phobic, oc_phobic, bc_philic, oc_philic - case ('BC' ) - if ( dm_indx%soot_phobic /= -999) then - dmclmg(:,:,:,dm_indx%soot_phobic)=buff(:,:,:,1) - dmclmg(:,:,:,dm_indx%soot_philic)=buff(:,:,:,3) - molwgt(dm_indx%soot_phobic) = 12. - molwgt(dm_indx%soot_philic) = 12. - else - print *, 'ERROR: invalid BC index, abort! ',me - stop 1008 - endif - -! fill in SU from SU: dms, so2, so4, msa - case ('SU' ) - if ( dm_indx%suso /= -999) then - dmclmg(:,:,:,dm_indx%suso) = buff(:,:,:,3) - molwgt(dm_indx%suso) = 96. - else - print *, 'ERROR: invalid SU index, abort! ',me - stop 1009 - endif - -! fill in OC from CC: bc_phobic, oc_phobic, bc_philic, oc_philic - case ('OC' ) - if ( dm_indx%waso_phobic /= -999) then - dmclmg(:,:,:,dm_indx%waso_phobic) = 1.4*buff(:,:,:,2) - dmclmg(:,:,:,dm_indx%waso_philic) = 1.4*buff(:,:,:,4) - molwgt(dm_indx%waso_phobic) = 12. - molwgt(dm_indx%waso_philic) = 12. - else - print *, 'ERROR: invalid OC index, abort! ',me - stop 1010 - endif - -! fill in SS from SS: ss1, ss2, ss3, ss4 - case ('SS' ) - if ( dm_indx%ssam /= -999) then - dmclmg(:,:,:,dm_indx%ssam) = buff(:,:,:,1) - dmclmg(:,:,:,dm_indx%sscm) = buff(:,:,:,2) + & - & buff(:,:,:,3)+buff(:,:,:,4) - else - print *, 'ERROR: invalid SS index, abort! ',me - stop 1011 - endif - - case default - - print *, 'ERROR: invalid aerosol species, abort ',tp - stop 1012 - - end select - - else lab_if_aer - print *,' *** Requested aerosol data file "',aerosol_file, & - & '" not found!' - print *,' *** Stopped in RD_GOCART_CLIM ! ', me - stop 1013 - endif lab_if_aer - - enddo lab_do_icmp - + return return !................................... - end subroutine rd_gocart_clim -! @} + end subroutine optavg_gocart !----------------------------------- -! + !................................... - end subroutine gocart_init + end subroutine gocart_aerinit !----------------------------------- !! @} -!>\ingroup module_radiation_aerosols -!> This subroutine computes SW + LW aerosol optical properties for -!! gocart aerosol species (merged from fcst and clim fields). -!! -!>\param alon IMAX, longitude of given points in degree -!!\param alat IMAX, latitude of given points in degree -!!\param prslk (IMAX,NLAY), pressure in cb -!!\param rhlay (IMAX,NLAY), layer mean relative humidity -!!\param dz (IMAX,NLAY), layer thickness in m -!!\param hz (IMAX,NLP1), level high in m -!!\param NSWLWBD total number of sw+ir bands for aeros opt prop -!!\param prsl (IMAX,NLAY), layer mean pressure in mb -!!\param tvly (IMAX,NLAY), layer mean virtual temperature in K -!!\param trcly (IMAX,NLAY,NTRAC), layer mean specific tracer in g/g -!!\param IMAX horizontal dimension of arrays -!!\param NLAY,NLP1 vertical dimensions of arrays -!!\param ivflip control flag for direction of vertical index -!!\n =0: index from toa to surface -!!\n =1: index from surface to toa -!!\param lsswr,lslwr logical flag for sw/lw radiation calls -!!\param aerosw (IMAX,NLAY,NBDSW,NF_AESW), aeros opt properties for SW -!!\n (:,:,:,1): optical depth -!!\n (:,:,:,2): single scattering albedo -!!\n (:,:,:,3): asymmetry parameter -!!\param aerolw (IMAX,NLAY,NBDLW,NF_AELW), aeros opt properties for LW -!!\n (:,:,:,1): optical depth -!!\n (:,:,:,2): single scattering albedo -!!\n (:,:,:,3): asymmetry parameter -!>\section gen_setgo setgocartaer General Algorithm -!!@{ +!> This subroutine compute aerosol optical properties for SW +!! and LW radiations. +!!\param prsi (IMAX,NLP1), pressure at interface in mb +!!\param prsl (IMAX,NLAY), layer mean pressure(not used) +!!\param prslk (IMAX,NLAY), exner function=\f$(p/p0)^{rocp}\f$ (not used) +!!\param tvly (IMAX,NLAY), layer virtual temperature (not used) +!!\param rhlay (IMAX,NLAY), layer mean relative humidity +!!\param dz (IMAX,NLAY), layer thickness in m +!!\param hz (IMAX,NLP1), level high in m +!!\param tracer (IMAX,NLAY,NTRAC), aer tracer concentrations +!!\param aerfld (IMAX,NLAY,NTRCAER), aer tracer concentrations +!!\param alon, alat (IMAX), longitude and latitude of given points in degree +!!\param slmsk (IMAX), sea/land mask (sea:0,land:1,sea-ice:2) +!!\param laersw,laerlw logical flag for sw/lw aerosol calculations +!!\param IMAX horizontal dimension of arrays +!!\param NLAY,NLP1 vertical dimensions of arrays +!!\param NSPC num of species for optional aod output fields +!!\param aerosw (IMAX,NLAY,NBDSW,NF_AESW), aeros opt properties for sw +!!\n (:,:,:,1): optical depth +!!\n (:,:,:,2): single scattering albedo +!!\n (:,:,:,3): asymmetry parameter +!!\param aerolw (IMAX,NLAY,NBDLW,NF_AELW), aeros opt properties for lw +!!\n (:,:,:,1): optical depth +!!\n (:,:,:,2): single scattering albedo +!!\n (:,:,:,3): asymmetry parameter +!!\param aerodp (IMAX,NSPC+1), vertically integrated aer-opt-depth +!!\section gel_go_aer_pro General Algorithm +!! @{ !----------------------------------- - subroutine setgocartaer & - & ( alon,alat,prslk,rhlay,dz,hz,NSWLWBD, & ! --- inputs: - & prsl,tvly,trcly, & - & IMAX,NLAY,NLP1, ivflip, lsswr,lslwr, & - & aerosw,aerolw & ! --- outputs: - & ) + subroutine aer_property_gocart & +!................................... +! --- inputs: + & ( prsi,prsl,prslk,tvly,rhlay,dz,hz,tracer,aerfld, & + & alon,alat,slmsk, laersw,laerlw, & + & imax,nlay,nlp1, & +! --- outputs: + & aerosw,aerolw,aerodp & + & ) ! ================================================================== ! ! ! -! setgocartaer computes sw + lw aerosol optical properties for gocart ! -! aerosol species (merged from fcst and clim fields) ! +! aer_property_gocart maps prescribed gocart aerosol data set onto ! +! model grids, and compute aerosol optical properties for sw and ! +! lw radiations. ! ! ! ! inputs: ! +! prsi - pressure at interface mb IMAX*NLP1 ! +! prsl - layer mean pressure (not used) IMAX*NLAY ! +! prslk - exner function=(p/p0)**rocp (not used) IMAX*NLAY ! +! tvly - layer virtual temperature (not used) IMAX*NLAY ! +! rhlay - layer mean relative humidity IMAX*NLAY ! +! dz - layer thickness m IMAX*NLAY ! +! hz - level high m IMAX*NLP1 ! +! tracer - aer tracer concentrations (not used) IMAX*NLAY*NTRAC! +! aerfld - prescribed aer tracer mixing ratios IMAX*NLAY*NTRCAER! ! alon, alat IMAX ! ! - longitude and latitude of given points in degree ! -! prslk - pressure cb IMAX*NLAY ! -! rhlay - layer mean relative humidity IMAX*NLAY ! -! dz - layer thickness m IMAX*NLAY ! -! hz - level high m IMAX*NLP1 ! -! NSWLWBD - total number of sw+ir bands for aeros opt prop 1 ! -! prsl - layer mean pressure mb IMAX*NLAY ! -! tvly - layer mean virtual temperature k IMAX*NLAY ! -! trcly - layer mean specific tracer g/g IMAX*NLAY*NTRAC! +! slmsk - sea/land mask (sea:0,land:1,sea-ice:2) IMAX ! +! laersw,laerlw 1 ! +! - logical flag for sw/lw aerosol calculations ! ! IMAX - horizontal dimension of arrays 1 ! ! NLAY,NLP1-vertical dimensions of arrays 1 ! -! ivflip - control flag for direction of vertical index 1 ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! lsswr,lslwr ! -! - logical flag for sw/lw radiation calls 1 ! ! ! ! outputs: ! ! aerosw - aeros opt properties for sw IMAX*NLAY*NBDSW*NF_AESW! @@ -5138,577 +4239,290 @@ subroutine setgocartaer & ! (:,:,:,1): optical depth ! ! (:,:,:,2): single scattering albedo ! ! (:,:,:,3): asymmetry parameter ! -! tau_gocart - 550nm aeros opt depth IMAX*NLAY*MAX_NUM_GRIDCOMP! +! aerodp - vertically integrated aer-opt-depth IMAX*NSPC+1 ! ! ! ! module parameters and constants: ! -! NBDSW - total number of sw bands for aeros opt prop 1 ! -! NLWBND - total number of ir bands for aeros opt prop 1 ! +! NSWBND - total number of actual sw spectral bands computed ! +! NLWBND - total number of actual lw spectral bands computed ! +! NSWLWBD - total number of sw+lw bands computed ! ! ! -! module variable: (set by subroutine gocart_init) ! -! dmclmg - aerosols dry mass/mixing ratios IMXG*JMXG*KMXG*NMXG ! -! psclmg - pressure cb IMXG*JMXG*KMXG ! +! external module variables: (in physparam) ! +! ivflip - control flag for direction of vertical index ! +! =0: index from toa to surface ! +! =1: index from surface to toa ! ! ! -! usage: call setgocartaer ! +! module variable: (set by subroutine aer_init) ! ! ! -! subprograms called: map_aermr, aeropt_grt ! +! usage: call aer_property_gocart ! ! ! ! ================================================================== ! -! - implicit none ! --- inputs: - integer, intent(in) :: IMAX,NLAY,NLP1,ivflip,NSWLWBD - logical, intent(in) :: lsswr, lslwr + integer, intent(in) :: IMAX, NLAY, NLP1 + logical, intent(in) :: laersw, laerlw - real (kind=kind_phys), dimension(:,:), intent(in) :: prslk, & - & prsl, rhlay, tvly, dz, hz - real (kind=kind_phys), dimension(:), intent(in) :: alon, alat - real (kind=kind_phys), dimension(:,:,:), intent(in) :: trcly + real (kind=kind_phys), dimension(:,:), intent(in) :: prsi, prsl, & + & prslk, tvly, rhlay, dz, hz + real (kind=kind_phys), dimension(:), intent(in) :: alon, alat, & + & slmsk + real (kind=kind_phys), dimension(:,:,:),intent(in):: tracer + real (kind=kind_phys), dimension(:,:,:),intent(in):: aerfld ! --- outputs: real (kind=kind_phys), dimension(:,:,:,:), intent(out) :: & & aerosw, aerolw + real (kind=kind_phys), dimension(:,:) , intent(out) :: aerodp ! --- locals: - real (kind=kind_phys), dimension(NLAY) :: rh1, dz1 - real (kind=kind_phys), dimension(NLAY,NSWLWBD)::tauae,ssaae,asyae - real (kind=kind_phys), dimension(NLAY,max_num_gridcomp) :: & - & tauae_gocart - - real (kind=kind_phys) :: tmp1, tmp2 - - integer :: i, i1, i2, j1, j2, k, m, m1, kp - -! prognostic aerosols on gfs grids - real (kind=kind_phys), dimension(:,:,:),allocatable:: aermr,dmfcs + real (kind=kind_phys), dimension(nlay,nswlwbd):: tauae,ssaae,asyae + real (kind=kind_phys), dimension(nspc) :: spcodp -! aerosol (dry mass) on gfs grids/levels - real (kind=kind_phys), dimension(:,:), allocatable :: & - & dmanl,dmclm, dmclmx - real (kind=kind_phys), dimension(KMXG) :: pstmp, pkstr - real (kind=kind_phys) :: ptop, psfc, tem, plv, tv, rho + real (kind=kind_phys),dimension(nlay,kcm) :: aerms + real (kind=kind_phys),dimension(nlay) :: dz1, rh1 + real (kind=kind_phys) :: plv, tv, rho + integer :: i, m, m1, k -! --- conversion constants - real (kind=kind_phys), parameter :: hdltx = 0.5 * dltx - real (kind=kind_phys), parameter :: hdlty = 0.5 * dlty - -!===> ... begin here -! - if ( .not. allocated(dmanl) ) then - allocate ( dmclmx(KMXG,NMXG) ) - allocate ( dmanl(NLAY,NMXG) ) - allocate ( dmclm(NLAY,NMXG) ) - - allocate ( aermr(IMAX,NLAY,NMXG) ) - allocate ( dmfcs(IMAX,NLAY,NMXG) ) - endif ! -!> -# Call map_aermr() to map input tracer array (trcly) to local -!! tracer array (aermr). - dmfcs(:,:,:) = f_zero - lab_if_fcst : if ( get_fcst ) then - - call map_aermr -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) - - endif lab_if_fcst +!===> ... begin here ! -!> -# Map geos-gocart climo (dmclmg) to gfs grids (dmclm). - lab_do_IMAX : do i = 1, IMAX - - dmclm(:,:) = f_zero - - lab_if_clim : if ( get_clim ) then -! --- map grid in longitude direction - i2 = 1 - j2 = 1 - tmp1 = alon(i) - if (tmp1 > 180.) tmp1 = tmp1 - 360.0 - lab_do_IMXG : do i1 = 1, IMXG - tmp2 = geos_rlon(i1) - if (tmp2 > 180.) tmp2 = tmp2 - 360.0 - if (abs(tmp1-tmp2) <= hdltx) then - i2 = i1 - exit lab_do_IMXG - endif - enddo lab_do_IMXG - -! --- map grid in latitude direction - lab_do_JMXG : do j1 = 1, JMXG - if (abs(alat(i)-geos_rlat(j1)) <= hdlty) then - j2 = j1 - exit lab_do_JMXG - endif - enddo lab_do_JMXG + lab_do_IMAXg : do i = 1, IMAX -! --- update local arrays pstmp and dmclmx - pstmp(:)= psclmg(i2,j2,:)*1000.0 ! cb to Pa - dmclmx(:,:) = dmclmg(i2,j2,:,:) - -! --- map geos-gocart climo (dmclmx) to gfs level (dmclm) - pkstr(:)=fpkap(pstmp(:)) - psfc = pkstr(1) ! pressure at sfc - ptop = pkstr(KMXG) ! pressure at toa - -! --- map grid in verical direction (follow how ozone is mapped -! in radiation_gases routine) +! --- initialize tauae, ssaae, asyae + do m = 1, NSWLWBD do k = 1, NLAY - kp = k ! from sfc to toa - if(ivflip==0) kp = NLAY - k + 1 ! from toa to sfc - tmp1 = prslk(i,kp) - - do m1 = 1, KMXG - 1 ! from sfc to toa - if(tmp1 > pkstr(m1+1) .and. tmp1 <= pkstr(m1)) then - tmp2 = f_one / (pkstr(m1)-pkstr(m1+1)) - tem = (pkstr(m1) - tmp1) * tmp2 - dmclm(kp,:) = tem * dmclmx(m1+1,:)+ & - & (f_one-tem) * dmclmx(m1,:) - endif - enddo - -!* if(tmp1 > psfc) dmclm(kp,:) = dmclmx(1,:) -!* if(tmp1 < ptop) dmclm(kp,:) = dmclmx(KMXG,:) - + tauae(k,m) = f_zero + ssaae(k,m) = f_one + asyae(k,m) = f_zero enddo - endif lab_if_clim -! -! --- compute fcst/clim merged aerosol loading (dmanl) and the -! radiation optical properties (aerosw, aerolw) -! - do k = 1, NLAY + enddo -! --- map global to local arrays (rh1 and dz1) - rh1(k) = rhlay(i,k) - dz1(k) = dz (i,k) +! --- set floor value for aerms (kg/m3) + do k = 1, NLAY + do m = 1, kcm + aerms(k,m) = 1.e-15 + enddo + enddo -! --- convert from mixing ratio to dry mass (g/m3) - plv = 100. * prsl(i,k) ! convert pressure from mb to Pa - tv = tvly(i,k) ! virtual temp in K - rho = plv / (con_rd * tv) ! air density in kg/m3 - if ( get_fcst ) then - do m = 1, NMXG ! mixing ratio (g/g) - dmfcs(i,k,m) = max(1000.*(rho*aermr(i,k,m)),f_zero) - enddo ! m_do_loop - endif - if ( get_clim .and. (gocart_climo == 'ver4') ) then - do m = 1, NMXG - dmclm(k,m)=1000.*dmclm(k,m)*rho !mixing ratio (g/g) - if ( molwgt(m) /= 0. ) then !mixing ratio (mol/mol) - dmclm(k,m)=dmclm(k,m) * (molwgt(m)/con_amd) - endif - enddo ! m_do_loop - endif + do m = 1, nspc + spcodp(m) = f_zero + enddo + do k = 1, NLAY + rh1(k) = rhlay(i,k) ! + dz1(k) = 1000.*dz (i,k) ! thickness converted from km to m + plv = 100.*prsl(i,k) ! convert pressure from mb to Pa + tv = tvly(i,k) ! virtual temp in K + rho = plv / ( con_rd * tv) ! air density in kg/m3 -! --- determine dmanl from dmclm and dmfcs - do m = 1, NMXG - dmanl(k,m)= ctaer*dmfcs(i,k,m) + & - & ( f_one-ctaer)*dmclm(k,m) + do m = 1, KCM + aerms(k,m) = aerfld(i,k,m)*rho ! dry mass (kg/m3) enddo - enddo +! +! --- calculate sw/lw aerosol optical properties for the +! corresponding frequency bands -!> -# Call aeropt_grt() to alculate sw/lw aerosol optical properties -!! for the corresponding frequency bands. + call aeropt +! --- inputs: (in-scope variables) +! --- outputs: (in-scope variables) - call aeropt_grt -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + enddo ! end_do_k_loop - if ( lsswr ) then +! ---------------------------------------------------------------------- - if ( laswflg ) then +! --- update aerosw and aerolw arrays + if ( laersw ) then - do m = 1, NBDSW - do k = 1, NLAY - aerosw(i,k,m,1) = tauae(k,m) - aerosw(i,k,m,2) = ssaae(k,m) - aerosw(i,k,m,3) = asyae(k,m) - enddo + do m = 1, NBDSW + do k = 1, NLAY + aerosw(i,k,m,1) = tauae(k,m) + aerosw(i,k,m,2) = ssaae(k,m) + aerosw(i,k,m,3) = asyae(k,m) enddo + enddo - else - - aerosw(:,:,:,:) = f_zero - - endif +! --- update diagnostic aod arrays + do k = 1, NLAY + aerodp(i,1) = aerodp(i,1) + tauae(k,nv_aod) + enddo - endif ! end if_lsswr_block + do m = 1, NSPC + aerodp(i,m+1) = spcodp(m) + enddo - if ( lslwr ) then + endif ! end if_larsw_block - if ( lalwflg ) then + if ( laerlw ) then - if ( NLWBND == 1 ) then - m1 = NBDSW + 1 - do m = 1, NBDLW - do k = 1, NLAY - aerolw(i,k,m,1) = tauae(k,m1) - aerolw(i,k,m,2) = ssaae(k,m1) - aerolw(i,k,m,3) = asyae(k,m1) - enddo - enddo - else - do m = 1, NBDLW - m1 = NBDSW + m - do k = 1, NLAY - aerolw(i,k,m,1) = tauae(k,m1) - aerolw(i,k,m,2) = ssaae(k,m1) - aerolw(i,k,m,3) = asyae(k,m1) - enddo + if ( NLWBND == 1 ) then + m1 = NSWBND + 1 + do m = 1, NBDLW + do k = 1, NLAY + aerolw(i,k,m,1) = tauae(k,m1) + aerolw(i,k,m,2) = ssaae(k,m1) + aerolw(i,k,m,3) = asyae(k,m1) enddo - endif - + enddo else - - aerolw(:,:,:,:) = f_zero - + do m = 1, NBDLW + m1 = NSWBND + m + do k = 1, NLAY + aerolw(i,k,m,1) = tauae(k,m1) + aerolw(i,k,m,2) = ssaae(k,m1) + aerolw(i,k,m,3) = asyae(k,m1) + enddo + enddo endif - endif ! end if_lslwr_block - enddo lab_do_IMAX + endif ! end if_laerlw_block + + enddo lab_do_IMAXg ! ================= contains ! ================= -!>\ingroup module_radiation_aerosols -!> This subroutine maps input tracer fields (trcly) to local tracer -!! array (aermr). -!>\section map_aermr_gen map_aermr General Algorithm -!! @{ -!----------------------------- - subroutine map_aermr -!............................. -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) - -! ==================================================================== ! -! ! -! subprogram: map_aermr ! -! ! -! map input tracer fields (trcly) to local tracer array (aermr) ! -! ! -! ==================== defination of variables =================== ! -! ! -! input arguments: ! -! IMAX - horizontal dimension of arrays 1 ! -! NLAY - vertical dimensions of arrays 1 ! -! trcly - layer tracer mass mixing ratio g/g IMAX*NLAY*NTRAC! -! output arguments: (to module variables) ! -! aermr - layer aerosol mass mixing ratio g/g IMAX*NLAY*NMXG ! -! ! -! note: ! -! NTRAC is the number of tracers excluding water vapor ! -! NMXG is the number of prognostic aerosol species ! -! ================================================================== ! -! - implicit none - -! --- inputs: -! --- output: - -! --- local: - integer :: i, indx, ii - character :: tp*2 - -! initialize - aermr(:,:,:) = f_zero - ii = 1 !! <---- trcly does not contain q - -! ==> DU: du1 (submicron bins), du2, du3, du4, du5 - if( gfs_phy_tracer%doing_DU ) then - aermr(:,:,dm_indx%dust1) = trcly(:,:,dmfcs_indx%du001-ii) - aermr(:,:,dm_indx%dust2) = trcly(:,:,dmfcs_indx%du002-ii) - aermr(:,:,dm_indx%dust3) = trcly(:,:,dmfcs_indx%du003-ii) - aermr(:,:,dm_indx%dust4) = trcly(:,:,dmfcs_indx%du004-ii) - aermr(:,:,dm_indx%dust5) = trcly(:,:,dmfcs_indx%du005-ii) - endif - -! ==> OC: oc_phobic, oc_philic - if( gfs_phy_tracer%doing_OC ) then - aermr(:,:,dm_indx%waso_phobic) = & - & trcly(:,:,dmfcs_indx%ocphobic-ii) - aermr(:,:,dm_indx%waso_philic) = & - & trcly(:,:,dmfcs_indx%ocphilic-ii) - endif - -! ==> BC: bc_phobic, bc_philic - if( gfs_phy_tracer%doing_BC ) then - aermr(:,:,dm_indx%soot_phobic) = & - & trcly(:,:,dmfcs_indx%bcphobic-ii) - aermr(:,:,dm_indx%soot_philic) = & - & trcly(:,:,dmfcs_indx%bcphilic-ii) - endif - -! ==> SS: ss1, ss2 (submicron bins), ss3, ss4, ss5 - if( gfs_phy_tracer%doing_SS ) then - aermr(:,:,dm_indx%ssam) = trcly(:,:,dmfcs_indx%ss001-ii) & - & + trcly(:,:,dmfcs_indx%ss002-ii) - aermr(:,:,dm_indx%sscm) = trcly(:,:,dmfcs_indx%ss003-ii) & - & + trcly(:,:,dmfcs_indx%ss004-ii) & - & + trcly(:,:,dmfcs_indx%ss005-ii) - endif - -! ==> SU: so4 - if( gfs_phy_tracer%doing_SU ) then - aermr(:,:,dm_indx%suso) = trcly(:,:,dmfcs_indx%so4-ii) - endif - - return -!................................... - end subroutine map_aermr -!! @} -!----------------------------------- - +!-------------------------------- + subroutine aeropt +!................................ -!>\ingroup module_radiation_aerosols -!! This subroutine computes aerosols optical properties in NSWLWBD -!! SW/LW bands. Aerosol distribution at each grid point is composed -!! from up to NMXG aerosol species (from NUM_GRIDCOMP components). -!>\section aeropt_grt_gen aeropt_grt General Algorithm -!! @{ -!----------------------------------- - subroutine aeropt_grt -!................................... ! --- inputs: (in scope variables) ! --- outputs: (in scope variables) ! ================================================================== ! ! ! -! subprogram: aeropt_grt ! -! ! -! compute aerosols optical properties in NSWLWBD sw/lw bands. ! -! Aerosol distribution at each grid point is composed from up to ! -! NMXG aerosol species (from NUM_GRIDCOMP components). ! +! compute aerosols optical properties in NSWLWBD bands for gocart ! +! aerosol species ! ! ! ! input variables: ! -! dmanl - aerosol dry mass g/m3 NLAY*NMXG ! ! rh1 - relative humidity % NLAY ! -! dz1 - layer thickness km NLAY ! +! dz1 - layer thickness m NLAY ! +! aerms - aerosol mass concentration kg/m3 NLAY*KCM ! ! NLAY - vertical dimensions - 1 ! -! ivflip - control flag for direction of vertical index ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! ! ! ! output variables: ! -! tauae - aerosol optical depth - NLAY*NSWLWBD ! -! ssaae - aerosol single scattering albedo - NLAY*NSWLWBD ! -! asyae - aerosol asymmetry parameter - NLAY*NSWLWBD ! +! tauae - optical depth - NLAY*NSWLWBD! +! ssaae - single scattering albedo - NLAY*NSWLWBD! +! asyae - asymmetry parameter - NLAY*NSWLWBD! +! aerodp - vertically integrated aer-opt-depth - IMAX*NSPC+1 ! ! ! ! ================================================================== ! -! - implicit none ! --- inputs: ! --- outputs: ! --- locals: - real (kind=kind_phys) :: aerdm - real (kind=kind_phys) :: ext1, ssa1, asy1, ex00, ss00, as00, & - & ex01, ss01, as01, exint - real (kind=kind_phys) :: tau, ssa, asy, & - & sum_tau, sum_ssa, sum_asy - -! --- subgroups for sub-micron dust -! --- corresponds to 0.1-0.18, 0.18-0.3, 0.3-0.6, 0.6-1.0 micron - - real (kind=kind_phys) :: fd(4) - data fd / 0.01053,0.08421,0.25263,0.65263 / - - character :: tp*2 - integer :: icmp, n, kk, ib, ih2, ih1, ii, ij, ijk real (kind=kind_phys) :: drh0, drh1, rdrh - - real (kind=kind_phys) :: qmin !<--lower bound for opt calc - data qmin / 1.e-20 / - -!===> ... begin here - -! --- initialize (assume no aerosols) - tauae = f_zero - ssaae = f_one - asyae = f_zero - - tauae_gocart = f_zero - -!===> ... loop over vertical layers -! - lab_do_layer : do kk = 1, NLAY + real (kind=kind_phys) :: cm, ext01, sca01, asy01, ssa01 + real (kind=kind_phys) :: ext1, asy1, ssa1, sca1 + real (kind=kind_phys) :: sum_tau,sum_asy,sum_ssa,tau,asy,ssa + integer :: ih1, ih2, nbin, ib, ntrc, ktrc ! --- linear interp coeffs for rh-dep species - ih2 = 1 - do while ( rh1(kk) > rhlev_grt(ih2) ) + do while ( rh1(k) > rhlev_grt(ih2) ) ih2 = ih2 + 1 - if ( ih2 > KRHLEV ) exit + if ( ih2 > krhlev ) exit enddo ih1 = max( 1, ih2-1 ) - ih2 = min( KRHLEV, ih2 ) + ih2 = min( krhlev, ih2 ) drh0 = rhlev_grt(ih2) - rhlev_grt(ih1) - drh1 = rh1(kk) - rhlev_grt(ih1) + drh1 = rh1(k) - rhlev_grt(ih1) if ( ih1 == ih2 ) then - rdrh = f_zero + rdrh = f_zero else - rdrh = drh1 / drh0 + rdrh = drh1 / drh0 endif -! --- loop through sw/lw spectral bands - - lab_do_ib : do ib = 1, NSWLWBD - sum_tau = f_zero - sum_ssa = f_zero - sum_asy = f_zero +! --- compute optical properties for each spectral bands + do ib = 1, nswlwbd + + sum_tau = f_zero + sum_ssa = f_zero + sum_asy = f_zero + +! --- determine tau, ssa, asy for dust aerosols + ext1 = f_zero + asy1 = f_zero + sca1 = f_zero + ssa1 = f_zero + do m = 1, kcm1 + cm = max(aerms(k,m),0.0) * dz1(k) + ext1 = ext1 + cm*extrhi_grt(m,ib) + sca1 = sca1 + cm*scarhi_grt(m,ib) + ssa1 = ssa1 + cm*extrhi_grt(m,ib) * ssarhi_grt(m,ib) + asy1 = asy1 + cm*scarhi_grt(m,ib) * asyrhi_grt(m,ib) + enddo ! m-loop + tau = ext1 + if (ext1 > f_zero) ssa=min(f_one, ssa1/ext1) + if (sca1 > f_zero) asy=min(f_one, asy1/sca1) + +! --- update aod from individual species + if ( ib==nv_aod ) then + spcodp(1) = spcodp(1) + tau + endif +! --- update sum_tau, sum_ssa, sum_asy + sum_tau = sum_tau + tau + sum_ssa = sum_ssa + tau * ssa + sum_asy = sum_asy + tau * ssa * asy -! --- loop through aerosol grid components - lab_do_icmp : do icmp = 1, NUM_GRIDCOMP +! --- determine tau, ssa, asy for non-dust aerosols + do ntrc = 2, nspc ext1 = f_zero - ssa1 = f_zero asy1 = f_zero - - tp = gridcomp(icmp) - - select case ( tp ) - -! -- dust aerosols: no humidification effect - case ( 'DU') - do n = 1, KCM1 - - if (n <= 4) then - aerdm = dmanl(kk,dm_indx%dust1) * fd(n) - else - aerdm = dmanl(kk,dm_indx%dust1+n-4 ) - endif - - if (aerdm < qmin) aerdm = f_zero - ex00 = extrhi_grt(n,ib)*(1000.*dz1(kk))*aerdm - ss00 = ssarhi_grt(n,ib) - as00 = asyrhi_grt(n,ib) - ext1 = ext1 + ex00 - ssa1 = ssa1 + ex00 * ss00 - asy1 = asy1 + ex00 * ss00 * as00 - - enddo - -! -- suso aerosols: with humidification effect - case ( 'SU') - ij = isuso - exint = extrhd_grt(ih1,ij,ib) & - & + rdrh*(extrhd_grt(ih2,ij,ib) - extrhd_grt(ih1,ij,ib)) - ss00 = ssarhd_grt(ih1,ij,ib) & - & + rdrh*(ssarhd_grt(ih2,ij,ib) - ssarhd_grt(ih1,ij,ib)) - as00 = asyrhd_grt(ih1,ij,ib) & - & + rdrh*(asyrhd_grt(ih2,ij,ib) - asyrhd_grt(ih1,ij,ib)) - - aerdm = dmanl(kk, dm_indx%suso) - if (aerdm < qmin) aerdm = f_zero - ex00 = exint*(1000.*dz1(kk))*aerdm - ext1 = ex00 - ssa1 = ex00 * ss00 - asy1 = ex00 * ss00 * as00 - -! -- seasalt aerosols: with humidification effect - case ( 'SS') - do n = 1, 2 !<---- ssam, sscm - ij = issam + (n-1) - exint = extrhd_grt(ih1,ij,ib) & - & + rdrh*(extrhd_grt(ih2,ij,ib) - extrhd_grt(ih1,ij,ib)) - ss00 = ssarhd_grt(ih1,ij,ib) & - & + rdrh*(ssarhd_grt(ih2,ij,ib) - ssarhd_grt(ih1,ij,ib)) - as00 = asyrhd_grt(ih1,ij,ib) & - & + rdrh*(asyrhd_grt(ih2,ij,ib) - asyrhd_grt(ih1,ij,ib)) - - aerdm = dmanl(kk, dm_indx%ssam+n-1) - if (aerdm < qmin) aerdm = f_zero - ex00 = exint*(1000.*dz1(kk))*aerdm - ext1 = ext1 + ex00 - ssa1 = ssa1 + ex00 * ss00 - asy1 = asy1 + ex00 * ss00 * as00 - - enddo - -! -- organic carbon/black carbon: -! using 'waso' and 'soot' for hydrophilic OC and BC -! using 'waso' and 'soot' at RH=0 for hydrophobic OC and BC - case ( 'OC', 'BC') - if(tp == 'OC') then - ii = dm_indx%waso_phobic - ij = iwaso - else - ii = dm_indx%soot_phobic - ij = isoot - endif - -! --- hydrophobic - aerdm = dmanl(kk, ii) - if (aerdm < qmin) aerdm = f_zero - ex00 = extrhd_grt(1,ij,ib)*(1000.*dz1(kk))*aerdm - ss00 = ssarhd_grt(1,ij,ib) - as00 = asyrhd_grt(1,ij,ib) -! --- hydrophilic - aerdm = dmanl(kk, ii+1) - if (aerdm < qmin) aerdm = f_zero - exint = extrhd_grt(ih1,ij,ib) & - & + rdrh*(extrhd_grt(ih2,ij,ib) - extrhd_grt(ih1,ij,ib)) - ex01 = exint*(1000.*dz1(kk))*aerdm - ss01 = ssarhd_grt(ih1,ij,ib) & - & + rdrh*(ssarhd_grt(ih2,ij,ib) - ssarhd_grt(ih1,ij,ib)) - as01 = asyrhd_grt(ih1,ij,ib) & - & + rdrh*(asyrhd_grt(ih2,ij,ib) - asyrhd_grt(ih1,ij,ib)) - - ext1 = ex00 + ex01 - ssa1 = (ex00 * ss00) + (ex01 * ss01) - asy1 = (ex00 * ss00 * as00) + (ex01 * ss01 * as01) - - end select - -! --- determine tau, ssa, asy for each grid component + sca1 = f_zero + ssa1 = f_zero + ktrc = trc_to_aod(ntrc) + do nbin = 1, num_radius(ntrc) + m1 = radius_lower(ntrc) + nbin - 1 + m = m1 - num_radius(1) ! exclude dust aerosols + cm = max(aerms(k,m1),0.0) * dz1(k) + ext01 = extrhd_grt(ih1,m,ib) + & + & rdrh * (extrhd_grt(ih2,m,ib)-extrhd_grt(ih1,m,ib)) + sca01 = scarhd_grt(ih1,m,ib) + & + & rdrh * (scarhd_grt(ih2,m,ib)-scarhd_grt(ih1,m,ib)) + ssa01 = ssarhd_grt(ih1,m,ib) + & + & rdrh * (ssarhd_grt(ih2,m,ib)-ssarhd_grt(ih1,m,ib)) + asy01 = asyrhd_grt(ih1,m,ib) + & + & rdrh * (asyrhd_grt(ih2,m,ib)-asyrhd_grt(ih1,m,ib)) + ext1 = ext1 + cm*ext01 + sca1 = sca1 + cm*sca01 + ssa1 = ssa1 + cm*ext01 * ssa01 + asy1 = asy1 + cm*sca01 * asy01 + enddo ! end_do_nbin_loop tau = ext1 - if (ext1 > f_zero) ssa=min(f_one,ssa1/ext1) - if (ssa1 > f_zero) asy=min(f_one,asy1/ssa1) - -! --- save tau at 550 nm for each grid component - if ( ib == nv_aod ) then - do ijk = 1, max_num_gridcomp - if ( tp == max_gridcomp(ijk) ) then - tauae_gocart(kk,ijk) = tau - endif - enddo + if (ext1 > f_zero) ssa=min(f_one, ssa1/ext1) + if (sca1 > f_zero) asy=min(f_one, asy1/sca1) +! --- update aod from individual species + if ( ib==nv_aod ) then + spcodp(ktrc) = spcodp(ktrc) + tau endif - ! --- update sum_tau, sum_ssa, sum_asy sum_tau = sum_tau + tau sum_ssa = sum_ssa + tau * ssa sum_asy = sum_asy + tau * ssa * asy - - enddo lab_do_icmp - + enddo ! end_do_ntrc_loop ! --- determine total tau, ssa, asy for aerosol mixture - tauae(kk,ib) = sum_tau - if (sum_tau > f_zero) ssaae(kk,ib) = sum_ssa / sum_tau - if (sum_ssa > f_zero) asyae(kk,ib) = sum_asy / sum_ssa - - enddo lab_do_ib - - enddo lab_do_layer + tauae(k,ib) = sum_tau + if (sum_tau > f_zero) ssaae(k,ib) = sum_ssa / sum_tau + if (sum_ssa > f_zero) asyae(k,ib) = sum_asy / sum_ssa + enddo ! end_do_ib_loop ! return -!................................... - end subroutine aeropt_grt -!! @} -!-------------------------------- - !................................ - end subroutine setgocartaer + end subroutine aeropt !-------------------------------- + +!................................... + end subroutine aer_property_gocart +!----------------------------------- !! @} ! -! GOCART code modification end here (Sarah Lu) ------------------------! ! ======================================================================= !..........................................! end module module_radiation_aerosols ! !==========================================! +!> @} From ed16475af3e9710368b388614cf0c26d4830d24f Mon Sep 17 00:00:00 2001 From: "Chunxi.Zhang-NOAA" Date: Wed, 22 Jan 2020 16:42:07 +0000 Subject: [PATCH 023/141] 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 024/141] 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 025/141] 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 11821ddcbe34ff4ed53950f14348911914a56c7e Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 27 Jan 2020 15:11:24 +0000 Subject: [PATCH 026/141] fixed too much high level cloud for iccn==2 --- physics/m_micro.F90 | 24 +++++++++++++----------- physics/micro_mg3_0.F90 | 2 ++ 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 7ac887a3b..7df85fbc8 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -973,17 +973,19 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! if(temp(i,k) > T_ICE_ALL) SC_ICE(i,k) = 1.0 ! if(temp(i,k) > TICE) SC_ICE(i,k) = rhc(i,k) ! - if(temp(i,k) < T_ICE_ALL) then -! SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) - SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) - elseif(temp(i,k) > TICE) then - SC_ICE(i,k) = rhc(i,k) - else -! SC_ICE(i,k) = 1.0 -! tx1 = max(SC_ICE(I,k), 1.2) - tx1 = max(SC_ICE(I,k), 1.5) - SC_ICE(i,k) = ((tice-temp(i,k))*tx1 + (temp(i,k)-t_ice_all)*rhc(i,k)) & - * t_ice_denom + if(iccn == 0) then + if(temp(i,k) < T_ICE_ALL) then +! SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) + SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) + elseif(temp(i,k) > TICE) then + SC_ICE(i,k) = rhc(i,k) + else +! SC_ICE(i,k) = 1.0 +! tx1 = max(SC_ICE(I,k), 1.2) + tx1 = max(SC_ICE(I,k), 1.5) + SC_ICE(i,k) = ((tice-temp(i,k))*tx1 + (temp(i,k)-t_ice_all)*rhc(i,k)) & + * t_ice_denom + endif endif if (iccn .ne. 1) then CDNC_NUC(I,k) = npccninr8(k) diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 215d3516b..31ff83cc4 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -1506,6 +1506,8 @@ subroutine micro_mg_tend ( & do i=1,mgncol if (t(i,k) < icenuct) then ncai(i,k) = naai(i,k)*rho(i,k) + ncai(i,k) = min(ncai(i,k), 710.0e3_r8) + naai(i,k) = ncai(i,k)*rhoinv(i,k) else naai(i,k) = zero ncai(i,k) = zero From 4c7dcaa8ae1e5465c5358647e75c239c6dafb30c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 27 Jan 2020 10:08:39 -0700 Subject: [PATCH 027/141] 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 028/141] 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 029/141] 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 030/141] 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 031/141] 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 032/141] 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 6466b9105bdad7830467c5035c31b16205d7f795 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Thu, 13 Feb 2020 12:44:52 -0500 Subject: [PATCH 033/141] changed ntrcaer in rad_aero to ntrcaerm --- physics/radiation_aerosols.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index 339b991f0..45a909ca8 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -169,7 +169,7 @@ module module_radiation_aerosols ! use module_radlw_parameters, only : NBDLW, wvnlw1, wvnlw2 ! use funcphys, only : fpkap - use aerclm_def, only : ntrcaer + use aerclm_def, only : ntrcaerm ! implicit none @@ -3499,7 +3499,7 @@ subroutine gocart_aerinit & ! --- ... invoke gocart aerosol initialization - if (KCM /= ntrcaer ) then + if (KCM /= ntrcaerm ) then print *, 'ERROR in # of gocart aer species',KCM stop 3000 endif From f562f446ed6c7bbc567c02df4c18fd98b1eb35b2 Mon Sep 17 00:00:00 2001 From: "Shan.Sun" Date: Fri, 14 Feb 2020 16:15:25 +0000 Subject: [PATCH 034/141] 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 035/141] 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 036/141] 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 037/141] 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 038/141] 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 039/141] 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 040/141] 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 041/141] 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 042/141] 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 043/141] 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 044/141] 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 045/141] 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 046/141] 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 047/141] 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 048/141] Further bugfixes for levr Date: Tue, 17 Mar 2020 15:39:06 -0600 Subject: [PATCH 049/141] Squashed commit of the following: commit 107b22d297a203dbf24e7f161b24d5a180ff9f3b Merge: 43e0e38 73f9f09 Author: Dustin Swales Date: Thu Mar 5 21:07:31 2020 +0000 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev2 commit 43e0e38d9553742aa681e34213cc2cdfbd3bca4e Author: Dustin Swales Date: Thu Feb 27 15:49:56 2020 -0700 Try adding many mpi_barrier commands commit 36de8f56671b03217d14853745219ef611732384 Author: Dustin Swales Date: Thu Feb 27 13:55:27 2020 -0700 Added mpi_bast commands back in commit 75fdb61479ae836bb81795438436a6a58f9fbd6f Author: Dustin Swales Date: Wed Feb 19 15:16:15 2020 -0700 Reverted some changes commit 93ae6cba0133ca8b990ff8314aa40e70f708ac55 Author: Dustin Swales Date: Wed Feb 19 14:59:09 2020 -0700 Removed deprecated files. commit 0e954b799ca362b748093b2a601a2c090ca98269 Author: Dustin Swales Date: Wed Feb 19 14:57:25 2020 -0700 Removed my login credential from .gitmodules. commit 244d3efadedf9aee74787ea4374069c96ddb43e5 Author: Dustin Swales Date: Wed Feb 19 14:54:07 2020 -0700 Reverted some changes. commit e201f0846c163420136ff90114a53079dda1d00f Author: Dustin Swales Date: Wed Feb 19 10:25:45 2020 -0700 Cleaned up rrtmgp_lw_pre.F90 commit 1d92cfaff0dba748ad8005dcd4c579111035a2e9 Author: Dustin Swales Date: Tue Feb 18 15:54:04 2020 -0700 Reverted changes to GFS_rrtmgp_sw_pre.F90 commit b57ebfd04e71bd5edcfe2b5cccda4f28b8f0d6eb Author: Dustin Swales Date: Tue Feb 18 14:49:30 2020 -0700 Revert earleir change. commit ab6c12eb92075fbaa7bb0babee68b1326385ed23 Author: Dustin Swales Date: Tue Feb 18 14:23:43 2020 -0700 Switch back hprime to hprime(:,1) commit 12acbb019ce7b9e40e1fd70e6a738e994024e74f Merge: c5ba6f9 6d55230 Author: Dustin Swales Date: Tue Feb 18 14:05:21 2020 -0700 Merge branch 'rrtmgp-dev2' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev2-no-mpi_bcast commit 6d552308db8258e843f56ff33339b57c2a94efab Author: Dustin Swales Date: Tue Feb 18 14:04:49 2020 -0700 Chnaged intent of lw_cloud_optical_props commit a3cd7db3a278d2ab0ad787a608ad3d4cc73e5c76 Author: Dustin Swales Date: Tue Feb 18 13:32:51 2020 -0700 Remove using gas switches. commit c5ba6f942f01088f8b2a9d822b7b2163563bd558 Author: Dustin Swales Date: Tue Feb 18 13:31:15 2020 -0700 Remove using gas switches. commit c47706ba033e72f20c97d482e91a80856367f587 Author: Dustin Swales Date: Tue Feb 18 12:25:32 2020 -0700 changed variable name. commit 723f74014151b9a7d8b5d34fd67e9ddb3e19d0db Merge: 596229b c1bf1ae Author: Dustin Swales Date: Tue Feb 18 11:58:18 2020 -0700 Merge branch 'rrtmgp-dev2' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev2-no-mpi_bcast commit c1bf1ae02bde5a0462dc0b5614f8acb1d88fefaf Author: Dustin Swales Date: Tue Feb 18 11:57:44 2020 -0700 Try using 1D hprime commit 596229bac3c1b0c71aef0a4f8a2afd9c16a96436 Merge: 9c682fc c984e90 Author: Dustin Swales Date: Fri Feb 14 16:56:36 2020 -0700 Merge branch 'rrtmgp-dev2' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev2-no-mpi_bcast commit c984e907306502fa109d514b64031102102ae512 Author: Dustin Swales Date: Fri Feb 14 16:54:38 2020 -0700 Cleaned up a tad. commit 9c682fc7ee703eb9e801bd264899f72cdde1bd01 Merge: c2eb222 54a38d9 Author: Dustin Swales Date: Wed Feb 12 10:45:23 2020 -0700 Merge branch 'rrtmgp-dev2' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev2-no-mpi_bcast commit 54a38d99cc46599bac0df04478865c1a287b48b2 Author: Dustin Swales Date: Wed Feb 12 10:43:24 2020 -0700 Removed cloud-fraction rounding. Was using for debugging purposes. commit b1e111fc0fe4ecb7c854dd538ae36f15c67af44a Author: Dustin Swales Date: Wed Feb 12 10:39:01 2020 -0700 Reverted recent change. commit 6473891e32fa5aca404c61e1fec6ca9d4744bb52 Author: Dustin Swales Date: Wed Feb 12 09:48:51 2020 -0700 Reverted some local changes. commit 8d42056e8e14713d8b76412138568538f6aacd9e Merge: 75c479d 01ed01f Author: Dustin Swales Date: Wed Feb 12 09:29:47 2020 -0700 Merge branch 'master' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev2 commit c2eb222ed073ae53c24d15d71a92ef12dde41fc8 Merge: 3aa8cd4 75c479d Author: Dustin Swales Date: Tue Feb 11 15:16:01 2020 -0700 Merge branch 'rrtmgp-dev2' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev2-no-mpi_bcast Conflicts: physics/rrtmgp_lw_cloud_optics.F90 physics/rrtmgp_sw_cloud_optics.F90 commit 75c479d4f3c8e99649ed8ab8e8d83892eaf72592 Author: Dustin Swales Date: Tue Feb 11 15:13:34 2020 -0700 Updated interface to rte-rrtmgp routines. commit 30b523724d8339de8c4ef2a98e778e0c878b494e Author: Dustin Swales Date: Tue Feb 11 11:09:46 2020 -0700 Updated submodule commit 3aa8cd4f38897c95f2fef5bff1fbc930ce0bba41 Author: Dustin Swales Date: Tue Feb 11 11:08:25 2020 -0700 Updated submodule commit c1cec1142babd2d549858346df9fccd7ff13320e Author: Dustin Swales Date: Tue Feb 11 10:57:40 2020 -0700 Switched to rte-rrtmgp dtc/branch. commit 3491dcdf52b32dd066a2d17bf145630a26bdf994 Author: Dustin Swales Date: Tue Feb 11 10:55:46 2020 -0700 Switched to rte-rrtmgp dtc/branch. commit b67bc2db8adb1e7252d0c2b3ad14ef5bc242b790 Author: Dustin Swales Date: Mon Feb 10 16:34:52 2020 -0700 Removed mpi calls during initialization. Reading data ona ll processors. Started from 3dfb4c9b21a9ac44e304ef8a593d1fa88846d49a commit 3dfb4c9b21a9ac44e304ef8a593d1fa88846d49a Author: Dustin Swales Date: Mon Feb 10 16:27:32 2020 -0700 Cleaned up _init routines. commit d3517899d5f0684c2c15f039c439cb5a31b4657e Author: Dustin Swales Date: Thu Jan 30 15:47:43 2020 -0700 Move allocation statement into master processor only. commit e7c6c8ec9b84b9b773463333f711f867cfe22c27 Author: Dustin Swales Date: Thu Jan 30 15:24:37 2020 -0700 Try different broadcast call for character arrays. commit be43ed8319d25de7f9146bfde679a7c32250df8c Author: Dustin Swales Date: Thu Jan 30 14:46:01 2020 -0700 Added a second mpi barrier. commit 33158c7f80cec30c72d6cc169ce39550500de278 Author: Dustin Swales Date: Thu Jan 30 14:09:54 2020 -0700 Added mpi barrier. communicator working, i think. commit 3e79d0279453ef0c007461c13dfe7cc8690c6379 Author: Dustin Swales Date: Thu Jan 30 13:27:36 2020 -0700 Move allocation statements. commit 09b3c3b78a6f492934f91b504366a8167d5df44a Author: Dustin Swales Date: Tue Jan 28 14:09:37 2020 -0700 Added print statements to Thompson init routines. commit ab612f4b312c830de0b5abdc9d63d49b2f9f3f8d Author: Dustin Swales Date: Tue Jan 28 12:44:25 2020 -0700 More diagnostic print statements. commit af24b718d61526ce5a3836d835a9b953ed979d89 Author: Dustin Swales Date: Tue Jan 28 12:03:10 2020 -0700 Added some diagnostic print statements. Remvoe barrier commands. commit e40e0f500db5e63cd458acb9333c72a98f7645ad Author: Dustin Swales Date: Tue Jan 28 11:40:53 2020 -0700 Added some diagnostic print statements. commit d42469b35632eed39692f1132c874dab6468ab1e Author: Dustin Swales Date: Tue Jan 28 11:12:32 2020 -0700 Change data type to double-precision. commit 28269a94fcb85ebbfc1c9678b7b93c69642a4ed8 Author: Dustin Swales Date: Tue Jan 28 10:35:04 2020 -0700 Modification to LW gas optics init(). One more time. commit c5ce144525abb51605c204b125db1496c5ef983d Author: Dustin Swales Date: Tue Jan 28 10:05:25 2020 -0700 Modification to LW gas optics init(). Add mpi_barrier commit f6c4e82fea3adb58eb843b3fa502f44a7734e19c Author: Dustin Swales Date: Tue Jan 28 09:33:50 2020 -0700 Modification to LW gas optics init(). commit f38ef59b00f4b18504bbf9ef68542d1074027cff Author: Dustin Swales Date: Mon Jan 27 16:26:39 2020 -0700 Some changes to MPI calls in inti() routines. commit bb03ad3fed2fb904d517d8f13f8d9989f8dab879 Author: Dustin Swales Date: Mon Jan 27 15:47:19 2020 -0700 Omission from previous commit. commit 28243f13ba5d9766a0b2c01d2de08de47502bbb3 Author: Dustin Swales Date: Mon Jan 27 15:25:20 2020 -0700 Remove bcast condition on precision. commit 01725b47395eff38951691d621ea49ec825f21b8 Author: Dustin Swales Date: Mon Jan 27 14:48:48 2020 -0700 Omission from previous commit. commit c0aab421b1c50f0d9de5a05c2653977b732d38d1 Author: Dustin Swales Date: Mon Jan 27 14:18:20 2020 -0700 Some changes to MPI calls in inti() routines. New grouping. commit fbb009f595f3a686523ed19af6daae868b9c9322 Author: Dustin Swales Date: Mon Jan 27 12:36:55 2020 -0700 Some changes to MPI calls in inti() routines. Again and again... commit 6e0c346cbe12c682b6273843d72ecc4081240088 Author: Dustin Swales Date: Mon Jan 27 11:01:50 2020 -0700 Some changes to MPI calls in inti() routines. Again... commit 0992def87d74fa13c41e6bf2e28335e021451129 Author: Dustin Swales Date: Mon Jan 27 10:21:38 2020 -0700 Some changes to MPI calls in inti() routines. commit dd9d5ce39a82abd336f1b2a27bce06dc949cbb9f Author: Dustin Swales Date: Tue Jan 21 15:54:36 2020 -0700 Removed diagnostic print statements. commit 320907ff03f5545a3825fb50efbfff803d1eb14b Author: Dustin Swales Date: Tue Jan 21 15:43:21 2020 -0700 Bug fix. commit 64691a6e755b3286f6b49518e99a64831f2459bd Author: Dustin Swales Date: Tue Jan 14 10:54:02 2020 -0700 Added by-band lw fluxes to diagnostic output. New namelist parameter for RRTMGP: number of gaussian angles for quadrature calculation. commit 6c8ecdd910d935a526ac430405ec914b1491aa0a Author: Dustin Swales Date: Mon Jan 13 12:49:13 2020 -0700 Try overwriting cloud optical depth in bands1-2. commit 5812151340d1263f1a7e0372dc5fb3b1c816e35c Author: Dustin Swales Date: Tue Jan 7 11:21:44 2020 -0700 Added some more diagnostics. commit 203cd4ac6d3d4b0d92e9f558bd13611a3e2ccbf4 Author: Dustin Swales Date: Tue Jan 7 10:08:21 2020 -0700 Needed to add MPI commands to open diagnostic output file. commit b6792036ac56e939121e049a8c11e3658a3e4492 Author: Dustin Swales Date: Mon Jan 6 14:40:49 2020 -0700 Fixed error in previous commit. commit 04ad9ed3a5f08f9f9b8c3888a73184a5b11c1e60 Author: Dustin Swales Date: Mon Jan 6 13:40:06 2020 -0700 Added longitude/latitude to output stream. Needed to sort through MPI output. commit 5542acaf51a9460fab4723c20622bb6f97853656 Author: Dustin Swales Date: Mon Jan 6 11:22:38 2020 -0700 Added diagnostics for LW clouds. commit ec093b215fa3f60f0032f3b2bb311e0b75a83b29 Author: Dustin Swales Date: Fri Jan 3 14:58:39 2020 -0700 Reverted some recent changes. commit 323e6f992c3ccb750b6fea1762d0a2e0a270fcc7 Author: Dustin Swales Date: Fri Jan 3 14:17:52 2020 -0700 Added number_of_gaussian angles to LW calculation. commit a564c8b379708caa55a7484038574fc5b1245838 Author: Dustin Swales Date: Thu Jan 2 12:02:56 2020 -0700 Moved aggregation into conditional loop. LW only. commit 2e161eba6e74476729385177e4ebb02ae2491a8c Author: Dustin Swales Date: Tue Dec 31 11:34:47 2019 -0700 Moved GFS_rrtmgp_lw_pre.F90 to rrtmgp_lw_pre.F90 commit edcb6726a9e223fd55f472f0e3d7649331c266d0 Author: Dustin Swales Date: Tue Dec 31 08:47:37 2019 -0700 Added diffusivity angle adjustment to LW. commit 28bea10e6c892d020c19604973de5203d9658fb4 Author: Dustin Swales Date: Thu Dec 19 16:00:00 2019 -0700 Removed diagnostic cloud outputs. commit b2d42f39cd3a6e5564219ca68be7604c2ad81f46 Author: Dustin Swales Date: Thu Dec 19 14:20:35 2019 -0700 Fix rounding error in G cloud-sampling test. Add diagnostics for cloud microphysics commit 4d3515dcda2f0b16c0ef7528e6760fa29bbbb343 Author: Dustin Swales Date: Tue Dec 17 11:08:09 2019 -0700 Round cloud-fractions to avoid McICA sampling error. In RRTMG as well. commit 5b02c9eb3fd929be59e1ca65451e1a1a74292dda Author: Dustin Swales Date: Tue Dec 17 10:18:24 2019 -0700 Round cloud-fractions to avoid McICA sampling error. commit e30305d8b7d87d4193c3a7049e4709aa5f97b744 Author: Dustin Swales Date: Mon Dec 16 15:53:19 2019 -0700 Fixed error in .meta file. commit 1526e7dcb457d05adc789c2f7a7c3a135f853d9f Author: Dustin Swales Date: Mon Dec 16 14:10:54 2019 -0700 Treat surface albedo exactly as in RRTMG. For SW bands 1-9, use nIR; For band 10, use average of nIR and uvVIS; For bands 11-24, use uvVIS. commit e105f48a986fdca2cc6b55e57d3c0dda4ae8bfbc Author: Dustin Swales Date: Mon Dec 16 13:50:35 2019 -0700 Revert "Delta-scale SW before incrementing aerosol optics." This reverts commit 122a750b58724330e244bb9814f0f66a7b22502d. commit 81abe37aba9e22ba3fae072b045dab715b7e8851 Author: Dustin Swales Date: Mon Dec 16 13:50:10 2019 -0700 Revert "Revert "Removed MPI for testing in UFS."" This reverts commit 8c5ead8cb39979350ab71e9a0b0ee22510e447eb. commit 8c5ead8cb39979350ab71e9a0b0ee22510e447eb Author: Dustin Swales Date: Mon Dec 16 13:48:41 2019 -0700 Revert "Removed MPI for testing in UFS." This reverts commit 4dcb001d753b0515dd0163dc02fff271380698b2. commit 122a750b58724330e244bb9814f0f66a7b22502d Author: Dustin Swales Date: Mon Dec 16 12:29:31 2019 -0700 Delta-scale SW before incrementing aerosol optics. commit 4dcb001d753b0515dd0163dc02fff271380698b2 Author: Dustin Swales Date: Mon Dec 16 11:56:21 2019 -0700 Removed MPI for testing in UFS. commit 86a24827b1a8d92b766a8fe422c401d4891ae19b Author: Dustin Swales Date: Mon Dec 16 11:04:06 2019 -0700 Fixed MPI calls in lw cloud optics. commit 8c46c345e8cfa24a5adc5708cad80392c62c6023 Author: Dustin Swales Date: Fri Dec 13 15:10:42 2019 -0700 Some more cleanup and documenting. Added initialization routine for cloud-sampling routines. commit 0ea0a12bae5e469095635c03e893a7135cf33967 Author: Dustin Swales Date: Fri Dec 13 13:44:15 2019 -0700 Turned MPI on for rrtmgp gas-optics, omission from last commit. commit 9ec9667452f6090c5fafc6ad8668e7bcfd011029 Author: Dustin Swales Date: Fri Dec 13 13:05:16 2019 -0700 Turned MPI on for rrtmgp gas-optics commit 1943d14264ac1623bd219a03b87ccc1f79297075 Author: Dustin Swales Date: Fri Dec 13 09:53:55 2019 -0700 Removed all instances of GFS derived data types from rrtmgp scheme level code. commit def30ce6634e68ccfc8e6e188f11b748e7fb6fb1 Author: Dustin Swales Date: Thu Dec 12 17:09:10 2019 -0700 Started removing GFS DDTs from RRTMGP scheme. commit 9a47ad3fe56cdc479d644df6f1d8a9dc51a468c9 Author: Dustin Swales Date: Thu Dec 12 14:19:48 2019 -0700 Added aerosol and cloud-sampling schemes. commit 9bd2dbb122546d1367e286b4c500e1f9ced702f4 Author: Dustin Swales Date: Wed Dec 11 16:07:46 2019 -0700 Express layer-thinkness in meters? commit ddebe4554926ddae4f74b406b5e743f400b63a49 Author: Dustin Swales Date: Wed Dec 11 14:33:40 2019 -0700 Alebdos (nIR and uvvis) are being averaged in rrtmg, did same in rrtmgp. Sneaky commit ac6d7a5cc33ecc8e04727ccc54a519649e6ce991 Author: Dustin Swales Date: Wed Dec 11 10:38:43 2019 -0700 Moved some interstitial firelds out of GFS_interstitial_type into flat fields. commit b16c6c76f4db31453ecf621e66211d33d37f0d8d Author: Dustin Swales Date: Wed Dec 11 09:19:43 2019 -0700 Removed MPI calls. commit 6cdd545a425f717a1fed528eaef31c48509f2dcb Author: Dustin Swales Date: Tue Dec 10 15:25:31 2019 -0700 Try calling mpi_barrier just before gas_optics%load commit a59b8981e618851303fe224ea8d803a14b101e64 Author: Dustin Swales Date: Tue Dec 10 14:46:50 2019 -0700 Added some print statements commit 92817d25049588af50f7c750e80af3885d9c0698 Author: Dustin Swales Date: Tue Dec 10 13:56:38 2019 -0700 Removed mpi calls in lw gas optics. Test reading in data on all processors. commit dcb8e4643479ef2d6c7c8427e1cc171a1ac1d69e Author: Dustin Swales Date: Tue Dec 10 11:05:25 2019 -0700 Add print statements, check LW optical-depth on all processors. commit 782ecb0bfff3f97736c2c5a4c8676f8afb9d718a Author: Dustin Swales Date: Tue Dec 10 10:12:41 2019 -0700 Reverted broadcast call for scalars commit 25974eb2fb2a0de4f5935d3bd862da353cc9c618 Author: Dustin Swales Date: Tue Dec 10 09:49:32 2019 -0700 Cleaned up, added some diagnostics to test MPI in UFS. commit 229ca5905567b6ee3224be17db89ab054d881ec8 Author: Dustin Swales Date: Mon Dec 9 16:25:31 2019 -0700 Revert to original mpi_bcast for character arrays. commit 0a726fd3c3a46b68ec76eee40bd847b22b8bfef5 Author: Dustin Swales Date: Mon Dec 9 16:02:30 2019 -0700 Try using string length provided in file for broadcsting strings. commit a25d7142c7f200b57e73fe18a091bcb4c4179668 Author: Dustin Swales Date: Mon Dec 9 15:21:43 2019 -0700 Changed MPI_BCAST() for character arrays. commit 72093456eb9f67a8b875100766befeeb6380ae6e Author: Dustin Swales Date: Mon Dec 9 14:34:52 2019 -0700 Add mpi_barrier() calls to all initialization routines commit e858d73db6a8434b502d16b866df0bcb38b849d9 Author: Dustin Swales Date: Mon Dec 9 13:39:57 2019 -0700 Add mpi_barrier() calls to SW gas optics initialization routine commit fbd398f361fc86fd15e053936f567936bf70d70a Author: Dustin Swales Date: Mon Dec 9 12:17:02 2019 -0700 Added ifdef(mpi) around declaration in initialization routines. commit 1bc898da3e2e6628a7551f973ed041b28073a881 Author: Dustin Swales Date: Mon Dec 9 11:56:26 2019 -0700 Added some print statements to diagnose MPI init. commit f471f795b9013ca224319ec94cb027aa7dc91e5b Author: Dustin Swales Date: Mon Dec 9 11:49:32 2019 -0700 Added some print statements to diagnose MPI init. commit 26cc6b1340dd7bec3bf85f79c30ded2faf6a024a Author: Dustin Swales Date: Fri Dec 6 11:00:33 2019 -0700 Cleaned up daytime masking in SW calculation commit e93fc1b647df2d7f2575d76ecc6e09dc6c858396 Author: Dustin Swales Date: Thu Dec 5 15:05:11 2019 -0700 Some housekeeping commit e905e96a10c1d07997f32486daee29545a6049d9 Author: Dustin Swales Date: Thu Dec 5 13:59:49 2019 -0700 Add loop over solar scaling commit 71b6a374f9ee1133576aa3f89a37f0e4248f5b70 Author: Dustin Swales Date: Wed Dec 4 12:43:32 2019 -0700 Change to diagnostic outputs for RRTMGP. commit 993508daad3917ac0d67dc8afa737fe92b6329e8 Merge: f895fc0 10191cd Author: dustinswales Date: Wed Dec 4 09:51:31 2019 -0700 Merge pull request #9 from dustinswales/rrtmgp-dev Created new rrtmgp-dev(2) branch. Something got corrupted. commit 10191cd672f7da36202b5e5b2e29c96c69f6aeca Merge: c62f631 7041bd2 Author: Dustin Swales Date: Tue Dec 3 12:12:55 2019 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev commit c62f6312fb34bd1b9acc27c432403169c8a8efc7 Merge: 2752142 0f796d9 Author: Dustin Swales Date: Tue Dec 3 19:04:48 2019 +0000 Merge branch 'rrtmgp-dev' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev commit 2752142a09002b57da48c8f21e94e7e1c9a8a0d9 Author: Dustin Swales Date: Tue Dec 3 19:03:57 2019 +0000 Cleaned up a tad. Added some diagnostics for debuggind in SCM. commit 0f796d919bef9d11b65a7797af123eeb1e5d1e63 Merge: d2799f4 904a433 Author: Dustin Swales Date: Wed Nov 20 16:19:04 2019 -0700 Merge branch 'master' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev commit d2799f4f37b60be3b7a3a3ed2ee24d4c93067402 Merge: 50b82a5 a7c38a6 Author: Dustin Swales Date: Wed Nov 20 15:53:00 2019 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev commit 50b82a57dc0b660adf1825f4f5982172c70104ae Author: Dustin Swales Date: Wed Nov 20 10:50:34 2019 -0700 Delta-scaling added to SW calculation. commit 54e00662f4af5abb518cd3b526438258b58dc6b0 Author: Dustin Swales Date: Thu Nov 7 10:59:19 2019 -0700 Added solar constant adjustment factor to incident SW TOA flux. GP SW downward fluxes now agree with baseline G downward fluxes. commit 69bf6216846ea067b81dfea6d7656afd84a5afe1 Merge: b7aa280 59717c5 Author: Dustin Swales Date: Tue Nov 5 12:01:04 2019 -0700 Merge remote branch 'grant-fork/cires_ugwp_namelist_fix' into rrtmgp-dev commit b7aa280e7cfb64b65b5619911eb8d91b4f90049b Merge: b6cc944 78a8ed2 Author: Dustin Swales Date: Tue Nov 5 10:03:44 2019 -0700 Merge branch 'rrtmgp-dev' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev commit 78a8ed263f43955704f43cdc84f985b4451d074a Author: Dustin Swales Date: Mon Nov 4 23:19:06 2019 +0000 Made some changes. Moved fields into Interstitial type. Results still differ from baseline RRTMG. commit b6cc9448f65c8843b99cb8692303fdeddb076e3f Merge: 1f57f68 fe6c9ae Author: Dustin Swales Date: Fri Nov 1 10:35:35 2019 -0600 Merge branch 'rrtmgp-dev' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev commit fe6c9aeb5b0cdad9cf3d711c7268e7ee81706698 Author: Dustin Swales Date: Tue Oct 29 14:17:19 2019 +0000 Moved RRTMGP active gases from GFS_radtend_type to GFS_control_type. commit 1f57f6813dcf1aae13175eefe22056ac6712886e Merge: f35effe cfafb29 Author: Dustin Swales Date: Mon Oct 28 11:05:42 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev commit f35effe345487621f30aeaa9d8f56c09d9344c13 Author: Dustin Swales Date: Fri Oct 25 22:06:21 2019 +0000 Some more changes in MPI commands within initialization commit 6126278f2879e155396c58b31d4c7ad8ffc3a8e7 Author: Dustin Swales Date: Fri Oct 25 17:32:46 2019 +0000 Fixed typo in MPI_BCAST() calls commit 2f23b9322841879cee20e412eedaf1f427ec679b Author: Dustin Swales Date: Thu Oct 17 19:11:05 2019 +0000 Remove deprecated code commit 04bdd4fde2f2d7110982c8e420cba8045bc8f1fd Author: Dustin Swales Date: Thu Oct 17 18:18:28 2019 +0000 Modified calls to radiaiton routines. commit 816ba3f2ab5c86a1524eba9de2c20f76086a2dbe Author: Dustin Swales Date: Wed Oct 16 22:30:12 2019 +0000 Fixed a bug commit 8bb1e85ca50022547a74f54ea01197e364cd8e82 Merge: 0b79698 9d6dd01 Author: Dustin Swales Date: Tue Oct 15 18:19:58 2019 +0000 Synced w/ upstream gmtb/develop commit 0b79698508a943c472340b812e82459e5a07c554 Author: Dustin Swales Date: Wed Oct 9 18:01:33 2019 +0000 Switched rte-rrtmgp submodule bracnh commit ac3006455f9c343f03bc204d10d9ccb08392499b Author: Dustin Swales Date: Wed Oct 9 17:54:02 2019 +0000 updated .gitmodules commit eba4af6bfbae1f1b2d36f140607f099a1ef9cc49 Author: Dustin Swales Date: Wed Oct 9 17:38:22 2019 +0000 Added RRTMGP as submodule commit 209b572774321cb824d8ab136291d64c39276a1d Merge: 87d19cf ecb641e Author: dustinswales Date: Wed Oct 9 11:14:24 2019 -0600 Merge pull request #8 from NCAR/gmtb/develop Sync with upstream Gmtb/develop commit 87d19cf0ceef826dd0336028bcd05a45d367d7e5 Merge: 4520c5d 9d6b208 Author: dustinswales Date: Wed Oct 9 10:57:16 2019 -0600 Merge pull request #7 from dustinswales/master Sync with master commit 9d6b208eae4be79edffbc8db20b737885912c824 Merge: 77bfcc2 ce641c9 Author: dustinswales Date: Wed Oct 9 10:55:46 2019 -0600 Merge pull request #6 from NCAR/master Sync with upstream master commit 4520c5df700ae787183414b23fd21625c9ea1dab Merge: 5ebe4c0 3958a87 Author: Dustin Swales Date: Tue Oct 8 20:15:13 2019 +0000 Merge branch 'rrtmgp-dev' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev commit 3958a870e7bf851456cfe80ffc8c7ebb7643045b Author: Dustin Swales Date: Mon Oct 7 15:06:55 2019 -0600 Changes were made to use RRTMGP for SW calculation, and RRTMG for the LW calculation. commit 34d5fe1584e8f2fd0f013fb4799e58441473c7e4 Author: Dustin Swales Date: Thu Sep 26 14:22:39 2019 -0600 Working commit e35f1b9c6f653aa18e0dce6c97eb95a8ddb7bc7a Merge: 4b61376 5cb9f93 Author: dustinswales Date: Wed Sep 25 09:17:22 2019 -0600 Merge pull request #5 from grantfirl/ticket_2050 Ticket 2050 fix commit 5cb9f93ff5a9de81fb0a0e937fdc0f10de6bb1ac Author: Grant Firl Date: Tue Sep 24 17:59:06 2019 -0600 change RRTMGP scheme metadata to use instances of DDTs rather than the type definition commit 4b61376adab644be38453bb3cd427b355c2b801e Author: Dustin Swales Date: Tue Sep 24 16:29:48 2019 -0600 Getting closer... commit f5562ee5c658119530b5f90e01c388e6840b499d Author: Dustin Swales Date: Tue Sep 24 09:55:14 2019 -0600 Fixed some bugs in argument tables. commit c668a6aa3b1af6f4858d6017577b347ee0c9185e Author: Dustin Swales Date: Mon Sep 23 10:56:22 2019 -0600 Modified arg_tables. Added .meta files commit 2ead7272da521a06bfb38805f75ffae53b9b72ec Author: Dustin Swales Date: Thu Sep 19 11:54:25 2019 -0600 Update .gitignore commit d6946ed8eccc87a080936da4500ed1bccbce3456 Author: Dustin Swales Date: Thu Sep 19 11:40:36 2019 -0600 Updated rrtmgp external commit fa9b30eaa187236b7366a3c2fb85d30f26c7b8ba Merge: 206a950 77bfcc2 Author: Dustin Swales Date: Thu Sep 19 11:31:35 2019 -0600 Merge branch 'master' into rrtmgp-dev commit 77bfcc2b2c14802a2b0e10df2a1d8c74750e2412 Merge: be12710 12c416a Author: dustinswales Date: Thu Sep 19 11:23:28 2019 -0600 Merge pull request #1 from NCAR/master Sync master branch of local fork with NCAR/ccpp-physics commit 5ebe4c00a7851b6d57a556adc8a2ce2b916cc2ab Merge: 7f8fc0b 243abfc Author: Dustin Swales Date: Mon Jul 1 18:23:43 2019 +0000 Synced w/ NCAR/ccpp-physics:master commit 7f8fc0b7fed7a60b17c48e0ac1d65572b3f43967 Author: Dustin Swales Date: Mon Jul 1 18:13:46 2019 +0000 Correction to MPI calls. commit f7915b9ff0d5ee993ccea474e7389ad5b7e86324 Author: Dustin Swales Date: Thu Jun 27 18:16:17 2019 +0000 Synced with NCAR repo. commit fa055745b654ce70e3be4a6f305d2ab6e02e7527 Author: Dustin Swales Date: Wed Jun 26 21:50:30 2019 +0000 Added rte-rrtmgp repository. commit 206a950623bd562f1aae4cb3d74f062ec4360aa1 Author: Dustin Swales Date: Mon Jun 24 12:17:11 2019 -0600 Added piece for GFDL MP. Not curretnly exercised. commit 0a100cb5d374d175222b8de578bdb0692807ee1c Merge: c445658 be12710 Author: Dustin Swales Date: Thu Jun 20 11:32:45 2019 -0600 Synced w/ master/ commit c445658417197b59c08e4d287a1aa88f4c041800 Author: Dustin Swales Date: Thu Jun 20 09:23:00 2019 -0600 Fixed a few bugs, some housekeeping. commit 9e5405c33e51962594cfd39762fa23eb9e548d5f Author: Dustin Swales Date: Thu Jun 13 16:29:43 2019 -0600 Fixed indexing error for output fluxes. commit c9a357a9d3b3bcc732b4211d3caa88d9bbf5757a Author: Dustin Swales Date: Wed Jun 12 09:39:56 2019 -0600 Added calls to compute_bc() in LW and SW gas_optics. Small bug found in mo_compute_bc. Work in progress. commit 044c88090bc90abada0eb6934260f5c005a8b0b7 Author: Dustin Swales Date: Tue Jun 11 09:28:20 2019 -0600 Renamed two modules. commit b882dffc9c043973d3809653163b7c8628f3ff8c Author: Dustin Swales Date: Mon Jun 10 17:17:06 2019 -0600 Added gas_optics_sw_run() and gas_optics_lw_run() routines. commit 52cb3a0c664485a650a14bce9bb70b390cbb9c14 Author: Dustin Swales Date: Fri Jun 7 11:33:25 2019 -0600 Fixed potential issue in Thompson MP scheme. Cleaned up a tad. commit 893ce888562ad7bda6392838e5406873f1c99107 Author: Dustin Swales Date: Thu Jun 6 16:16:17 2019 -0600 Some housekeeping. commit 6e2c8bdabcd53657852a1e905995131215ab5518 Author: Dustin Swales Date: Thu Jun 6 10:24:02 2019 -0600 Some cleaning up since last commit. commit a4bdffeaab6b44b9237af0836d99d288fdd947c5 Author: Dustin Swales Date: Wed Jun 5 16:45:48 2019 -0600 Major reorganization. Added schemes for cloud-optics and gas optics. Added RRTMGP active gases to gfs_physics_nml. commit f86636b604e28bde74600de0654da8183337c655 Author: Dustin Swales Date: Mon Jun 3 16:25:05 2019 -0600 Split up init into gas and cloud _init routines. Renamed some variables to be more clear. commit 4e0cfc85d8629d0130d22913e6c03030010114de Author: Dustin Swales Date: Fri May 31 15:27:09 2019 -0600 Added back option to call RRTMG cloud_optics(). commit 57be5513e59dbf9064dd71f01da9d6f43ac89c1d Author: Dustin Swales Date: Fri May 31 14:25:56 2019 -0600 Added new GFS_rrtmgp_XX_post.F90 for both SW and LW. commit ef4ed600037058c72a8081b6b89b4b333d507c89 Author: Dustin Swales Date: Fri May 31 11:54:56 2019 -0600 Moved microphysics from GFS_rrtmgp_pre_run() into its own routine, cloud_microphysics(). commit f5dc37a072cc7c68487657d4f70a787b2c13c60a Author: Dustin Swales Date: Thu May 30 16:46:06 2019 -0600 Remover extra-layer from GFS_rrtmgp_pre_run(). commit 1386e5816e5e1602ce3c1490bb49ac6d86412ea7 Author: Dustin Swales Date: Wed May 29 17:05:59 2019 -0600 More organizational changes to RRTMGP. commit 129b829e2d1cd8cd837526d75423172510d37878 Author: Dustin Swales Date: Tue May 28 10:04:25 2019 -0600 In progress... commit a60e1e1fa4388e222dbc9771a20d315290ce7493 Author: Dustin Swales Date: Tue May 21 16:23:01 2019 -0600 RRTMGP DDTs working! commit 9157959def8d8e4a5263a04361646bb746740c2d Author: Dustin Swales Date: Thu May 16 17:29:33 2019 -0600 Move computation of RRTMGP cloud optics to suite level, only for LW. commit f99255df6af91ae5f9345484949c3f6f8b8cad75 Author: Dustin Swales Date: Thu May 16 15:26:34 2019 -0600 Commit for Robert to view. commit 3beeb50f57710c07697c72e65df4f0018b8f1a20 Author: Dustin Swales Date: Mon May 13 11:55:41 2019 -0600 Changes for RRTMGP DDTs to be used in CCPP. commit e0ca27264d26464241429da466ca5bf49ca20c9a Author: Dustin Swales Date: Fri May 10 10:58:06 2019 -0600 Added metadata tables for DDTs. In CCPP/physics, started seperating pieces from suite-level to scheme level. commit 25b237274ae59fd2af3a185708ec019c3bd41ab9 Author: Dustin Swales Date: Thu May 9 15:19:04 2019 -0600 Added metadata tables to DDT definitions. commit 232545f63715b03064d687bdc6811d5974672e6c Author: Dustin Swales Date: Wed May 8 14:02:45 2019 -0600 Added _type to all instances of ty_gas_optics_rrtmgp commit 81f256d0f58353a656acc678593a776e2bbe6586 Author: Dustin Swales Date: Wed May 8 13:48:36 2019 -0600 Add rte-rrtmgp DDTs to CCPP commit 0a40aaa2ce2bc66c636fa7dcbcbe23b316dc253b Author: Dustin Swales Date: Tue May 7 15:54:57 2019 -0600 Moved to using extension/mo_rrtmgp_clr_all_sky.F90 routines to compute fluxes. commit 6557c76fe80f88c5af896548d4a5bab2e9c90e6e Author: Dustin Swales Date: Tue May 7 15:12:14 2019 -0600 Moved RRTMGP code to suite-level. commit 33e087f9eadc95faffeee35ea7b248d2b23f15e8 Author: Dustin Swales Date: Thu May 2 15:23:26 2019 -0600 Cleaned up, added detailed comments, vectorized loops. commit 8bbbd5b179d39380413fe7488b7bd0797cccfe75 Author: Dustin Swales Date: Thu May 2 11:34:46 2019 -0600 Cleaned up RRTGMP_pre a bit. Modified all calculations to use Pa instead of mb. commit 6c55b934838296fbb44580ddd847681aab2286f8 Author: Dustin Swales Date: Thu May 2 10:04:49 2019 -0600 Fixed allocation for RRTMGP aerosol/cloudy optical property DDT. Adjusted SW aerosol band ordering in GFS_rrtmgp_pre.F90. commit d14dba342a7c4f53cafa9632931d3893eb013790 Author: Dustin Swales Date: Wed May 1 16:05:13 2019 -0600 Fixd bug left in from last commit commit c089f10991dd72ed0a897ecdb9349e0a0307f7d7 Author: Dustin Swales Date: Wed May 1 15:29:19 2019 -0600 Same stuff as previous commit, but for SW. commit cf6bd6628be76bc64b788e270832d7586ce4357c Author: Dustin Swales Date: Wed May 1 09:15:21 2019 -0600 Revised LW flux calculation. commit e92cd8cb84673298c12269cddec0a0d33aa835d8 Author: Dustin Swales Date: Tue Apr 30 14:53:24 2019 -0600 Housekeeping in LW. Remove diffusivity angle adjustment, Added RRTMG draw_samples, Cleaned up aerosol increment, Passing random number to RRTMGP cloud sampling. commit 3c861b04be307f0cb0ee2786f4cb9fc497dce008 Author: Dustin Swales Date: Mon Apr 29 17:29:51 2019 -0600 LW RRTMGP cloud-optics working. Also, RRTMGP cloud sampling has been implemented (in progress). commit 67c2e26ed271aa2bdbe32548f443f6a916464f95 Author: Dustin Swales Date: Wed Apr 24 10:53:16 2019 -0600 Working./gmtb_scm twpice_control_RRTMGP_cloud commit 5ddf44d3950e86d994e26c58687bb184f67c11d4 Author: Dustin Swales Date: Thu Apr 18 15:41:45 2019 -0600 SW all-sky calculation working. Microphysics needs some attention. commit b4510ef93be07dd0d24b49b2a842799fbb588c87 Author: Dustin Swales Date: Tue Apr 16 12:26:03 2019 -0600 Added SW clear-sky calculation. commit 78ab01ec89f1b883105e12eb6684524219c021f2 Author: Dustin Swales Date: Tue Apr 16 12:20:17 2019 -0600 Added SW clear-sky calculation. commit 9414a90790aa4669cef3b21a256595ce540661f6 Author: Dustin Swales Date: Tue Apr 16 12:15:03 2019 -0600 Added ability to provide cloudy profile to radiation (RRTMG and RRTMGP). commit 80e70c19a89ee4d9ddd6bd0d869f0cee80992fe6 Author: Dustin Swales Date: Fri Mar 22 15:32:19 2019 -0600 Added diffusivity angle correction to optical-depths. commit 824009254877c1ac359b974ac1449506a98cf3a2 Author: Dustin Swales Date: Thu Mar 21 16:57:34 2019 -0600 Ported RRTMGP development from release repo. LW is working. --- .gitmodules | 4 + physics/GFS_rrtmgp_lw_post.F90 | 235 +++ physics/GFS_rrtmgp_lw_post.meta | 208 +++ physics/GFS_rrtmgp_pre.F90 | 783 ++++++++ physics/GFS_rrtmgp_pre.meta | 375 ++++ physics/GFS_rrtmgp_setup.F90 | 609 +++++++ physics/GFS_rrtmgp_setup.meta | 343 ++++ physics/GFS_rrtmgp_sw_post.F90 | 307 ++++ physics/GFS_rrtmgp_sw_post.meta | 267 +++ physics/GFS_rrtmgp_sw_pre.F90 | 155 ++ physics/GFS_rrtmgp_sw_pre.meta | 194 ++ physics/radlw_param.meta | 6 + physics/radsw_param.meta | 6 + physics/rrtmg_lw_cloud_optics.F90 | 821 +++++++++ physics/rrtmg_sw_cloud_optics.F90 | 2412 +++++++++++++++++++++++++ physics/rrtmgp_aux.F90 | 33 + physics/rrtmgp_lw_aerosol_optics.F90 | 97 + physics/rrtmgp_lw_aerosol_optics.meta | 166 ++ physics/rrtmgp_lw_cloud_optics.F90 | 374 ++++ physics/rrtmgp_lw_cloud_optics.meta | 309 ++++ physics/rrtmgp_lw_cloud_sampling.F90 | 126 ++ physics/rrtmgp_lw_cloud_sampling.meta | 114 ++ physics/rrtmgp_lw_gas_optics.F90 | 402 +++++ physics/rrtmgp_lw_gas_optics.meta | 210 +++ physics/rrtmgp_lw_pre.F90 | 86 + physics/rrtmgp_lw_pre.meta | 134 ++ physics/rrtmgp_lw_rte.F90 | 172 ++ physics/rrtmgp_lw_rte.meta | 200 ++ physics/rrtmgp_sw_aerosol_optics.F90 | 115 ++ physics/rrtmgp_sw_aerosol_optics.meta | 182 ++ physics/rrtmgp_sw_cloud_optics.F90 | 367 ++++ physics/rrtmgp_sw_cloud_optics.meta | 278 +++ physics/rrtmgp_sw_cloud_sampling.F90 | 133 ++ physics/rrtmgp_sw_cloud_sampling.meta | 130 ++ physics/rrtmgp_sw_gas_optics.F90 | 371 ++++ physics/rrtmgp_sw_gas_optics.meta | 244 +++ physics/rrtmgp_sw_rte.F90 | 218 +++ physics/rrtmgp_sw_rte.meta | 252 +++ physics/rte-rrtmgp | 1 + 39 files changed, 11439 insertions(+) create mode 100644 .gitmodules create mode 100644 physics/GFS_rrtmgp_lw_post.F90 create mode 100644 physics/GFS_rrtmgp_lw_post.meta create mode 100644 physics/GFS_rrtmgp_pre.F90 create mode 100644 physics/GFS_rrtmgp_pre.meta create mode 100644 physics/GFS_rrtmgp_setup.F90 create mode 100644 physics/GFS_rrtmgp_setup.meta create mode 100644 physics/GFS_rrtmgp_sw_post.F90 create mode 100644 physics/GFS_rrtmgp_sw_post.meta create mode 100644 physics/GFS_rrtmgp_sw_pre.F90 create mode 100644 physics/GFS_rrtmgp_sw_pre.meta create mode 100644 physics/rrtmg_lw_cloud_optics.F90 create mode 100644 physics/rrtmg_sw_cloud_optics.F90 create mode 100644 physics/rrtmgp_aux.F90 create mode 100644 physics/rrtmgp_lw_aerosol_optics.F90 create mode 100644 physics/rrtmgp_lw_aerosol_optics.meta create mode 100644 physics/rrtmgp_lw_cloud_optics.F90 create mode 100644 physics/rrtmgp_lw_cloud_optics.meta create mode 100644 physics/rrtmgp_lw_cloud_sampling.F90 create mode 100644 physics/rrtmgp_lw_cloud_sampling.meta create mode 100644 physics/rrtmgp_lw_gas_optics.F90 create mode 100644 physics/rrtmgp_lw_gas_optics.meta create mode 100644 physics/rrtmgp_lw_pre.F90 create mode 100644 physics/rrtmgp_lw_pre.meta create mode 100644 physics/rrtmgp_lw_rte.F90 create mode 100644 physics/rrtmgp_lw_rte.meta create mode 100644 physics/rrtmgp_sw_aerosol_optics.F90 create mode 100644 physics/rrtmgp_sw_aerosol_optics.meta create mode 100644 physics/rrtmgp_sw_cloud_optics.F90 create mode 100644 physics/rrtmgp_sw_cloud_optics.meta create mode 100644 physics/rrtmgp_sw_cloud_sampling.F90 create mode 100644 physics/rrtmgp_sw_cloud_sampling.meta create mode 100644 physics/rrtmgp_sw_gas_optics.F90 create mode 100644 physics/rrtmgp_sw_gas_optics.meta create mode 100644 physics/rrtmgp_sw_rte.F90 create mode 100644 physics/rrtmgp_sw_rte.meta create mode 160000 physics/rte-rrtmgp diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 000000000..8421166ca --- /dev/null +++ b/.gitmodules @@ -0,0 +1,4 @@ +[submodule "physics/rte-rrtmgp"] + path = physics/rte-rrtmgp + url = https://github.com/RobertPincus/rte-rrtmgp + branch = dtc/ccpp diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 new file mode 100644 index 000000000..38b9530b0 --- /dev/null +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -0,0 +1,235 @@ +module GFS_rrtmgp_lw_post + use machine, only: kind_phys + use GFS_typedefs, only: GFS_coupling_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type, & + GFS_statein_type, & + GFS_diag_type + use module_radiation_aerosols, only: NSPC1 + use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type + ! RRTMGP DDT's + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_heating_rates, only: compute_heating_rate + use rrtmgp_aux, only: check_error_msg + implicit none + + public GFS_rrtmgp_lw_post_init,GFS_rrtmgp_lw_post_run,GFS_rrtmgp_lw_post_finalize + +contains + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_post_init + ! ######################################################################################### + subroutine GFS_rrtmgp_lw_post_init() + end subroutine GFS_rrtmgp_lw_post_init + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_post_run + ! ######################################################################################### +!> \section arg_table_GFS_rrtmgp_lw_post_run +!! \htmlinclude GFS_rrtmgp_lw_post.html +!! + subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statein, im, & + p_lev, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky,& + raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, & + flxprf_lw, hlw0, errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! Fortran DDT: FV3-GFS model control parameters + type(GFS_grid_type), intent(in) :: & + Grid ! Fortran DDT: FV3-GFS grid and interpolation related data + type(GFS_statein_type), intent(in) :: & + Statein ! Fortran DDT: FV3-GFS prognostic state data in from dycore + integer, intent(in) :: & + im ! Horizontal loop extent + real(kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: & + tsfa ! Lowest model layer air temperature for radiation (K) + real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (hPa) + real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & + fluxlwUP_allsky, & ! RRTMGP longwave all-sky flux (W/m2) + fluxlwDOWN_allsky, & ! RRTMGP longwave all-sky flux (W/m2) + fluxlwUP_clrsky, & ! RRTMGP longwave clear-sky flux (W/m2) + fluxlwDOWN_clrsky ! RRTMGP longwave clear-sky flux (W/m2) + real(kind_phys), intent(in) :: & + raddt ! Radiation time step + real(kind_phys), dimension(im,NSPC1), intent(in) :: & + aerodp ! Vertical integrated optical depth for various aerosol species + real(kind_phys), dimension(im,5), intent(in) :: & + cldsa ! Fraction of clouds for low, middle, high, total and BL + integer, dimension(im,3), intent(in) ::& + mbota, & ! vertical indices for low, middle and high cloud tops + mtopa ! vertical indices for low, middle and high cloud bases + real(kind_phys), dimension(im,Model%levs), intent(in) :: & + cld_frac, & ! Total cloud fraction in each layer + cldtaulw ! approx 10.mu band layer cloud optical depth + real(kind_phys),dimension(size(Grid%xlon,1), Model%levs) :: & + hlwc ! Longwave all-sky heating-rate (K/sec) + + ! Outputs (mandatory) + character(len=*), intent(out) :: & + errmsg + integer, intent(out) :: & + errflg + type(GFS_coupling_type), intent(inout) :: & + Coupling ! Fortran DDT: FV3-GFS fields to/from coupling with other components + type(GFS_radtend_type), intent(inout) :: & + Radtend ! Fortran DDT: FV3-GFS radiation tendencies + type(GFS_diag_type), intent(inout) :: & + Diag ! Fortran DDT: FV3-GFS diagnotics data + + ! Outputs (optional) + real(kind_phys), dimension(size(Grid%xlon,1), Model%levs), optional, intent(inout) :: & + hlw0 ! Longwave clear-sky heating rate (K/sec) + type(proflw_type), dimension(size(Grid%xlon,1), Model%levs+1), optional, intent(inout) :: & + flxprf_lw ! 2D radiative fluxes, components: + ! upfxc - total sky upward flux (W/m2) + ! dnfxc - total sky dnward flux (W/m2) + ! upfx0 - clear sky upward flux (W/m2) + ! dnfx0 - clear sky dnward flux (W/m2) + + ! Local variables + integer :: i, j, k, iSFC, iTOA, itop, ibtc + logical :: l_clrskylw_hr, l_fluxeslw2d, top_at_1 + real(kind_phys) :: tem0d, tem1, tem2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Model%lslwr) return + + ! Are any optional outputs requested? + l_clrskylw_hr = present(hlw0) + l_fluxeslw2d = present(flxprf_lw) + + ! ####################################################################################### + ! What is vertical ordering? + ! ####################################################################################### + top_at_1 = (p_lev(1,1) .lt. p_lev(1, Model%levs)) + if (top_at_1) then + iSFC = Model%levs+1 + iTOA = 1 + else + iSFC = 1 + iTOA = Model%levs+1 + endif + + ! ####################################################################################### + ! Compute LW heating-rates. + ! ####################################################################################### + if (Model%lslwr) then + ! Clear-sky heating-rate (optional) + if (l_clrskylw_hr) then + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxlwUP_clrsky, & ! IN - RRTMGP upward longwave clear-sky flux profiles (W/m2) + fluxlwDOWN_clrsky, & ! IN - RRTMGP downward longwave clear-sky flux profiles (W/m2) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + hlw0)) ! OUT - Longwave clear-sky heating rate (K/sec) + endif + ! All-sky heating-rate (mandatory) + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxlwUP_allsky, & ! IN - RRTMGP upward longwave all-sky flux profiles (W/m2) + fluxlwDOWN_allsky, & ! IN - RRTMGP downward longwave all-sky flux profiles (W/m2) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + hlwc)) ! OUT - Longwave all-sky heating rate (K/sec) + + ! Copy fluxes from RRTGMP types into model radiation types. + ! Mandatory outputs + Diag%topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) + Diag%topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) + Radtend%sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) + Radtend%sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) + Radtend%sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) + Radtend%sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC) + + ! Optional outputs + if(l_fluxeslw2d) then + flxprf_lw%upfxc = fluxlwUP_allsky + flxprf_lw%dnfxc = fluxlwDOWN_allsky + flxprf_lw%upfx0 = fluxlwUP_clrsky + flxprf_lw%dnfx0 = fluxlwDOWN_clrsky + endif + endif + + ! ####################################################################################### + ! Save LW outputs. + ! ####################################################################################### + if (Model%lslwr) then + ! Save surface air temp for diurnal adjustment at model t-steps + Radtend%tsflw (:) = tsfa(:) + + ! All-sky heating rate profile + do k = 1, model%levs + Radtend%htrlw(1:im,k) = hlwc(1:im,k) + enddo + if (Model%lwhtr) then + do k = 1, model%levs + Radtend%lwhc(1:im,k) = hlw0(1:im,k) + enddo + endif + + ! Radiation fluxes for other physics processes + Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc + endif + + ! ####################################################################################### + ! Save LW diagnostics + ! - For time averaged output quantities (including total-sky and clear-sky SW and LW + ! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base + ! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in + ! corresponding slots of array fluxr with appropriate time weights. + ! - Collect the fluxr data for wrtsfc + ! ####################################################################################### + if (Model%lssav) then + if (Model%lslwr) then + do i=1,im + ! LW all-sky fluxes + Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + Model%fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up + Diag%fluxr(i,19) = Diag%fluxr(i,19) + Model%fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn + Diag%fluxr(i,20) = Diag%fluxr(i,20) + Model%fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up + ! LW clear-sky fluxes + Diag%fluxr(i,28) = Diag%fluxr(i,28) + Model%fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up + Diag%fluxr(i,30) = Diag%fluxr(i,30) + Model%fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn + Diag%fluxr(i,33) = Diag%fluxr(i,33) + Model%fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up + enddo + + do i=1,im + Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) + Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) + enddo + + ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud is reversed for + ! the fluxr output. save interface pressure (pa) of top/bot + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) + ibtc = mbota(i,j) + Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d + Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop) + Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc) + Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) + + ! Add optical depth and emissivity output + tem2 = 0. + do k=ibtc,itop + tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel + enddo + Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + enddo + enddo + endif + endif + + end subroutine GFS_rrtmgp_lw_post_run + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_post_finalize + ! ######################################################################################### + subroutine GFS_rrtmgp_lw_post_finalize () + end subroutine GFS_rrtmgp_lw_post_finalize + +end module GFS_rrtmgp_lw_post diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta new file mode 100644 index 000000000..3eb1e0953 --- /dev/null +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -0,0 +1,208 @@ +[ccpp-arg-table] + name = GFS_rrtmgp_lw_post_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = inout + optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type + intent = inout + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP_allsky] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwDOWN_allsky] + standard_name = RRTMGP_lw_flux_profile_downward_allsky + long_name = RRTMGP downward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP_clrsky] + standard_name = RRTMGP_lw_flux_profile_upward_clrsky + long_name = RRTMGP upward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwDOWN_clrsky] + standard_name = RRTMGP_lw_flux_profile_downward_clrsky + long_name = RRTMGP downward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = in + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = in + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = in + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cldtaulw] + standard_name = RRTMGP_cloud_optical_depth_layers_at_10mu_band + long_name = approx 10mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flxprf_lw] + standard_name = RRTMGP_lw_fluxes + long_name = lw fluxes total sky / csk and up / down at levels + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = proflw_type + intent = inout + optional = T +[hlw0] + standard_name = RRTMGP_lw_heating_rate_clear_sky + long_name = RRTMGP longwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[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_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 new file mode 100644 index 000000000..cb2b79410 --- /dev/null +++ b/physics/GFS_rrtmgp_pre.F90 @@ -0,0 +1,783 @@ +module GFS_rrtmgp_pre + use physparam + use machine, only: & + kind_phys ! Working type + use GFS_typedefs, only: & + GFS_statein_type, & ! Prognostic state data in from dycore + GFS_stateout_type, & ! Prognostic state or tendencies return to dycore + GFS_sfcprop_type, & ! Surface fields + GFS_coupling_type, & ! Fields to/from coupling with other components (e.g. land/ice/ocean/etc.) + GFS_control_type, & ! Model control parameters + GFS_grid_type, & ! Grid and interpolation related data + GFS_tbd_type, & ! To-Be-Determined data that doesn't fit in any one container + GFS_radtend_type, & ! Radiation tendencies needed in physics + GFS_diag_type ! Fields targetted for diagnostic output + use physcons, only: & + eps => con_eps, & ! Rd/Rv + epsm1 => con_epsm1, & ! Rd/Rv-1 + fvirt => con_fvirt, & ! Rv/Rd-1 + rog => con_rog ! Rd/g + use radcons, only: & + qmin, epsq ! Minimum vlaues for varius calculations + use funcphys, only: & + fpvs ! Function ot compute sat. vapor pressure over liq. + use module_radiation_astronomy,only: & + coszmn ! Function to compute cos(SZA) + use module_radiation_gases, only: & + NF_VGAS, & ! Number of active gas species + getgases, & ! Routine to setup trace gases + getozn ! Routine to setup ozone + use module_radiation_aerosols, only: & + NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) + NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) + setaer, & ! Routine to compute aerosol radiative properties (tau,g,omega) + NSPC1 ! Number of species for vertically integrated aerosol optical-depth + use module_radiation_clouds, only: & + NF_CLDS, & ! Number of fields in "clouds" array (e.g. (cloud(1)=lwp,clouds(2)=ReffLiq,...) + progcld1, & ! Zhao/Moorthi's prognostic cloud scheme + progcld3, & ! Zhao/Moorthi's prognostic cloud+pdfcld + progcld4, & ! GFDL cloud scheme + progcld5, & ! Thompson / WSM6 cloud micrphysics scheme + progclduni ! Unified cloud-scheme + use surface_perturbation, only: & + cdfnor ! Routine to compute CDF (used to compute percentiles) + use module_radiation_surface, only: & + setemis, & ! Routine to compute surface-emissivity + NF_ALBD, & ! Number of surface albedo categories (4; nir-direct, nir-diffuse, uvvis-direct, uvvis-diffuse) + setalb ! Routine to compute surface albedo + ! RRTMGP types + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use rrtmgp_aux, only: check_error_msg!, rrtmgp_minP, rrtmgp_minT + use mo_rrtmgp_constants, only: grav, avogad + use mo_rrtmg_lw_cloud_optics + + real(kind_phys), parameter :: & + amd = 28.9644_kind_phys, & ! Molecular weight of dry-air (g/mol) + amw = 18.0154_kind_phys, & ! Molecular weight of water vapor (g/mol) + amo3 = 47.9982_kind_phys, & ! Modelular weight of ozone (g/mol) + amdw = amd/amw, & ! Molecular weight of dry air / water vapor + amdo3 = amd/amo3 ! Molecular weight of dry air / ozone + + ! Some common trace gas on/off flags. + ! This allows for control over which trace gases are used in RRTMGP radiation scheme via + ! namelist. + logical :: & + isActive_h2o = .false., & ! + isActive_co2 = .false., & ! + isActive_o3 = .false., & ! + isActive_n2o = .false., & ! + isActive_ch4 = .false., & ! + isActive_o2 = .false., & ! + isActive_ccl4 = .false., & ! + isActive_cfc11 = .false., & ! + isActive_cfc12 = .false., & ! + isActive_cfc22 = .false. ! + integer :: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, iStr_o2, iStr_ccl4, & + iStr_cfc11, iStr_cfc12, iStr_cfc22 + + public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize +contains + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_pre_init + ! ######################################################################################### +!! \section arg_table_GFS_rrtmgp_pre_init +!! \htmlinclude GFS_rrtmgp_pre_init.html +!! + subroutine GFS_rrtmgp_pre_init(Model, Radtend, active_gases_array, errmsg, errflg) + ! Inputs + type(GFS_control_type), intent(inout) :: & + Model ! DDT: FV3-GFS model control parameters + type(GFS_radtend_type), intent(inout) :: & + Radtend ! DDT: FV3-GFS radiation tendencies + + ! Outputs + character(len=*),dimension(Model%ngases), intent(out) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + character(len=1) :: tempstr + integer :: ij, count + integer,dimension(Model%ngases,2) :: gasIndices + + ! Initialize + errmsg = '' + errflg = 0 + + if (len(Model%active_gases) .eq. 0) return + + ! Which gases are active? Provided via physics namelist. + + ! Pull out gas names from list... + ! First grab indices in character array corresponding to start:end of gas name. + gasIndices(1,1)=1 + count=1 + do ij=1,len(Model%active_gases) + tempstr=trim(Model%active_gases(ij:ij)) + if (tempstr .eq. '_') then + gasIndices(count,2)=ij-1 + gasIndices(count+1,1)=ij+1 + count=count+1 + endif + enddo + gasIndices(Model%ngases,2)=len(trim(Model%active_gases)) + + ! Now extract the gas names + do ij=1,Model%ngases + active_gases_array(ij) = Model%active_gases(gasIndices(ij,1):gasIndices(ij,2)) + enddo + + ! Which gases are active? (This is purely for flexibility) + do ij=1,Model%ngases + if(trim(active_gases_array(ij)) .eq. 'h2o') then + isActive_h2o = .true. + istr_h2o = ij + endif + if(trim(active_gases_array(ij)) .eq. 'co2') then + isActive_co2 = .true. + istr_co2 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'o3') then + isActive_o3 = .true. + istr_o3 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'n2o') then + isActive_n2o = .true. + istr_n2o = ij + endif + if(trim(active_gases_array(ij)) .eq. 'ch4') then + isActive_ch4 = .true. + istr_ch4 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'o2') then + isActive_o2 = .true. + istr_o2 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'ccl4') then + isActive_ccl4 = .true. + istr_ccl4 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'cfc11') then + isActive_cfc11 = .true. + istr_cfc11 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'cfc12') then + isActive_cfc12 = .true. + istr_cfc12 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'cfc22') then + isActive_cfc22 = .true. + istr_cfc22 = ij + endif + enddo + + end subroutine GFS_rrtmgp_pre_init + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_pre_run + ! ######################################################################################### +!> \section arg_table_GFS_rrtmgp_pre_run +!! \htmlinclude GFS_rrtmgp_pre.html +!! + subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN + ncol, lw_gas_props, active_gases_array, & ! IN + sec_diff_byband, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp,& ! OUT + cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! OUT + tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth, gas_concentrations, & ! OUT + errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT: FV3-GFS model control parameters + type(GFS_grid_type), intent(in) :: & + Grid ! DDT: FV3-GFS grid and interpolation related data + type(GFS_statein_type), intent(in) :: & + Statein ! DDT: FV3-GFS prognostic state data in from dycore + type(GFS_coupling_type), intent(in) :: & + Coupling ! DDT: FV3-GFS fields to/from coupling with other components + type(GFS_radtend_type), intent(inout) :: & + Radtend ! DDT: FV3-GFS radiation tendencies + type(GFS_sfcprop_type), intent(in) :: & + Sfcprop ! DDT: FV3-GFS surface fields + type(GFS_tbd_type), intent(in) :: & + Tbd ! DDT: FV3-GFS data not yet assigned to a defined container + integer, intent(in) :: & + ncol ! Number of horizontal grid points + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: longwave spectral information + character(len=*),dimension(Model%ngases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + + ! Outputs + real(kind_phys), dimension(ncol,Model%levs), intent(out) :: & + p_lay, & ! Pressure at model-layer + t_lay ! Temperature at model layer + real(kind_phys), dimension(ncol,Model%levs+1), intent(out) :: & + p_lev, & ! Pressure at model-interface + t_lev ! Temperature at model-interface + real(kind_phys), intent(out) :: & + raddt ! Radiation time-step + real(kind_phys), dimension(ncol), intent(out) :: & + tsfg, & ! Ground temperature + tsfa ! Skin temperature + type(ty_gas_concs),intent(out) :: & + gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain ! Cloud rain effective radius + real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & + tv_lay, & ! Virtual temperatue at model-layers + relhum ! Relative-humidity at model-layers + real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(out) :: & + tracer ! Array containing trace gases + integer,dimension(ncol,3),intent(out) :: & + mbota, & ! Vertical indices for cloud tops + mtopa ! Vertical indices for cloud bases + real(kind_phys), dimension(ncol,5), intent(out) :: & + cldsa ! Fraction of clouds for low, middle, high, total and BL + real(kind_phys), dimension(ncol), intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(out) :: & + sec_diff_byband + + ! Local variables + integer :: i, j, iCol, iBand, iSFC, iTOA, iLay + logical :: top_at_1 + real(kind_phys),dimension(NCOL,Model%levs) :: vmr_o3, vmr_h2o, coldry, tem0, colamt + real(kind_phys) :: es, qs, tem1, tem2 + real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb + real(kind_phys), dimension(ncol, Model%levs) :: qs_lay, q_lay, deltaZ, deltaP, o3_lay + real(kind_phys), dimension(ncol, Model%levs, NF_VGAS) :: gas_vmr + real(kind_phys), dimension(ncol, Model%levs, NF_CLDS) :: clouds + real(kind_phys), dimension(ncol) :: precipitableH2o + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. (Model%lsswr .or. Model%lslwr)) return + + ! ####################################################################################### + ! What is vertical ordering? + ! ####################################################################################### + top_at_1 = (Statein%prsi(1,1) .lt. Statein%prsi(1, Model%levs)) + if (top_at_1) then + iSFC = Model%levs + iTOA = 1 + else + iSFC = 1 + iTOA = Model%levs + endif + + ! ####################################################################################### + ! Compute some fields needed by RRTMGP + ! ####################################################################################### + + ! Water-vapor mixing-ratio + q_lay(1:ncol,:) = Statein%qgrs(1:NCOL,:,1) + where(q_lay .lt. 1.e-6) q_lay = 1.e-6 + + ! Pressure at layer-interface + p_lev(1:NCOL,:) = Statein%prsi(1:NCOL,:) + + ! Pressure at layer-center + p_lay(1:NCOL,:) = Statein%prsl(1:NCOL,:) + + ! Temperature at layer-center + t_lay(1:NCOL,:) = Statein%tgrs(1:NCOL,:) + + ! Temperature at layer-interfaces + if (top_at_1) then + t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) + t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys + t_lev(1:NCOL,iSFC+1) = Sfcprop%tsfc(1:NCOL) + else + t_lev(1:NCOL,1) = Sfcprop%tsfc(1:NCOL) + t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys + t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) + endif + + ! Compute layer pressure thicknes + deltaP = abs(p_lev(:,2:model%levs+1)-p_lev(:,1:model%levs)) + + ! Compute a bunch of thermodynamic fields needed by the macrophysics schemes. Relative humidity, + ! saturation mixing-ratio, vapor mixing-ratio, virtual temperature, layer thickness,... + do iCol=1,NCOL + do iLay=1,Model%levs + es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa + qs = max( QMIN, eps * es / (p_lay(iCol,iLay) + epsm1*es) ) + relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(QMIN, q_lay(iCol,iLay))/qs ) ) + qs_lay(iCol,iLay) = qs + tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + fvirt*q_lay(iCol,iLay)) + deltaZ(iCol,iLay) = (rog*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + enddo + + ! ####################################################################################### + ! Get layer ozone mass mixing ratio + ! ####################################################################################### + ! First recast remaining all tracers (except sphum) forcing them all to be positive + do j = 2, model%NTRAC + tracer(1:NCOL,:,j) = Statein%qgrs(1:NCOL,:,j) + where(tracer(:,:,j) .lt. 0.0) tracer(:,:,j) = 0._kind_phys + enddo + + if (Model%ntoz > 0) then + do iLay=1,Model%levs + do iCol=1,NCOL + o3_lay(iCol,iLay) = max( QMIN, tracer(iCol,iLay,Model%ntoz) ) + enddo + enddo + ! OR Use climatological ozone data + else + call getozn (Statein%prslk(1:NCOL,:), Grid%xlat, NCOL, Model%levs, o3_lay) + endif + + ! ####################################################################################### + ! Set gas concentrations for RRTMGP + ! ####################################################################################### + ! Call getgases(), to set up non-prognostic gas volume mixing ratios (gas_vmr). + call getgases (p_lev/100., Grid%xlon, Grid%xlat, NCOL, Model%levs, gas_vmr) + + ! Compute volume mixing-ratios for ozone (mmr) and specific-humidity. + vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) + vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.) + + ! Initialize and opulate RRTMGP DDT w/ gas-concentrations + call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array)) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o2), gas_vmr(:,:,4))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_co2), gas_vmr(:,:,1))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_ch4), gas_vmr(:,:,3))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_n2o), gas_vmr(:,:,2))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_h2o), vmr_h2o)) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o3), vmr_o3)) + + ! ####################################################################################### + ! Compute diffusivity angle adjustments for each longwave band + ! *NOTE* Legacy RRTMGP code + ! ####################################################################################### + ! Conpute diffusivity angle adjustments. + ! First need to compute precipitable water in each column + tem0 = (1._kind_phys - vmr_h2o)*amd + vmr_h2o*amw + coldry = ( 1.0e-20 * 1.0e3 *avogad)*(deltap*.01) / (100.*grav*tem0*(1._kind_phys + vmr_h2o)) + colamt = max(0._kind_phys, coldry*vmr_h2o) + do iCol=1,nCol + tem1 = 0._kind_phys + tem2 = 0._kind_phys + do iLay=1,Model%levs + tem1 = tem1 + coldry(iCol,iLay)+colamt(iCol,iLay) + tem2 = tem2 + colamt(iCol,iLay) + enddo + precipitableH2o(iCol) = p_lev(iCol,iSFC)*0.01*(10._kind_phys*tem2 / (amdw*tem1*grav)) + enddo + + ! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 + ! and 1.80) as a function of total column water vapor. the function + ! has been defined to minimize flux and cooling rate errors in these bands + ! over a wide range of precipitable water values. + do iCol=1,nCol + do iBand = 1, lw_gas_props%get_nband() + if (iBand==1 .or. iBand==4 .or. iBand==10) then + sec_diff_byband(iBand,iCol) = diffusivityB1410 + else + sec_diff_byband(iBand,iCol) = min( diffusivityHigh, max(diffusivityLow, & + a0(iBand)+a1(iBand)*exp(a2(iBand)*precipitableH2o(iCol)))) + endif + enddo + enddo + + ! ####################################################################################### + ! Radiation time step (output) (Is this really needed?) (Used by some diangostics) + ! ####################################################################################### + raddt = min(Model%fhswr, Model%fhlwr) + + ! ####################################################################################### + ! Setup surface ground temperature and ground/air skin temperature if required. + ! ####################################################################################### + tsfg(1:NCOL) = Sfcprop%tsfc(1:NCOL) + tsfa(1:NCOL) = Sfcprop%tsfc(1:NCOL) + + ! ####################################################################################### + ! Cloud microphysics + ! ####################################################################################### + call cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev, & + tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) + + ! Copy output cloud fields + cld_frac = clouds(:,:,1) + cld_lwp = clouds(:,:,2) + cld_reliq = clouds(:,:,3) + cld_iwp = clouds(:,:,4) + cld_reice = clouds(:,:,5) + cld_rwp = clouds(:,:,6) + cld_rerain = clouds(:,:,7) + cld_swp = clouds(:,:,8) + cld_resnow = clouds(:,:,9) + + end subroutine GFS_rrtmgp_pre_run + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_pre_finalize + ! ######################################################################################### + subroutine GFS_rrtmgp_pre_finalize () + end subroutine GFS_rrtmgp_pre_finalize + + ! ######################################################################################### + ! Subroutine cloud_microphysics() + ! ######################################################################################### + subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev,& + tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT: FV3-GFS model control parameters + type(GFS_tbd_type), intent(in) :: & + Tbd ! DDT: FV3-GFS data not yet assigned to a defined container + type(GFS_grid_type), intent(in) :: & + Grid ! DDT: FV3-GFS grid and interpolation related data + type(GFS_sfcprop_type), intent(in) :: & + Sfcprop ! DDT: FV3-GFS surface fields + integer, intent(in) :: & + ncol ! Number of horizontal gridpoints + real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & + tracer ! Cloud condensate amount in layer by type () + real(kind_phys), dimension(ncol,Model%levs), intent(in) :: & + p_lay, & ! Pressure @ model layer centers (Pa) + t_lay, & ! Temperature @ layer centers (K) + tv_lay, & ! Virtual temperature @ layer centers (K) + relhum, & ! Relative humidity @ layer centers(1) + qs_lay, & ! Saturation specific humidity @ layer center (kg/kg) + q_lay, & ! Specific humidity @ layer centers(kg/kg) + deltaZ, & ! Layer thickness (km) + deltaP ! Layer thickness (Pa) + real(kind_phys), dimension(ncol,Model%levs+1), intent(in) :: & + p_lev ! Pressure @ model layer interface (Pa) + + ! Outputs + real(kind_phys), dimension(ncol, Model%levs, NF_CLDS),intent(out) :: & + clouds ! Cloud properties (NCOL,Model%levs,NF_CLDS) + integer,dimension(ncol,3), intent(out) :: & + mbota, & ! Vertical indices for low, mid, hi cloud bases (NCOL,3) + mtopa ! Vertical indices for low, mid, hi cloud tops (NCOL,3) + real(kind_phys), dimension(ncol), intent(out) ::& + de_lgth ! Clouds decorrelation length (km) + real(kind_phys), dimension(ncol, 5), intent(out) :: & + cldsa ! Fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + + ! Local variables + real(kind_phys), dimension(ncol, Model%levs, Model%ncnd) :: cld_condensate + integer :: i,k + real(kind_phys), parameter :: xrc3 = 100. + real(kind_phys), dimension(ncol, Model%levs) :: delta_q, cnv_w, cnv_c, effr_l, & + effr_i, effr_r, effr_s, cldcov + + ! ####################################################################################### + ! Obtain cloud information for radiation calculations + ! (clouds,cldsa,mtopa,mbota) + ! for prognostic cloud: + ! - For Zhao/Moorthi's prognostic cloud scheme, + ! call module_radiation_clouds::progcld1() + ! - For Zhao/Moorthi's prognostic cloud+pdfcld, + ! call module_radiation_clouds::progcld3() + ! call module_radiation_clouds::progclduni() for unified cloud and ncld=2 + ! ####################################################################################### + cld_condensate = 0.0_kind_phys + if (Model%ncnd == 1) then ! Zhao_Carr_Sundqvist + cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water/ice + elseif (Model%ncnd == 2) then ! MG + cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water + cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water + elseif (Model%ncnd == 4) then ! MG2 + cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water + cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water + cld_condensate(1:NCOL,1:Model%levs,3) = tracer(1:NCOL,1:Model%levs,Model%ntrw) ! -rain water + cld_condensate(1:NCOL,1:Model%levs,4) = tracer(1:NCOL,1:Model%levs,Model%ntsw) ! -snow water + elseif (Model%ncnd == 5) then ! GFDL MP, Thompson, MG3 + cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water + cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water + cld_condensate(1:NCOL,1:Model%levs,3) = tracer(1:NCOL,1:Model%levs,Model%ntrw) ! -rain water + cld_condensate(1:NCOL,1:Model%levs,4) = tracer(1:NCOL,1:Model%levs,Model%ntsw) + & ! -snow + grapuel + tracer(1:NCOL,1:Model%levs,Model%ntgl) + endif + where(cld_condensate < epsq) cld_condensate = 0.0 + + ! For GFDL microphysics scheme... + if (Model%imp_physics == 11 ) then + if (.not. Model%lgfdlmprad) then + cld_condensate(:,:,1) = tracer(:,1:Model%levs,Model%ntcw) + cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntrw) + cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntiw) + cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntsw) + cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntgl) + endif + do k=1,Model%levs + do i=1,NCOL + if (cld_condensate(i,k,1) < EPSQ ) cld_condensate(i,k,1) = 0.0 + enddo + enddo + endif + + if (Model%uni_cld) then + if (Model%effr_in) then + cldcov(:,:) = Tbd%phy_f3d(:,:,Model%indcld) + effr_l(:,:) = Tbd%phy_f3d(:,:,2) + effr_i(:,:) = Tbd%phy_f3d(:,:,3) + effr_r(:,:) = Tbd%phy_f3d(:,:,4) + effr_s(:,:) = Tbd%phy_f3d(:,:,5) + else + do k=1,model%levs + do i=1,ncol + cldcov(i,k) = Tbd%phy_f3d(i,k,Model%indcld) + enddo + enddo + endif + elseif (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL MP + cldcov(1:NCOL,1:Model%levs) = tracer(1:NCOL,1:Model%levs,Model%ntclamt) + if (Model%effr_in) then + effr_l(:,:) = Tbd%phy_f3d(:,:,1) + effr_i(:,:) = Tbd%phy_f3d(:,:,2) + effr_r(:,:) = Tbd%phy_f3d(:,:,3) + effr_s(:,:) = Tbd%phy_f3d(:,:,4) + endif + else ! neither of the other two cases + cldcov = 0.0 + endif + + + ! Add suspended convective cloud water to grid-scale cloud water + ! only for cloud fraction & radiation computation it is to enhance + ! cloudiness due to suspended convec cloud water for zhao/moorthi's + ! (imp_phys=99) & ferrier's (imp_phys=5) microphysics schemes + if ((Model%num_p3d == 4) .and. (Model%npdf3d == 3)) then ! same as Model%imp_physics = 99 + delta_q(1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,5) + cnv_w (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,6) + cnv_c (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,7) + elseif ((Model%npdf3d == 0) .and. (Model%ncnvcld3d == 1)) then ! same as MOdel%imp_physics=98 + delta_q(1:ncol,1:Model%levs) = 0.0 + cnv_w (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,1:Model%levs,Model%num_p3d+1) + cnv_c (1:ncol,1:Model%levs) = 0.0 + else ! all the rest + delta_q(1:ncol,1:Model%levs) = 0.0 + cnv_w (1:ncol,1:Model%levs) = 0.0 + cnv_c (1:ncol,1:Model%levs) = 0.0 + endif + + ! For zhao/moorthi's prognostic cloud scheme, add in convective cloud water to liquid-cloud water + if (Model%imp_physics == 99) then + cld_condensate(1:NCOL,1:Model%levs,1) = cld_condensate(1:NCOL,1:Model%levs,1) + cnv_w(1:NCOL,1:Model%levs) + endif + + ! For MG prognostic cloud scheme, add in convective cloud water to liquid-and-ice-cloud condensate + if (Model%imp_physics == 10) then + cld_condensate(1:NCOL,1:Model%levs,1) = cld_condensate(1:NCOL,1:Model%levs,1) + cnv_w(1:NCOL,1:Model%levs) + cld_condensate(1:NCOL,1:Model%levs,2) + endif + + ! ####################################################################################### + ! MICROPHYSICS + ! ####################################################################################### + ! *) zhao/moorthi's prognostic cloud scheme or unified cloud and/or with MG microphysics + if (Model%imp_physics == 99 .or. Model%imp_physics == 10) then + if (Model%uni_cld .and. Model%ncld >= 2) then + call progclduni( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + cld_condensate, & ! IN - Cloud condensate amount (Model%ncnd types) () + Model%ncnd, & ! IN - Number of cloud condensate types () + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) + effr_l, & ! IN - Liquid-water effective radius (microns) + effr_i, & ! IN - Ice-water effective radius (microns) + effr_r, & ! IN - Rain-water effective radius (microns) + effr_s, & ! IN - Snow-water effective radius (microns) + Model%effr_in, & ! IN - Logical, if .true. use input effective radii + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + else + call progcld1 ( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + q_lay, & ! IN - Specific humidity at layer center (kg/kg) + qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) + relhum, & ! IN - Relative humidity at layer center (1) + cld_condensate(:,:,1),& ! IN - Cloud condensate amount () + ! (Zhao: liq+convective; MG: liq+ice+convective) + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + Model%uni_cld, & ! IN - True for cloud fraction from shoc + Model%lmfshal, & ! IN - True for mass flux shallow convection + Model%lmfdeep2, & ! IN - True for mass flux deep convection + cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) + effr_l, & ! IN - Liquid-water effective radius (microns) + effr_i, & ! IN - Ice-water effective radius (microns) + effr_r, & ! IN - Rain-water effective radius (microns) + effr_s, & ! IN - Snow-water effective radius (microns) + Model%effr_in, & ! IN - Logical, if .true. use input effective radii + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + endif + ! *) zhao/moorthi's prognostic cloud+pdfcld + elseif(Model%imp_physics == 98) then + call progcld3 ( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + q_lay, & ! IN - Specific humidity at layer center (kg/kg) + qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) + relhum, & ! IN - Relative humidity at layer center (1) + cld_condensate(:,:,1),& ! IN - Cloud condensate amount (only h20) () + cnv_w, & ! IN - Layer convective cloud condensate + cnv_c, & ! IN - Layer convective cloud cover + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + delta_q, & ! IN - Total water distribution width + Model%sup, & ! IN - ??? Supersaturation? + Model%kdt, & ! IN - ??? + Model%me, & ! IN - ??? NOT USED IN PROGCLD3() + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + ! *) GFDL cloud scheme + elseif (Model%imp_physics == 11) then + if (.not.Model%lgfdlmprad) then + call progcld4 ( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + q_lay, & ! IN - Specific humidity at layer center (kg/kg) + qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) + relhum, & ! IN - Relative humidity at layer center (1) + cld_condensate(:,:,1),& ! IN - Cloud condensate amount (only h20) () + cnv_w, & ! IN - Layer convective cloud condensate + cnv_c, & ! IN - Layer convective cloud cover + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + else + call progclduni( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + cld_condensate, & ! IN - Cloud condensate amount (Model%ncnd types) () + Model%ncnd, & ! IN - Number of cloud condensate types () + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) + effr_l, & ! IN - Liquid-water effective radius (microns) + effr_i, & ! IN - Ice-water effective radius (microns) + effr_r, & ! IN - Rain-water effective radius (microns) + effr_s, & ! IN - Snow-water effective radius (microns) + Model%effr_in, & ! IN - Logical, if .true. use input effective radii + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + endif + ! *) Thompson / WSM6 cloud micrphysics scheme + elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then + + call progcld5 ( & ! IN + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + q_lay, & ! IN - Specific humidity at layer center (kg/kg) + qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) + relhum, & ! IN - Relative humidity at layer center (1) + tracer, & ! IN - Cloud condensate amount in layer by type () + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + Model%ntrac-1, & ! IN - Number of tracers + Model%ntcw-1, & ! IN - Tracer index for cloud condensate (or liquid water) + Model%ntiw-1, & ! IN - Tracer index for ice + Model%ntrw-1, & ! IN - Tracer index for rain + Model%ntsw-1, & ! IN - Tracer index for snow + Model%ntgl-1, & ! IN - Tracer index for groupel + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + Model%uni_cld, & ! IN - True for cloud fraction from shoc + Model%lmfshal, & ! IN - True for mass flux shallow convection + Model%lmfdeep2, & ! IN - True for mass flux deep convection + cldcov(:,1:Model%levs), & ! IN - Layer cloud fraction (used if uni_cld=.true.) + Tbd%phy_f3d(:,:,1), & ! IN - Liquid-water effective radius (microns) + Tbd%phy_f3d(:,:,2), & ! IN - Ice-water effective radius (microns) + Tbd%phy_f3d(:,:,3), & ! IN - LSnow-water effective radius (microns) + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + endif ! end if_imp_physics + end subroutine cloud_microphysics + ! +end module GFS_rrtmgp_pre diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta new file mode 100644 index 000000000..c80098709 --- /dev/null +++ b/physics/GFS_rrtmgp_pre.meta @@ -0,0 +1,375 @@ +[ccpp-arg-table] + name = GFS_rrtmgp_pre_init + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = inout + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + 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 = GFS_rrtmgp_pre_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in + optional = F +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[sec_diff_byband] + standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band + long_name = secant of diffusivity angle in each RRTMGP LW band + units = none + dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[t_lev] + standard_name = air_temperature_at_interface_for_RRTMGP + long_name = air temperature at vertical interface for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = out + optional = F +[gas_concentrations] + standard_name = Gas_concentrations_for_RRTMGP_suite + long_name = DDT containing gas concentrations for RRTMGP radiation scheme + units = DDT + dimensions = () + type = ty_gas_concs + 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 = GFS_rrtmgp_pre_finalize + type = scheme diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 new file mode 100644 index 000000000..42ce8662c --- /dev/null +++ b/physics/GFS_rrtmgp_setup.F90 @@ -0,0 +1,609 @@ +!> \file GFS_rrtmgp_setup.f90 +!! This file contains +module GFS_rrtmgp_setup + + use physparam, only : & + isolar, ictmflg, ico2flg, ioznflg, iaerflg, iaermdl, icldflg, & + iovrsw, iovrlw, lcrick, lcnorm, lnoprec, ialbflg, iemsflg, & + isubcsw, isubclw, ivflip , ipsd0, iswcliq + use machine, only: & + kind_phys ! Working type + use GFS_typedefs, only: & + GFS_control_type ! Model control parameters + implicit none + + public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_run, GFS_rrtmgp_setup_finalize + + private + + logical :: is_initialized = .false. + + ! Version tag and last revision date + character(40), parameter :: & + VTAGRAD='NCEP-RRTMGP_driver v1.0 Sep 2019 ' + + ! Defaults + !> new data input control variables (set/reset in subroutines radinit/radupdate): + integer :: month0 = 0 + integer :: iyear0 = 0 + integer :: monthd = 0 + + !> control flag for the first time of reading climatological ozone data + !! (set/reset in subroutines radinit/radupdate, it is used only if the + !! control parameter ioznflg=0) + logical :: loz1st = .true. + + contains +!> \defgroup GFS_rrtmgp_setup GFS RRTMGP Scheme Setup +!! @{ +!! \section arg_table_GFS_rrtmgp_setup_init +!! \htmlinclude GFS_rrtmgp_setup.html +!! + subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & + iaer, ialb, iems, ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, & + isubc_sw, isubc_lw, icliq_sw, crick_proof, ccnorm, imp_physics, & + norad_precip, idate, iflip, me, & + errmsg, errflg) + implicit none + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT containing model control parameters + real(kind_phys), dimension(levr+1), intent(in) :: & + si + integer, intent(in) :: levr, ictm, isol, ico2, iaer, ialb, iems, & + ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, isubc_sw, isubc_lw, & + icliq_sw, imp_physics, iflip, me + logical, intent(in) :: & + crick_proof, ccnorm, norad_precip + integer, intent(in), dimension(4) :: & + idate + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + if (is_initialized) return + + ! Set radiation parameters + isolar = isol ! solar constant control flag + ictmflg = ictm ! data ic time/date control flag + ico2flg = ico2 ! co2 data source control flag + ioznflg = ntoz ! ozone data source control flag + iswcliq = icliq_sw ! optical property for liquid clouds for sw + iovrsw = iovr_sw ! cloud overlapping control flag for sw + iovrlw = iovr_lw ! cloud overlapping control flag for lw + lcrick = crick_proof ! control flag for eliminating CRICK + lcnorm = ccnorm ! control flag for in-cld condensate + lnoprec = norad_precip ! precip effect on radiation flag (ferrier microphysics) + isubcsw = isubc_sw ! sub-column cloud approx flag in sw radiation + isubclw = isubc_lw ! sub-column cloud approx flag in lw radiation + ialbflg = ialb ! surface albedo control flag + iemsflg = iems ! surface emissivity control flag + ivflip = iflip ! vertical index direction control flag + + if ( ictm==0 .or. ictm==-2 ) then + iaerflg = mod(iaer, 100) ! no volcanic aerosols for clim hindcast + else + iaerflg = mod(iaer, 1000) + endif + iaermdl = iaer/1000 ! control flag for aerosol scheme selection + if ( iaermdl < 0 .or. (iaermdl>2 .and. iaermdl/=5) ) then + print *, ' Error -- IAER flag is incorrect, Abort' + stop 7777 + endif + + !if ( ntcw > 0 ) then + icldflg = 1 ! prognostic cloud optical prop scheme + !else + ! icldflg = 0 ! no support for diag cloud opt prop scheme + !endif + + ! Set initial permutation seed for mcica cloud-radiation + if ( isubc_sw>0 .or. isubc_lw>0 ) then + ipsd0 = 17*idate(1)+43*idate(2)+37*idate(3)+23*idate(4) + endif + + if ( me == 0 ) then + print *,' In rad_initialize (GFS_rrtmgp_setup_init), before calling radinit' + print *,' si =',si + print *,' levr=',levr,' ictm=',ictm,' isol=',isol,' ico2=',ico2,& + ' iaer=',iaer,' ialb=',ialb,' iems=',iems,' ntcw=',ntcw + print *,' np3d=',num_p3d,' ntoz=',ntoz,' iovr_sw=',iovr_sw, & + ' iovr_lw=',iovr_lw,' isubc_sw=',isubc_sw, & + ' isubc_lw=',isubc_lw,' icliq_sw=',icliq_sw, & + ' iflip=',iflip,' me=',me + print *,' crick_proof=',crick_proof, & + ' ccnorm=',ccnorm,' norad_precip=',norad_precip + endif + + ! Hack for using RRTMGP-Sw and RRTMG-LW + if (.not. Model%do_GPsw_Glw) then + call radinit( si, levr, imp_physics, me ) + endif + + if ( me == 0 ) then + print *,' Radiation sub-cloud initial seed =',ipsd0, & + ' IC-idate =',idate + print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit' + endif + + is_initialized = .true. + return + end subroutine GFS_rrtmgp_setup_init + +!> \section arg_table_GFS_rrtmgp_setup_run +!! \htmlinclude GFS_rrtmgp_setup.html +!! + subroutine GFS_rrtmgp_setup_run (idate, jdate, deltsw, deltim, lsswr, me, & + slag, sdec, cdec, solcon, errmsg, errflg) + + implicit none + + ! interface variables + integer, intent(in) :: idate(:) + integer, intent(in) :: jdate(:) + real(kind=kind_phys), intent(in) :: deltsw + real(kind=kind_phys), intent(in) :: deltim + logical, intent(in) :: lsswr + integer, intent(in) :: me + real(kind=kind_phys), intent(out) :: slag + real(kind=kind_phys), intent(out) :: sdec + real(kind=kind_phys), intent(out) :: cdec + real(kind=kind_phys), intent(out) :: solcon + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Check initialization state + if (.not.is_initialized) then + write(errmsg, fmt='((a))') 'GFS_rrtmgp_setup_run called before GFS_rrtmgp_setup_init' + errflg = 1 + return + end if + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + call radupdate(idate,jdate,deltsw,deltim,lsswr,me, & + slag,sdec,cdec,solcon) + + end subroutine GFS_rrtmgp_setup_run + + !> \section arg_table_GFS_rrtmgp_setup_finalize + !! \htmlinclude GFS_rrtmgp_setup.html + !! + subroutine GFS_rrtmgp_setup_finalize (errmsg, errflg) + + implicit none + + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + ! do finalization stuff if needed + + is_initialized = .false. + + end subroutine GFS_rrtmgp_setup_finalize + + + ! Private functions + + + subroutine radinit( si, NLAY, imp_physics, me ) + !................................... + +! --- inputs: +! & ( si, NLAY, imp_physics, me ) +! --- outputs: +! ( none ) + +! ================= subprogram documentation block ================ ! +! ! +! subprogram: radinit initialization of radiation calculations ! +! ! +! usage: call radinit ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: wcoss ! +! ! +! ==================== definition of variables ==================== ! +! ! +! input parameters: ! +! si : model vertical sigma interface ! +! NLAY : number of model vertical layers ! +! imp_physics : MP identifier ! +! me : print control flag ! +! ! +! outputs: (none) ! +! ! +! external module variables: (in module physparam) ! +! isolar : solar constant cntrol flag ! +! = 0: use the old fixed solar constant in "physcon" ! +! =10: use the new fixed solar constant in "physcon" ! +! = 1: use noaa ann-mean tsi tbl abs-scale with cycle apprx! +! = 2: use noaa ann-mean tsi tbl tim-scale with cycle apprx! +! = 3: use cmip5 ann-mean tsi tbl tim-scale with cycl apprx! +! = 4: use cmip5 mon-mean tsi tbl tim-scale with cycl apprx! +! iaerflg : 3-digit aerosol flag (abc for volc, lw, sw) ! +! a:=0 use background stratospheric aerosol ! +! =1 include stratospheric vocanic aeros ! +! b:=0 no topospheric aerosol in lw radiation ! +! =1 compute tropspheric aero in 1 broad band for lw ! +! =2 compute tropspheric aero in multi bands for lw ! +! c:=0 no topospheric aerosol in sw radiation ! +! =1 include tropspheric aerosols for sw ! +! ico2flg : co2 data source control flag ! +! =0: use prescribed global mean co2 (old oper) ! +! =1: use observed co2 annual mean value only ! +! =2: use obs co2 monthly data with 2-d variation ! +! ictmflg : =yyyy#, external data ic time/date control flag ! +! = -2: same as 0, but superimpose seasonal cycle ! +! from climatology data set. ! +! = -1: use user provided external data for the ! +! forecast time, no extrapolation. ! +! = 0: use data at initial cond time, if not ! +! available, use latest, no extrapolation. ! +! = 1: use data at the forecast time, if not ! +! available, use latest and extrapolation. ! +! =yyyy0: use yyyy data for the forecast time, ! +! no further data extrapolation. ! +! =yyyy1: use yyyy data for the fcst. if needed, do ! +! extrapolation to match the fcst time. ! +! ioznflg : ozone data source control flag ! +! =0: use climatological ozone profile ! +! =1: use interactive ozone profile ! +! ialbflg : albedo scheme control flag ! +! =0: climatology, based on surface veg types ! +! =1: modis retrieval based surface albedo scheme ! +! iemsflg : emissivity scheme cntrl flag (ab 2-digit integer) ! +! a:=0 set sfc air/ground t same for lw radiation ! +! =1 set sfc air/ground t diff for lw radiation ! +! b:=0 use fixed sfc emissivity=1.0 (black-body) ! +! =1 use varying climtology sfc emiss (veg based) ! +! =2 future development (not yet) ! +! icldflg : cloud optical property scheme control flag ! +! =0: use diagnostic cloud scheme ! +! =1: use prognostic cloud scheme (default) ! +! imp_physics : cloud microphysics scheme control flag ! +! =99 zhao/carr/sundqvist microphysics scheme ! +! =98 zhao/carr/sundqvist microphysics+pdf cloud&cnvc,cnvw ! +! =11 GFDL cloud microphysics ! +! =8 Thompson microphysics scheme ! +! =6 WSM6 microphysics scheme ! +! =10 MG microphysics scheme ! +! iovrsw : control flag for cloud overlap in sw radiation ! +! iovrlw : control flag for cloud overlap in lw radiation ! +! =0: random overlapping clouds ! +! =1: max/ran overlapping clouds ! +! isubcsw : sub-column cloud approx control flag in sw radiation ! +! isubclw : sub-column cloud approx control flag in lw radiation ! +! =0: with out sub-column cloud approximation ! +! =1: mcica sub-col approx. prescribed random seed ! +! =2: mcica sub-col approx. provided random seed ! +! lcrick : control flag for eliminating CRICK ! +! =t: apply layer smoothing to eliminate CRICK ! +! =f: do not apply layer smoothing ! +! lcnorm : control flag for in-cld condensate ! +! =t: normalize cloud condensate ! +! =f: not normalize cloud condensate ! +! lnoprec : precip effect in radiation flag (ferrier microphysics) ! +! =t: snow/rain has no impact on radiation ! +! =f: snow/rain has impact on radiation ! +! ivflip : vertical index direction control flag ! +! =0: index from toa to surface ! +! =1: index from surface to toa ! +! ! +! subroutines called: sol_init, aer_init, gas_init, cld_init, ! +! sfc_init, rlwinit, rswinit ! +! ! +! usage: call radinit ! +! ! +! =================================================================== ! +! + + use module_radiation_astronomy, only : sol_init + use module_radiation_aerosols, only : aer_init + use module_radiation_gases, only : gas_init + use module_radiation_surface, only : sfc_init + use module_radiation_clouds, only : cld_init + + implicit none + +! --- inputs: + integer, intent(in) :: NLAY, me, imp_physics + + real (kind=kind_phys), intent(in) :: si(:) + +! --- outputs: (none, to module variables) + +! --- locals: + +! +!===> ... begin here +! +!> -# Set up control variables and external module variables in +!! module physparam +#if 0 + ! GFS_radiation_driver.F90 may in the future initialize air/ground + ! temperature differently; however, this is not used at the moment + ! and as such we avoid the difficulty of dealing with exchanging + ! itsfc between GFS_rrtmgp_setup and a yet-to-be-created/-used + ! interstitial routine (or GFS_radiation_driver.F90) + itsfc = iemsflg / 10 ! sfc air/ground temp control +#endif + loz1st = (ioznflg == 0) ! first-time clim ozone data read flag + month0 = 0 + iyear0 = 0 + monthd = 0 + + if (me == 0) then +! print *,' NEW RADIATION PROGRAM STRUCTURES -- SEP 01 2004' + print *,' NEW RADIATION PROGRAM STRUCTURES BECAME OPER. ', & + & ' May 01 2007' + print *, VTAGRAD !print out version tag + print *,' - Selected Control Flag settings: ICTMflg=',ictmflg, & + & ' ISOLar =',isolar, ' ICO2flg=',ico2flg,' IAERflg=',iaerflg, & + & ' IALBflg=',ialbflg,' IEMSflg=',iemsflg,' ICLDflg=',icldflg, & + & ' IMP_PHYSICS=',imp_physics,' IOZNflg=',ioznflg + print *,' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw, & + & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw +! write(0,*)' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw,& +! & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw + print *,' LCRICK=',lcrick,' LCNORM=',lcnorm,' LNOPREC=',lnoprec + + if ( ictmflg==0 .or. ictmflg==-2 ) then + print *,' Data usage is limited by initial condition!' + print *,' No volcanic aerosols' + endif + + if ( isubclw == 0 ) then + print *,' - ISUBCLW=',isubclw,' No McICA, use grid ', & + & 'averaged cloud in LW radiation' + elseif ( isubclw == 1 ) then + print *,' - ISUBCLW=',isubclw,' Use McICA with fixed ', & + & 'permutation seeds for LW random number generator' + elseif ( isubclw == 2 ) then + print *,' - ISUBCLW=',isubclw,' Use McICA with random ', & + & 'permutation seeds for LW random number generator' + else + print *,' - ERROR!!! ISUBCLW=',isubclw,' is not a ', & + & 'valid option ' + stop + endif + + if ( isubcsw == 0 ) then + print *,' - ISUBCSW=',isubcsw,' No McICA, use grid ', & + & 'averaged cloud in SW radiation' + elseif ( isubcsw == 1 ) then + print *,' - ISUBCSW=',isubcsw,' Use McICA with fixed ', & + & 'permutation seeds for SW random number generator' + elseif ( isubcsw == 2 ) then + print *,' - ISUBCSW=',isubcsw,' Use McICA with random ', & + & 'permutation seeds for SW random number generator' + else + print *,' - ERROR!!! ISUBCSW=',isubcsw,' is not a ', & + & 'valid option ' + stop + endif + + if ( isubcsw /= isubclw ) then + print *,' - *** Notice *** ISUBCSW /= ISUBCLW !!!', & + & isubcsw, isubclw + endif + endif + + ! Initialization + + call sol_init ( me ) ! --- ... astronomy initialization routine + call aer_init ( NLAY, me ) ! --- ... aerosols initialization routine + call gas_init ( me ) ! --- ... co2 and other gases initialization routine + call sfc_init ( me ) ! --- ... surface initialization routine + call cld_init ( si, NLAY, imp_physics, me) ! --- ... cloud initialization routine + + return + !................................... + end subroutine radinit + !----------------------------------- + +!> This subroutine checks and updates time sensitive data used by +!! radiation computations. This subroutine needs to be placed inside +!! the time advancement loop but outside of the horizontal grid loop. +!! It is invoked at radiation calling frequncy but before any actual +!! radiative transfer computations. +!! \param idate NCEP absolute date and time of intial condition +!! (year,month,day,time-zone,hour,minute,second, +!! mil-second) +!! \param jdate NCEP absolute date and time at forecast time +!! (year,month,day,time-zone,hour,minute,second, +!! mil-second) +!! \param deltsw SW radiation calling time interval in seconds +!! \param deltim model advancing time-step duration in seconds +!! \param lsswr logical control flag for SW radiation calculations +!! \param me print control flag +!! \param slag equation of time in radians +!! \param sdec,cdec sine and cosine of the solar declination angle +!! \param solcon solar constant adjusted by sun-earth distance \f$(W/m^2)\f$ +!> \section gen_radupdate General Algorithm +!> @{ +!----------------------------------- + subroutine radupdate( idate,jdate,deltsw,deltim,lsswr, me, & + & slag,sdec,cdec,solcon) +!................................... + +! ================= subprogram documentation block ================ ! +! ! +! subprogram: radupdate calls many update subroutines to check and ! +! update radiation required but time varying data sets and module ! +! variables. ! +! ! +! usage: call radupdate ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: ibm sp ! +! ! +! ==================== definition of variables ==================== ! +! ! +! input parameters: ! +! idate(8) : ncep absolute date and time of initial condition ! +! (yr, mon, day, t-zone, hr, min, sec, mil-sec) ! +! jdate(8) : ncep absolute date and time at fcst time ! +! (yr, mon, day, t-zone, hr, min, sec, mil-sec) ! +! deltsw : sw radiation calling frequency in seconds ! +! deltim : model timestep in seconds ! +! lsswr : logical flags for sw radiation calculations ! +! me : print control flag ! +! ! +! outputs: ! +! slag : equation of time in radians ! +! sdec, cdec : sin and cos of the solar declination angle ! +! solcon : sun-earth distance adjusted solar constant (w/m2) ! +! ! +! external module variables: ! +! isolar : solar constant cntrl (in module physparam) ! +! = 0: use the old fixed solar constant in "physcon" ! +! =10: use the new fixed solar constant in "physcon" ! +! = 1: use noaa ann-mean tsi tbl abs-scale with cycle apprx! +! = 2: use noaa ann-mean tsi tbl tim-scale with cycle apprx! +! = 3: use cmip5 ann-mean tsi tbl tim-scale with cycl apprx! +! = 4: use cmip5 mon-mean tsi tbl tim-scale with cycl apprx! +! ictmflg : =yyyy#, external data ic time/date control flag ! +! = -2: same as 0, but superimpose seasonal cycle ! +! from climatology data set. ! +! = -1: use user provided external data for the ! +! forecast time, no extrapolation. ! +! = 0: use data at initial cond time, if not ! +! available, use latest, no extrapolation. ! +! = 1: use data at the forecast time, if not ! +! available, use latest and extrapolation. ! +! =yyyy0: use yyyy data for the forecast time, ! +! no further data extrapolation. ! +! =yyyy1: use yyyy data for the fcst. if needed, do ! +! extrapolation to match the fcst time. ! +! ! +! module variables: ! +! loz1st : first-time clim ozone data read flag ! +! ! +! subroutines called: sol_update, aer_update, gas_update ! +! ! +! =================================================================== ! +! + use module_radiation_astronomy, only : sol_update + use module_radiation_aerosols, only : aer_update + use module_radiation_gases, only : gas_update + + implicit none + +! --- inputs: + integer, intent(in) :: idate(:), jdate(:), me + logical, intent(in) :: lsswr + + real (kind=kind_phys), intent(in) :: deltsw, deltim + +! --- outputs: + real (kind=kind_phys), intent(out) :: slag, sdec, cdec, solcon + +! --- locals: + integer :: iyear, imon, iday, ihour + integer :: kyear, kmon, kday, khour + + logical :: lmon_chg ! month change flag + logical :: lco2_chg ! cntrl flag for updating co2 data + logical :: lsol_chg ! cntrl flag for updating solar constant +! +!===> ... begin here +! +!> -# Set up time stamp at fcst time and that for green house gases +!! (currently co2 only) +! --- ... time stamp at fcst time + + iyear = jdate(1) + imon = jdate(2) + iday = jdate(3) + ihour = jdate(5) + +! --- ... set up time stamp used for green house gases (** currently co2 only) + + if ( ictmflg==0 .or. ictmflg==-2 ) then ! get external data at initial condition time + kyear = idate(1) + kmon = idate(2) + kday = idate(3) + khour = idate(5) + else ! get external data at fcst or specified time + kyear = iyear + kmon = imon + kday = iday + khour = ihour + endif ! end if_ictmflg_block + + if ( month0 /= imon ) then + lmon_chg = .true. + month0 = imon + else + lmon_chg = .false. + endif + +!> -# Call module_radiation_astronomy::sol_update(), yearly update, no +!! time interpolation. + if (lsswr) then + + if ( isolar == 0 .or. isolar == 10 ) then + lsol_chg = .false. + elseif ( iyear0 /= iyear ) then + lsol_chg = .true. + else + lsol_chg = ( isolar==4 .and. lmon_chg ) + endif + iyear0 = iyear + + call sol_update & +! --- inputs: + & ( jdate,kyear,deltsw,deltim,lsol_chg, me, & +! --- outputs: + & slag,sdec,cdec,solcon & + & ) + + endif ! end_if_lsswr_block + +!> -# Call module_radiation_aerosols::aer_update(), monthly update, no +!! time interpolation + if ( lmon_chg ) then + call aer_update ( iyear, imon, me ) + endif + +!> -# Call co2 and other gases update routine: +!! module_radiation_gases::gas_update() + if ( monthd /= kmon ) then + monthd = kmon + lco2_chg = .true. + else + lco2_chg = .false. + endif + + call gas_update ( kyear,kmon,kday,khour,loz1st,lco2_chg, me ) + + if ( loz1st ) loz1st = .false. + +!> -# Call surface update routine (currently not needed) +! call sfc_update ( iyear, imon, me ) + +!> -# Call clouds update routine (currently not needed) +! call cld_update ( iyear, imon, me ) +! + return +!................................... + end subroutine radupdate +!----------------------------------- + +!! @} +end module GFS_rrtmgp_setup diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta new file mode 100644 index 000000000..e40ad865a --- /dev/null +++ b/physics/GFS_rrtmgp_setup.meta @@ -0,0 +1,343 @@ +[ccpp-arg-table] + name = GFS_rrtmgp_setup_init + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[si] + standard_name = vertical_sigma_coordinate_for_radiation_initialization + long_name = vertical sigma coordinate for radiation initialization + units = none + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[levr] + standard_name = number_of_vertical_layers_for_radiation_calculations + long_name = number of vertical levels for radiation calculations + units = count + dimensions = () + type = integer + intent = in + optional = F +[ictm] + standard_name = flag_for_initial_time_date_control + long_name = flag for initial conditions and forcing + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isol] + standard_name = flag_for_solar_constant + long_name = use prescribed solar constant + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ico2] + standard_name = flag_for_using_prescribed_global_mean_co2_value + long_name = prescribed global mean value (old opernl) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iaer] + standard_name = flag_for_default_aerosol_effect_in_shortwave_radiation + long_name = default aerosol effect in sw only + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ialb] + standard_name = flag_for_using_climatology_albedo + long_name = flag for using climatology alb, based on sfc type + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iems] + standard_name = flag_for_surface_emissivity_control + long_name = surface emissivity control flag, use fixed value of 1 + units = flag + 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 +[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 +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[iovr_sw] + standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation + long_name = sw: max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_lw] + standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation + long_name = lw: max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isubc_sw] + standard_name = flag_for_sw_clouds_without_sub_grid_approximation + long_name = flag for sw clouds without sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isubc_lw] + standard_name = flag_for_lw_clouds_without_sub_grid_approximation + long_name = flag for lw clouds without sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[icliq_sw] + standard_name = flag_for_optical_property_for_liquid_clouds_for_shortwave_radiation + long_name = sw optical property for liquid clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[crick_proof] + standard_name = flag_for_CRICK_proof_cloud_water + long_name = flag for CRICK-Proof cloud water + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ccnorm] + standard_name = flag_for_cloud_condensate_normalized_by_cloud_cover + long_name = flag for cloud condensate normalized by cloud cover + 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 +[norad_precip] + standard_name = flag_for_precipitation_effect_on_radiation + long_name = radiation precip flag for Ferrier/Moorthi + units = flag + dimensions = () + type = logical + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initialization date and time + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[iflip] + standard_name = flag_for_vertical_index_direction_control + long_name = flag for vertical index direction control + units = flag + 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 + 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 = GFS_rrtmgp_setup_run + type = scheme +[idate] + standard_name = date_and_time_at_model_initialization + long_name = initialization date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[jdate] + standard_name = forecast_date_and_time + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[deltsw] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[deltim] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + 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 +[slag] + standard_name = equation_of_time + long_name = equation of time (radian) + units = radians + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[sdec] + standard_name = sine_of_solar_declination_angle + long_name = sin of the solar declination angle + units = none + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[cdec] + standard_name = cosine_of_solar_declination_angle + long_name = cos of the solar declination angle + units = none + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[solcon] + standard_name = solar_constant + long_name = solar constant (sun-earth distant adjusted) + units = W m-2 + dimensions = () + 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 = GFS_rrtmgp_setup_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 diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 new file mode 100644 index 000000000..7d4e6ba6b --- /dev/null +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -0,0 +1,307 @@ +module GFS_rrtmgp_sw_post + use machine, only: kind_phys + use GFS_typedefs, only: GFS_coupling_type, GFS_control_type, GFS_grid_type, & + GFS_radtend_type, GFS_diag_type, GFS_statein_type + use module_radiation_aerosols, only: NSPC1 + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, profsw_type, cmpfsw_type + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_heating_rates, only: compute_heating_rate + use rrtmgp_aux, only: check_error_msg + implicit none + + public GFS_rrtmgp_sw_post_init,GFS_rrtmgp_sw_post_run,GFS_rrtmgp_sw_post_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_post_init + ! ######################################################################################### + subroutine GFS_rrtmgp_sw_post_init() + end subroutine GFS_rrtmgp_sw_post_init + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_post_run + ! ######################################################################################### +!> \section arg_table_GFS_rrtmgp_sw_post_run +!! \htmlinclude GFS_rrtmgp_sw_post.html +!! + subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein, scmpsw, & + nCol, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, & + sw_gas_props, nday, idxday, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, & + fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, mtopa, cld_frac, cldtausw, flxprf_sw,& + hsw0, errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! Fortran DDT: FV3-GFS model control parameters + type(GFS_grid_type), intent(in) :: & + Grid ! Fortran DDT: FV3-GFS grid and interpolation related data + type(GFS_coupling_type), intent(inout) :: & + Coupling ! Fortran DDT: FV3-GFS fields to/from coupling with other components + type(GFS_radtend_type), intent(inout) :: & + Radtend ! Fortran DDT: FV3-GFS radiation tendencies + type(GFS_diag_type), intent(inout) :: & + Diag ! Fortran DDT: FV3-GFS diagnotics data + type(GFS_statein_type), intent(in) :: & + Statein ! Fortran DDT: FV3-GFS prognostic state data in from dycore + integer, intent(in) :: & + nCol, & ! Horizontal loop extent + nDay ! Number of daylit columns + integer, intent(in), dimension(nday) :: & + idxday ! Index array for daytime points + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! DDT containing SW spectral information + real(kind_phys), dimension(nCol, Model%levs+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (hPa) + real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(in) :: & + sfc_alb_nir_dir, & ! Surface albedo (direct) + sfc_alb_nir_dif, & ! Surface albedo (diffuse) + sfc_alb_uvvis_dir, & ! Surface albedo (direct) + sfc_alb_uvvis_dif ! Surface albedo (diffuse) + real(kind_phys), dimension(nCol, Model%levs+1), intent(in) :: & + fluxswUP_allsky, & ! SW All-sky flux (W/m2) + fluxswDOWN_allsky, & ! SW All-sky flux (W/m2) + fluxswUP_clrsky, & ! SW Clear-sky flux (W/m2) + fluxswDOWN_clrsky ! SW All-sky flux (W/m2) + real(kind_phys), intent(in) :: & + raddt ! Radiation time step + real(kind_phys), dimension(nCol,NSPC1), intent(in) :: & + aerodp ! Vertical integrated optical depth for various aerosol species + real(kind_phys), dimension(nCol,5), intent(in) :: & + cldsa ! Fraction of clouds for low, middle, high, total and BL + integer, dimension(nCol,3), intent(in) ::& + mbota, & ! vertical indices for low, middle and high cloud tops + mtopa ! vertical indices for low, middle and high cloud bases + real(kind_phys), dimension(nCol,Model%levs), intent(in) :: & + cld_frac, & ! Total cloud fraction in each layer + cldtausw ! approx .55mu band layer cloud optical depth + real(kind_phys),dimension(nCol, Model%levs) :: & + hswc ! All-sky heating rates (K/s) + + ! Outputs (mandatory) + character(len=*), intent(out) :: & + errmsg + integer, intent(out) :: & + errflg + + ! Outputs (optional) + real(kind_phys), dimension(nCol, Model%levs), optional, intent(inout) :: & + hsw0 ! Shortwave clear-sky heating-rate (K/sec) + type(profsw_type), dimension(nCol, Model%levs+1), intent(inout), optional :: & + flxprf_sw ! 2D radiative fluxes, components: + ! upfxc - total sky upward flux (W/m2) + ! dnfxc - total sky dnward flux (W/m2) + ! upfx0 - clear sky upward flux (W/m2) + ! dnfx0 - clear sky dnward flux (W/m2) + type(cmpfsw_type), dimension(nCol), intent(inout), optional :: & + scmpsw ! 2D surface fluxes, components: + ! uvbfc - total sky downward uv-b flux at (W/m2) + ! uvbf0 - clear sky downward uv-b flux at (W/m2) + ! nirbm - downward nir direct beam flux (W/m2) + ! nirdf - downward nir diffused flux (W/m2) + ! visbm - downward uv+vis direct beam flux (W/m2) + ! visdf - downward uv+vis diffused flux (W/m2) + ! Local variables + integer :: i, j, k, iSFC, iTOA, itop, ibtc + real(kind_phys) :: tem0d, tem1, tem2 + real(kind_phys), dimension(nDay, Model%levs) :: thetaTendClrSky, thetaTendAllSky + logical :: l_clrskysw_hr, l_fluxessw2d, top_at_1, l_sfcFluxessw1D + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Model%lsswr) return + if (nDay .gt. 0) then + + ! Are any optional outputs requested? + l_clrskysw_hr = present(hsw0) + l_fluxessw2d = present(flxprf_sw) + l_sfcfluxessw1D = present(scmpsw) + + ! ####################################################################################### + ! What is vertical ordering? + ! ####################################################################################### + top_at_1 = (p_lev(1,1) .lt. p_lev(1, Model%levs)) + if (top_at_1) then + iSFC = Model%levs+1 + iTOA = 1 + else + iSFC = 1 + iTOA = Model%levs+1 + endif + + ! ####################################################################################### + ! Compute SW heating-rates + ! ####################################################################################### + ! Clear-sky heating-rate (optional) + if (l_clrskysw_HR) then + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxswUP_clrsky(idxday(1:nDay),:), & ! IN - Shortwave upward clear-sky flux profiles (W/m2) + fluxswDOWN_clrsky(idxday(1:nDay),:), & ! IN - Shortwave downward clear-sky flux profiles (W/m2) + p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) + thetaTendClrSky)) ! OUT - Clear-sky heating-rate (K/sec) + hsw0(idxday(1:nDay),:)=thetaTendClrSky + endif + + ! All-sky heating-rate (mandatory) + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxswUP_allsky(idxday(1:nDay),:), & ! IN - Shortwave upward all-sky flux profiles (W/m2) + fluxswDOWN_allsky(idxday(1:nDay),:), & ! IN - Shortwave downward all-sky flux profiles (W/m2) + p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) + thetaTendAllSky)) ! OUT - All-sky heating-rate (K/sec) + hswc(idxday(1:nDay),:) = thetaTendAllSky + + ! Copy fluxes from RRTGMP types into model radiation types. + ! Mandatory outputs + Diag%topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) + Diag%topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) + Diag%topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) + Radtend%sfcfsw(:)%upfxc = fluxswUP_allsky(:,iSFC) + Radtend%sfcfsw(:)%upfx0 = fluxswUP_clrsky(:,iSFC) + Radtend%sfcfsw(:)%dnfxc = fluxswDOWN_allsky(:,iSFC) + Radtend%sfcfsw(:)%dnfx0 = fluxswDOWN_clrsky(:,iSFC) + + ! Optional output + if(l_fluxessw2D) then + flxprf_sw(:,:)%upfxc = fluxswUP_allsky(:,:) + flxprf_sw(:,:)%dnfxc = fluxswDOWN_allsky(:,:) + flxprf_sw(:,:)%upfx0 = fluxswUP_clrsky(:,:) + flxprf_sw(:,:)%dnfx0 = fluxswDOWN_clrsky(:,:) + endif + + ! ####################################################################################### + ! Save SW outputs + ! ####################################################################################### + ! All-sky heating rate + do k = 1, Model%levs + Radtend%htrsw(1:nCol,k) = hswc(1:nCol,k) + enddo + ! Clear-sky heating rate + if (Model%swhtr) then + do k = 1, Model%levs + Radtend%swhc(1:nCol,k) = hsw0(1:nCol,k) + enddo + endif + + ! Surface down and up spectral component fluxes + ! - Save two spectral bands' surface downward and upward fluxes for output. + do i=1,nCol + Coupling%nirbmdi(i) = scmpsw(i)%nirbm + Coupling%nirdfdi(i) = scmpsw(i)%nirdf + Coupling%visbmdi(i) = scmpsw(i)%visbm + Coupling%visdfdi(i) = scmpsw(i)%visdf + + Coupling%nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(1,i) + Coupling%nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) + Coupling%visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) + Coupling%visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) + enddo + else ! if_nday_block + ! ####################################################################################### + ! Save SW outputs + ! ####################################################################################### + Radtend%htrsw(:,:) = 0.0 + Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) + Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + + do i=1,nCol + Coupling%nirbmdi(i) = 0.0 + Coupling%nirdfdi(i) = 0.0 + Coupling%visbmdi(i) = 0.0 + Coupling%visdfdi(i) = 0.0 + + Coupling%nirbmui(i) = 0.0 + Coupling%nirdfui(i) = 0.0 + Coupling%visbmui(i) = 0.0 + Coupling%visdfui(i) = 0.0 + enddo + + if (Model%swhtr) then + Radtend%swhc(:,:) = 0 + endif + endif ! end_if_nday + + ! Radiation fluxes for other physics processes + do i=1,nCol + Coupling%sfcnsw(i) = Radtend%sfcfsw(i)%dnfxc - Radtend%sfcfsw(i)%upfxc + Coupling%sfcdsw(i) = Radtend%sfcfsw(i)%dnfxc + enddo + + ! ####################################################################################### + ! Save SW diagnostics + ! - For time averaged output quantities (including total-sky and clear-sky SW and LW + ! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base + ! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in + ! corresponding slots of array fluxr with appropriate time weights. + ! - Collect the fluxr data for wrtsfc + ! ####################################################################################### + if (Model%lssav) then + do i=1,nCol + Diag%fluxr(i,34) = Diag%fluxr(i,34) + Model%fhswr*aerodp(i,1) ! total aod at 550nm + Diag%fluxr(i,35) = Diag%fluxr(i,35) + Model%fhswr*aerodp(i,2) ! DU aod at 550nm + Diag%fluxr(i,36) = Diag%fluxr(i,36) + Model%fhswr*aerodp(i,3) ! BC aod at 550nm + Diag%fluxr(i,37) = Diag%fluxr(i,37) + Model%fhswr*aerodp(i,4) ! OC aod at 550nm + Diag%fluxr(i,38) = Diag%fluxr(i,38) + Model%fhswr*aerodp(i,5) ! SU aod at 550nm + Diag%fluxr(i,39) = Diag%fluxr(i,39) + Model%fhswr*aerodp(i,6) ! SS aod at 550nm + if (Radtend%coszen(i) > 0.) then + ! SW all-sky fluxes + tem0d = Model%fhswr * Radtend%coszdg(i) / Radtend%coszen(i) + Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + Diag%topfsw(i)%upfxc * tem0d ! total sky top sw up + Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + Radtend%sfcfsw(i)%upfxc * tem0d + Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + Radtend%sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn + ! SW uv-b fluxes + Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn + Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn + ! SW TOA incoming fluxes + Diag%fluxr(i,23) = Diag%fluxr(i,23) + Diag%topfsw(i)%dnfxc * tem0d ! top sw dn + ! SW SFC flux components + Diag%fluxr(i,24) = Diag%fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn + Diag%fluxr(i,25) = Diag%fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn + Diag%fluxr(i,26) = Diag%fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn + Diag%fluxr(i,27) = Diag%fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn + ! SW clear-sky fluxes + Diag%fluxr(i,29) = Diag%fluxr(i,29) + Diag%topfsw(i)%upfx0 * tem0d + Diag%fluxr(i,31) = Diag%fluxr(i,31) + Radtend%sfcfsw(i)%upfx0 * tem0d + Diag%fluxr(i,32) = Diag%fluxr(i,32) + Radtend%sfcfsw(i)%dnfx0 * tem0d + endif + enddo + + ! Save total and boundary-layer clouds + do i=1,nCol + Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) + Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) + enddo + + ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud + ! is reversed for the fluxr output. save interface pressure (pa) of top/bot + do j = 1, 3 + do i = 1, nCol + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) + ibtc = mbota(i,j) + Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d + Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop) + Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc) + Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) + + ! Add optical depth and emissivity output + tem1 = 0. + do k=ibtc,itop + tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel + enddo + Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 + enddo + enddo + endif + end subroutine GFS_rrtmgp_sw_post_run + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_post_finalize + ! ######################################################################################### + subroutine GFS_rrtmgp_sw_post_finalize () + end subroutine GFS_rrtmgp_sw_post_finalize + +end module GFS_rrtmgp_sw_post diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta new file mode 100644 index 000000000..a933cba89 --- /dev/null +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -0,0 +1,267 @@ +[ccpp-arg-table] + name = GFS_rrtmgp_sw_post_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type + intent = inout + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = inout + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_dimension) + type = cmpfsw_type + intent = inout + optional = T +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_nir_dir] + standard_name = surface_albedo_nearIR_direct + long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_nir_dif] + standard_name = surface_albedo_nearIR_diffuse + long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_uvvis_dir] + standard_name = surface_albedo_uvvis_dir + long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_uvvis_dif] + standard_name = surface_albedo_uvvis_dif + long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + 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 +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[fluxswUP_allsky] + standard_name = RRTMGP_sw_flux_profile_upward_allsky + long_name = RRTMGP upward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxswDOWN_allsky] + standard_name = RRTMGP_sw_flux_profile_downward_allsky + long_name = RRTMGP downward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxswUP_clrsky] + standard_name = RRTMGP_sw_flux_profile_upward_clrsky + long_name = RRTMGP upward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxswDOWN_clrsky] + standard_name = RRTMGP_sw_flux_profile_downward_clrsky + long_name = RRTMGP downward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = in + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = in + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = in + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cldtausw] + standard_name = RRTMGP_cloud_optical_depth_layers_at_0_55mu_band + long_name = approx .55mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[flxprf_sw] + standard_name = RRTMGP_sw_fluxes + long_name = sw fluxes total sky / csk and up / down at levels + units = W m-2 + dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_plus_one) + type = profsw_type + intent = inout + optional = T +[hsw0] + standard_name = RRTMGP_sw_heating_rate_clear_sky + long_name = RRTMGP shortwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[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_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 new file mode 100644 index 000000000..6987c3e4a --- /dev/null +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -0,0 +1,155 @@ +module GFS_rrtmgp_sw_pre + use physparam + use machine, only: & + kind_phys ! Working type + use GFS_typedefs, only: & + GFS_sfcprop_type, & ! Surface fields + GFS_control_type, & ! Model control parameters + GFS_grid_type, & ! Grid and interpolation related data + GFS_coupling_type, & ! + GFS_statein_type, & ! + GFS_radtend_type, & ! Radiation tendencies needed in physics + GFS_interstitial_type + use module_radiation_astronomy,only: & + coszmn ! Function to compute cos(SZA) + use module_radiation_surface, only: & + NF_ALBD, & ! Number of surface albedo categories (4; nir-direct, nir-diffuse, uvvis-direct, uvvis-diffuse) + setalb ! Routine to compute surface albedo + use surface_perturbation, only: & + cdfnor ! Routine to compute CDF (used to compute percentiles) + use mo_gas_optics_rrtmgp, only: & + ty_gas_optics_rrtmgp + public GFS_rrtmgp_sw_pre_run,GFS_rrtmgp_sw_pre_init,GFS_rrtmgp_sw_pre_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_pre_init + ! ######################################################################################### + subroutine GFS_rrtmgp_sw_pre_init () + end subroutine GFS_rrtmgp_sw_pre_init + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_pre_run + ! ######################################################################################### +!> \section arg_table_GFS_rrtmgp_sw_pre_run +!! \htmlinclude GFS_rrtmgp_sw_pre.html +!! + subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, & + tv_lay, relhum, tracer, sw_gas_props, nday, idxday, alb1d, sfc_alb_nir_dir, & + sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, RadTend, Coupling, & + errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT: FV3-GFS model control parameters + type(GFS_grid_type), intent(in) :: & + Grid ! DDT: FV3-GFS grid and interpolation related data + type(GFS_sfcprop_type), intent(in) :: & + Sfcprop ! DDT: FV3-GFS surface fields + type(GFS_statein_type), intent(in) :: & + Statein ! DDT: FV3-GFS prognostic state data in from dycore + integer, intent(in) :: & + ncol ! Number of horizontal grid points + real(kind_phys), dimension(ncol,Model%levs),intent(in) :: & + p_lay, & ! Layer pressure + tv_lay, & ! Layer virtual-temperature + relhum ! Layer relative-humidity + real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & + tracer + real(kind_phys), dimension(ncol,Model%levs+1),intent(in) :: & + p_lev ! Pressure @ layer interfaces (Pa) + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: spectral information for SW calculation + + ! Outputs + integer, intent(out) :: & + nday ! Number of daylit points + integer, dimension(ncol), intent(out) :: & + idxday ! Indices for daylit points + real(kind_phys), dimension(ncol), intent(out) :: & + alb1d ! Surface albedo pertubation + real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(out) :: & + sfc_alb_nir_dir, & ! Surface albedo (direct) + sfc_alb_nir_dif, & ! Surface albedo (diffuse) + sfc_alb_uvvis_dir, & ! Surface albedo (direct) + sfc_alb_uvvis_dif ! Surface albedo (diffuse) + type(GFS_radtend_type), intent(inout) :: & + Radtend ! DDT: FV3-GFS radiation tendencies + type(GFS_coupling_type), intent(inout) :: & + Coupling ! DDT: FV3-GFS coupling arrays + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + integer :: i, j, iCol, iBand, iLay + real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Model%lsswr) return + + ! ####################################################################################### + ! Compute cosine of zenith angle (only when SW is called) + ! ####################################################################################### + call coszmn (Grid%xlon, Grid%sinlat, Grid%coslat, Model%solhr, NCOL, Model%me, & + Radtend%coszen, Radtend%coszdg) + + ! ####################################################################################### + ! For SW gather daylit points + ! ####################################################################################### + nday = 0 + idxday = 0 + do i = 1, NCOL + if (Radtend%coszen(i) >= 0.0001) then + nday = nday + 1 + idxday(nday) = i + endif + enddo + + ! ####################################################################################### + ! mg, sfc-perts + ! --- scale random patterns for surface perturbations with perturbation size + ! --- turn vegetation fraction pattern into percentile pattern + ! ####################################################################################### + alb1d(:) = 0. + if (Model%do_sfcperts) then + if (Model%pertalb(1) > 0.) then + do i=1,ncol + call cdfnor(Coupling%sfc_wts(i,5),alb1d(i)) + enddo + endif + endif + + ! ####################################################################################### + ! Call module_radiation_surface::setalb() to setup surface albedo. + ! ####################################################################################### + call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%snoalb, Sfcprop%zorl, & + Radtend%coszen, Sfcprop%tsfc, Sfcprop%tsfc, Sfcprop%hprime(:,1), Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, & + Sfcprop%fice, Sfcprop%tisfc, NCOL, alb1d, Model%pertalb, sfcalb) + + ! Approximate mean surface albedo from vis- and nir- diffuse values. + Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + + ! Spread across all SW bands + do iBand=1,sw_gas_props%get_nband() + sfc_alb_nir_dir(iBand,1:NCOL) = sfcalb(1:NCOL,1) + sfc_alb_nir_dif(iBand,1:NCOL) = sfcalb(1:NCOL,2) + sfc_alb_uvvis_dir(iBand,1:NCOL) = sfcalb(1:NCOL,3) + sfc_alb_uvvis_dif(iBand,1:NCOL) = sfcalb(1:NCOL,4) + enddo + + end subroutine GFS_rrtmgp_sw_pre_run + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_pre_finalize + ! ######################################################################################### + subroutine GFS_rrtmgp_sw_pre_finalize () + end subroutine GFS_rrtmgp_sw_pre_finalize + +end module GFS_rrtmgp_sw_pre diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta new file mode 100644 index 000000000..73df740e1 --- /dev/null +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -0,0 +1,194 @@ +[ccpp-arg-table] + name = GFS_rrtmgp_sw_pre_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components + units = DDT + dimensions = () + type = GFS_coupling_type + intent = inout + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[alb1d] + standard_name = surface_albedo_perturbation + long_name = surface albedo perturbation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_nir_dir] + standard_name = surface_albedo_nearIR_direct + long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_nir_dif] + standard_name = surface_albedo_nearIR_diffuse + long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_uvvis_dir] + standard_name = surface_albedo_uvvis_dir + long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_uvvis_dif] + standard_name = surface_albedo_uvvis_dif + long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = out + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + 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 = GFS_rrtmgp_sw_pre_finalize + type = scheme \ No newline at end of file diff --git a/physics/radlw_param.meta b/physics/radlw_param.meta index a06a89512..61aee1d37 100644 --- a/physics/radlw_param.meta +++ b/physics/radlw_param.meta @@ -23,3 +23,9 @@ units = DDT dimensions = () type = sfcflw_type +[proflw_type] + standard_name = proflw_type + long_name = definition of type proflw_type + units = DDT + dimensions = () + type = proflw_type diff --git a/physics/radsw_param.meta b/physics/radsw_param.meta index 9f7c8a35a..e0eb5ece8 100644 --- a/physics/radsw_param.meta +++ b/physics/radsw_param.meta @@ -34,3 +34,9 @@ units = DDT dimensions = () type = cmpfsw_type +[profsw_type] + standard_name = profsw_type + long_name = definition of type profsw_type + units = DDT + dimensions = () + type = profsw_type diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/rrtmg_lw_cloud_optics.F90 new file mode 100644 index 000000000..31551d797 --- /dev/null +++ b/physics/rrtmg_lw_cloud_optics.F90 @@ -0,0 +1,821 @@ +module mo_rrtmg_lw_cloud_optics + use machine, only: kind_phys + use physparam, only: ilwcliq, ilwcice, iovrlw + use mersenne_twister, only: random_setseed, random_number, random_stat + + implicit none + + ! Parameter used for RRTMG cloud-optics + integer,parameter :: & + nBandsLW_RRTMG = 16 + ! ipat is bands index for ebert & curry ice cloud (for iflagice=1) + integer,dimension(nBandsLW_RRTMG),parameter :: & + ipat = (/ 1, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5 /) + real(kind_phys), parameter :: & + absrain = 0.33e-3, & ! Rain drop absorption coefficient \f$(m^{2}/g)\f$ . + abssnow0 = 1.5, & ! Snow flake absorption coefficient (micron), fu coeff + abssnow1 = 2.34e-3 ! Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef + + ! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 + ! and 1.80) as a function of total column water vapor. the function + ! has been defined to minimize flux and cooling rate errors in these bands + ! over a wide range of precipitable water values. + ! *NOTE* This is done in GFS_rrtmgp_lw_pre.F90:_run() + real (kind_phys), dimension(nbandsLW_RRTMG) :: & + a0 = (/ 1.66, 1.55, 1.58, 1.66, 1.54, 1.454, 1.89, 1.33, & + 1.668, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66 /), & + a1 = (/ 0.00, 0.25, 0.22, 0.00, 0.13, 0.446, -0.10, 0.40, & + -0.006, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 /), & + a2 = (/ 0.00, -12.0, -11.7, 0.00, -0.72, -0.243, 0.19, -0.062, & + 0.414, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 /) + real(kind_phys),parameter :: & + diffusivityLow = 1.50, & ! Minimum diffusivity angle for bands 2-3 and 5-9 + diffusivityHigh = 1.80, & ! Maximum diffusivity angle for bands 2-3 and 5-9 + diffusivityB1410 = 1.66 ! Diffusivity for bands 1, 4, and 10 + + ! RRTMG LW cloud property coefficients + real(kind_phys) , dimension(58,nBandsLW_RRTMG),parameter :: & + absliq1 = reshape(source=(/ & + 1.64047e-03, 6.90533e-02, 7.72017e-02, 7.78054e-02, 7.69523e-02, & !1 + 7.58058e-02, 7.46400e-02, 7.35123e-02, 7.24162e-02, 7.13225e-02, & !1 + 6.99145e-02, 6.66409e-02, 6.36582e-02, 6.09425e-02, 5.84593e-02, & !1 + 5.61743e-02, 5.40571e-02, 5.20812e-02, 5.02245e-02, 4.84680e-02, & !1 + 4.67959e-02, 4.51944e-02, 4.36516e-02, 4.21570e-02, 4.07015e-02, & !1 + 3.92766e-02, 3.78747e-02, 3.64886e-02, 3.53632e-02, 3.41992e-02, & !1 + 3.31016e-02, 3.20643e-02, 3.10817e-02, 3.01490e-02, 2.92620e-02, & !1 + 2.84171e-02, 2.76108e-02, 2.68404e-02, 2.61031e-02, 2.53966e-02, & !1 + 2.47189e-02, 2.40678e-02, 2.34418e-02, 2.28392e-02, 2.22586e-02, & !1 + 2.16986e-02, 2.11580e-02, 2.06356e-02, 2.01305e-02, 1.96417e-02, & !1 + 1.91682e-02, 1.87094e-02, 1.82643e-02, 1.78324e-02, 1.74129e-02, & !1 + 1.70052e-02, 1.66088e-02, 1.62231e-02, & !1 + 2.19486e-01, 1.80687e-01, 1.59150e-01, 1.44731e-01, 1.33703e-01, & !2 + 1.24355e-01, 1.15756e-01, 1.07318e-01, 9.86119e-02, 8.92739e-02, & !2 + 8.34911e-02, 7.70773e-02, 7.15240e-02, 6.66615e-02, 6.23641e-02, & !2 + 5.85359e-02, 5.51020e-02, 5.20032e-02, 4.91916e-02, 4.66283e-02, & !2 + 4.42813e-02, 4.21236e-02, 4.01330e-02, 3.82905e-02, 3.65797e-02, & !2 + 3.49869e-02, 3.35002e-02, 3.21090e-02, 3.08957e-02, 2.97601e-02, & !2 + 2.86966e-02, 2.76984e-02, 2.67599e-02, 2.58758e-02, 2.50416e-02, & !2 + 2.42532e-02, 2.35070e-02, 2.27997e-02, 2.21284e-02, 2.14904e-02, & !2 + 2.08834e-02, 2.03051e-02, 1.97536e-02, 1.92271e-02, 1.87239e-02, & !2 + 1.82425e-02, 1.77816e-02, 1.73399e-02, 1.69162e-02, 1.65094e-02, & !2 + 1.61187e-02, 1.57430e-02, 1.53815e-02, 1.50334e-02, 1.46981e-02, & !2 + 1.43748e-02, 1.40628e-02, 1.37617e-02, & !2 + 2.95174e-01, 2.34765e-01, 1.98038e-01, 1.72114e-01, 1.52083e-01, & !3 + 1.35654e-01, 1.21613e-01, 1.09252e-01, 9.81263e-02, 8.79448e-02, & !3 + 8.12566e-02, 7.44563e-02, 6.86374e-02, 6.36042e-02, 5.92094e-02, & !3 + 5.53402e-02, 5.19087e-02, 4.88455e-02, 4.60951e-02, 4.36124e-02, & !3 + 4.13607e-02, 3.93096e-02, 3.74338e-02, 3.57119e-02, 3.41261e-02, & !3 + 3.26610e-02, 3.13036e-02, 3.00425e-02, 2.88497e-02, 2.78077e-02, & !3 + 2.68317e-02, 2.59158e-02, 2.50545e-02, 2.42430e-02, 2.34772e-02, & !3 + 2.27533e-02, 2.20679e-02, 2.14181e-02, 2.08011e-02, 2.02145e-02, & !3 + 1.96561e-02, 1.91239e-02, 1.86161e-02, 1.81311e-02, 1.76673e-02, & !3 + 1.72234e-02, 1.67981e-02, 1.63903e-02, 1.59989e-02, 1.56230e-02, & !3 + 1.52615e-02, 1.49138e-02, 1.45791e-02, 1.42565e-02, 1.39455e-02, & !3 + 1.36455e-02, 1.33559e-02, 1.30761e-02, & !3 + 3.00925e-01, 2.36949e-01, 1.96947e-01, 1.68692e-01, 1.47190e-01, & !4 + 1.29986e-01, 1.15719e-01, 1.03568e-01, 9.30028e-02, 8.36658e-02, & !4 + 7.71075e-02, 7.07002e-02, 6.52284e-02, 6.05024e-02, 5.63801e-02, & !4 + 5.27534e-02, 4.95384e-02, 4.66690e-02, 4.40925e-02, 4.17664e-02, & !4 + 3.96559e-02, 3.77326e-02, 3.59727e-02, 3.43561e-02, 3.28662e-02, & !4 + 3.14885e-02, 3.02110e-02, 2.90231e-02, 2.78948e-02, 2.69109e-02, & !4 + 2.59884e-02, 2.51217e-02, 2.43058e-02, 2.35364e-02, 2.28096e-02, & !4 + 2.21218e-02, 2.14700e-02, 2.08515e-02, 2.02636e-02, 1.97041e-02, & !4 + 1.91711e-02, 1.86625e-02, 1.81769e-02, 1.77126e-02, 1.72683e-02, & !4 + 1.68426e-02, 1.64344e-02, 1.60427e-02, 1.56664e-02, 1.53046e-02, & !4 + 1.49565e-02, 1.46214e-02, 1.42985e-02, 1.39871e-02, 1.36866e-02, & !4 + 1.33965e-02, 1.31162e-02, 1.28453e-02, & !4 + 2.64691e-01, 2.12018e-01, 1.78009e-01, 1.53539e-01, 1.34721e-01, & !5 + 1.19580e-01, 1.06996e-01, 9.62772e-02, 8.69710e-02, 7.87670e-02, & !5 + 7.29272e-02, 6.70920e-02, 6.20977e-02, 5.77732e-02, 5.39910e-02, & !5 + 5.06538e-02, 4.76866e-02, 4.50301e-02, 4.26374e-02, 4.04704e-02, & !5 + 3.84981e-02, 3.66948e-02, 3.50394e-02, 3.35141e-02, 3.21038e-02, & !5 + 3.07957e-02, 2.95788e-02, 2.84438e-02, 2.73790e-02, 2.64390e-02, & !5 + 2.55565e-02, 2.47263e-02, 2.39437e-02, 2.32047e-02, 2.25056e-02, & !5 + 2.18433e-02, 2.12149e-02, 2.06177e-02, 2.00495e-02, 1.95081e-02, & !5 + 1.89917e-02, 1.84984e-02, 1.80269e-02, 1.75755e-02, 1.71431e-02, & !5 + 1.67283e-02, 1.63303e-02, 1.59478e-02, 1.55801e-02, 1.52262e-02, & !5 + 1.48853e-02, 1.45568e-02, 1.42400e-02, 1.39342e-02, 1.36388e-02, & !5 + 1.33533e-02, 1.30773e-02, 1.28102e-02, & !5 + 8.81182e-02, 1.06745e-01, 9.79753e-02, 8.99625e-02, 8.35200e-02, & !6 + 7.81899e-02, 7.35939e-02, 6.94696e-02, 6.56266e-02, 6.19148e-02, & !6 + 5.83355e-02, 5.49306e-02, 5.19642e-02, 4.93325e-02, 4.69659e-02, & !6 + 4.48148e-02, 4.28431e-02, 4.10231e-02, 3.93332e-02, 3.77563e-02, & !6 + 3.62785e-02, 3.48882e-02, 3.35758e-02, 3.23333e-02, 3.11536e-02, & !6 + 3.00310e-02, 2.89601e-02, 2.79365e-02, 2.70502e-02, 2.62618e-02, & !6 + 2.55025e-02, 2.47728e-02, 2.40726e-02, 2.34013e-02, 2.27583e-02, & !6 + 2.21422e-02, 2.15522e-02, 2.09869e-02, 2.04453e-02, 1.99260e-02, & !6 + 1.94280e-02, 1.89501e-02, 1.84913e-02, 1.80506e-02, 1.76270e-02, & !6 + 1.72196e-02, 1.68276e-02, 1.64500e-02, 1.60863e-02, 1.57357e-02, & !6 + 1.53975e-02, 1.50710e-02, 1.47558e-02, 1.44511e-02, 1.41566e-02, & !6 + 1.38717e-02, 1.35960e-02, 1.33290e-02, & !6 + 4.32174e-02, 7.36078e-02, 6.98340e-02, 6.65231e-02, 6.41948e-02, & !7 + 6.23551e-02, 6.06638e-02, 5.88680e-02, 5.67124e-02, 5.38629e-02, & !7 + 4.99579e-02, 4.86289e-02, 4.70120e-02, 4.52854e-02, 4.35466e-02, & !7 + 4.18480e-02, 4.02169e-02, 3.86658e-02, 3.71992e-02, 3.58168e-02, & !7 + 3.45155e-02, 3.32912e-02, 3.21390e-02, 3.10538e-02, 3.00307e-02, & !7 + 2.90651e-02, 2.81524e-02, 2.72885e-02, 2.62821e-02, 2.55744e-02, & !7 + 2.48799e-02, 2.42029e-02, 2.35460e-02, 2.29108e-02, 2.22981e-02, & !7 + 2.17079e-02, 2.11402e-02, 2.05945e-02, 2.00701e-02, 1.95663e-02, & !7 + 1.90824e-02, 1.86174e-02, 1.81706e-02, 1.77411e-02, 1.73281e-02, & !7 + 1.69307e-02, 1.65483e-02, 1.61801e-02, 1.58254e-02, 1.54835e-02, & !7 + 1.51538e-02, 1.48358e-02, 1.45288e-02, 1.42322e-02, 1.39457e-02, & !7 + 1.36687e-02, 1.34008e-02, 1.31416e-02, & !7 + 1.41881e-01, 7.15419e-02, 6.30335e-02, 6.11132e-02, 6.01931e-02, & !8 + 5.92420e-02, 5.78968e-02, 5.58876e-02, 5.28923e-02, 4.84462e-02, & !8 + 4.60839e-02, 4.56013e-02, 4.45410e-02, 4.31866e-02, 4.17026e-02, & !8 + 4.01850e-02, 3.86892e-02, 3.72461e-02, 3.58722e-02, 3.45749e-02, & !8 + 3.33564e-02, 3.22155e-02, 3.11494e-02, 3.01541e-02, 2.92253e-02, & !8 + 2.83584e-02, 2.75488e-02, 2.67925e-02, 2.57692e-02, 2.50704e-02, & !8 + 2.43918e-02, 2.37350e-02, 2.31005e-02, 2.24888e-02, 2.18996e-02, & !8 + 2.13325e-02, 2.07870e-02, 2.02623e-02, 1.97577e-02, 1.92724e-02, & !8 + 1.88056e-02, 1.83564e-02, 1.79241e-02, 1.75079e-02, 1.71070e-02, & !8 + 1.67207e-02, 1.63482e-02, 1.59890e-02, 1.56424e-02, 1.53077e-02, & !8 + 1.49845e-02, 1.46722e-02, 1.43702e-02, 1.40782e-02, 1.37955e-02, & !8 + 1.35219e-02, 1.32569e-02, 1.30000e-02, & !8 + 6.72726e-02, 6.61013e-02, 6.47866e-02, 6.33780e-02, 6.18985e-02, & !9 + 6.03335e-02, 5.86136e-02, 5.65876e-02, 5.39839e-02, 5.03536e-02, & !9 + 4.71608e-02, 4.63630e-02, 4.50313e-02, 4.34526e-02, 4.17876e-02, & !9 + 4.01261e-02, 3.85171e-02, 3.69860e-02, 3.55442e-02, 3.41954e-02, & !9 + 3.29384e-02, 3.17693e-02, 3.06832e-02, 2.96745e-02, 2.87374e-02, & !9 + 2.78662e-02, 2.70557e-02, 2.63008e-02, 2.52450e-02, 2.45424e-02, & !9 + 2.38656e-02, 2.32144e-02, 2.25885e-02, 2.19873e-02, 2.14099e-02, & !9 + 2.08554e-02, 2.03230e-02, 1.98116e-02, 1.93203e-02, 1.88482e-02, & !9 + 1.83944e-02, 1.79578e-02, 1.75378e-02, 1.71335e-02, 1.67440e-02, & !9 + 1.63687e-02, 1.60069e-02, 1.56579e-02, 1.53210e-02, 1.49958e-02, & !9 + 1.46815e-02, 1.43778e-02, 1.40841e-02, 1.37999e-02, 1.35249e-02, & !9 + 1.32585e-02, 1.30004e-02, 1.27502e-02, & !9 + 7.97040e-02, 7.63844e-02, 7.36499e-02, 7.13525e-02, 6.93043e-02, & !10 + 6.72807e-02, 6.50227e-02, 6.22395e-02, 5.86093e-02, 5.37815e-02, & !10 + 5.14682e-02, 4.97214e-02, 4.77392e-02, 4.56961e-02, 4.36858e-02, & !10 + 4.17569e-02, 3.99328e-02, 3.82224e-02, 3.66265e-02, 3.51416e-02, & !10 + 3.37617e-02, 3.24798e-02, 3.12887e-02, 3.01812e-02, 2.91505e-02, & !10 + 2.81900e-02, 2.72939e-02, 2.64568e-02, 2.54165e-02, 2.46832e-02, & !10 + 2.39783e-02, 2.33017e-02, 2.26531e-02, 2.20314e-02, 2.14359e-02, & !10 + 2.08653e-02, 2.03187e-02, 1.97947e-02, 1.92924e-02, 1.88106e-02, & !10 + 1.83483e-02, 1.79043e-02, 1.74778e-02, 1.70678e-02, 1.66735e-02, & !10 + 1.62941e-02, 1.59286e-02, 1.55766e-02, 1.52371e-02, 1.49097e-02, & !10 + 1.45937e-02, 1.42885e-02, 1.39936e-02, 1.37085e-02, 1.34327e-02, & !10 + 1.31659e-02, 1.29075e-02, 1.26571e-02, & !10 + 1.49438e-01, 1.33535e-01, 1.21542e-01, 1.11743e-01, 1.03263e-01, & !11 + 9.55774e-02, 8.83382e-02, 8.12943e-02, 7.42533e-02, 6.70609e-02, & !11 + 6.38761e-02, 5.97788e-02, 5.59841e-02, 5.25318e-02, 4.94132e-02, & !11 + 4.66014e-02, 4.40644e-02, 4.17706e-02, 3.96910e-02, 3.77998e-02, & !11 + 3.60742e-02, 3.44947e-02, 3.30442e-02, 3.17079e-02, 3.04730e-02, & !11 + 2.93283e-02, 2.82642e-02, 2.72720e-02, 2.61789e-02, 2.53277e-02, & !11 + 2.45237e-02, 2.37635e-02, 2.30438e-02, 2.23615e-02, 2.17140e-02, & !11 + 2.10987e-02, 2.05133e-02, 1.99557e-02, 1.94241e-02, 1.89166e-02, & !11 + 1.84317e-02, 1.79679e-02, 1.75238e-02, 1.70983e-02, 1.66901e-02, & !11 + 1.62983e-02, 1.59219e-02, 1.55599e-02, 1.52115e-02, 1.48761e-02, & !11 + 1.45528e-02, 1.42411e-02, 1.39402e-02, 1.36497e-02, 1.33690e-02, & !11 + 1.30976e-02, 1.28351e-02, 1.25810e-02, & !11 + 3.71985e-02, 3.88586e-02, 3.99070e-02, 4.04351e-02, 4.04610e-02, & !12 + 3.99834e-02, 3.89953e-02, 3.74886e-02, 3.54551e-02, 3.28870e-02, & !12 + 3.32576e-02, 3.22444e-02, 3.12384e-02, 3.02584e-02, 2.93146e-02, & !12 + 2.84120e-02, 2.75525e-02, 2.67361e-02, 2.59618e-02, 2.52280e-02, & !12 + 2.45327e-02, 2.38736e-02, 2.32487e-02, 2.26558e-02, 2.20929e-02, & !12 + 2.15579e-02, 2.10491e-02, 2.05648e-02, 1.99749e-02, 1.95704e-02, & !12 + 1.91731e-02, 1.87839e-02, 1.84032e-02, 1.80315e-02, 1.76689e-02, & !12 + 1.73155e-02, 1.69712e-02, 1.66362e-02, 1.63101e-02, 1.59928e-02, & !12 + 1.56842e-02, 1.53840e-02, 1.50920e-02, 1.48080e-02, 1.45318e-02, & !12 + 1.42631e-02, 1.40016e-02, 1.37472e-02, 1.34996e-02, 1.32586e-02, & !12 + 1.30239e-02, 1.27954e-02, 1.25728e-02, 1.23559e-02, 1.21445e-02, & !12 + 1.19385e-02, 1.17376e-02, 1.15417e-02, & !12 + 3.11868e-02, 4.48357e-02, 4.90224e-02, 4.96406e-02, 4.86806e-02, & !13 + 4.69610e-02, 4.48630e-02, 4.25795e-02, 4.02138e-02, 3.78236e-02, & !13 + 3.74266e-02, 3.60384e-02, 3.47074e-02, 3.34434e-02, 3.22499e-02, & !13 + 3.11264e-02, 3.00704e-02, 2.90784e-02, 2.81463e-02, 2.72702e-02, & !13 + 2.64460e-02, 2.56698e-02, 2.49381e-02, 2.42475e-02, 2.35948e-02, & !13 + 2.29774e-02, 2.23925e-02, 2.18379e-02, 2.11793e-02, 2.07076e-02, & !13 + 2.02470e-02, 1.97981e-02, 1.93613e-02, 1.89367e-02, 1.85243e-02, & !13 + 1.81240e-02, 1.77356e-02, 1.73588e-02, 1.69935e-02, 1.66392e-02, & !13 + 1.62956e-02, 1.59624e-02, 1.56393e-02, 1.53259e-02, 1.50219e-02, & !13 + 1.47268e-02, 1.44404e-02, 1.41624e-02, 1.38925e-02, 1.36302e-02, & !13 + 1.33755e-02, 1.31278e-02, 1.28871e-02, 1.26530e-02, 1.24253e-02, & !13 + 1.22038e-02, 1.19881e-02, 1.17782e-02, & !13 + 1.58988e-02, 3.50652e-02, 4.00851e-02, 4.07270e-02, 3.98101e-02, & !14 + 3.83306e-02, 3.66829e-02, 3.50327e-02, 3.34497e-02, 3.19609e-02, & !14 + 3.13712e-02, 3.03348e-02, 2.93415e-02, 2.83973e-02, 2.75037e-02, & !14 + 2.66604e-02, 2.58654e-02, 2.51161e-02, 2.44100e-02, 2.37440e-02, & !14 + 2.31154e-02, 2.25215e-02, 2.19599e-02, 2.14282e-02, 2.09242e-02, & !14 + 2.04459e-02, 1.99915e-02, 1.95594e-02, 1.90254e-02, 1.86598e-02, & !14 + 1.82996e-02, 1.79455e-02, 1.75983e-02, 1.72584e-02, 1.69260e-02, & !14 + 1.66013e-02, 1.62843e-02, 1.59752e-02, 1.56737e-02, 1.53799e-02, & !14 + 1.50936e-02, 1.48146e-02, 1.45429e-02, 1.42782e-02, 1.40203e-02, & !14 + 1.37691e-02, 1.35243e-02, 1.32858e-02, 1.30534e-02, 1.28270e-02, & !14 + 1.26062e-02, 1.23909e-02, 1.21810e-02, 1.19763e-02, 1.17766e-02, & !14 + 1.15817e-02, 1.13915e-02, 1.12058e-02, & !14 + 5.02079e-03, 2.17615e-02, 2.55449e-02, 2.59484e-02, 2.53650e-02, & !15 + 2.45281e-02, 2.36843e-02, 2.29159e-02, 2.22451e-02, 2.16716e-02, & !15 + 2.11451e-02, 2.05817e-02, 2.00454e-02, 1.95372e-02, 1.90567e-02, & !15 + 1.86028e-02, 1.81742e-02, 1.77693e-02, 1.73866e-02, 1.70244e-02, & !15 + 1.66815e-02, 1.63563e-02, 1.60477e-02, 1.57544e-02, 1.54755e-02, & !15 + 1.52097e-02, 1.49564e-02, 1.47146e-02, 1.43684e-02, 1.41728e-02, & !15 + 1.39762e-02, 1.37797e-02, 1.35838e-02, 1.33891e-02, 1.31961e-02, & !15 + 1.30051e-02, 1.28164e-02, 1.26302e-02, 1.24466e-02, 1.22659e-02, & !15 + 1.20881e-02, 1.19131e-02, 1.17412e-02, 1.15723e-02, 1.14063e-02, & !15 + 1.12434e-02, 1.10834e-02, 1.09264e-02, 1.07722e-02, 1.06210e-02, & !15 + 1.04725e-02, 1.03269e-02, 1.01839e-02, 1.00436e-02, 9.90593e-03, & !15 + 9.77080e-03, 9.63818e-03, 9.50800e-03, & !15 + 5.64971e-02, 9.04736e-02, 8.11726e-02, 7.05450e-02, 6.20052e-02, & !16 + 5.54286e-02, 5.03503e-02, 4.63791e-02, 4.32290e-02, 4.06959e-02, & !16 + 3.74690e-02, 3.52964e-02, 3.33799e-02, 3.16774e-02, 3.01550e-02, & !16 + 2.87856e-02, 2.75474e-02, 2.64223e-02, 2.53953e-02, 2.44542e-02, & !16 + 2.35885e-02, 2.27894e-02, 2.20494e-02, 2.13622e-02, 2.07222e-02, & !16 + 2.01246e-02, 1.95654e-02, 1.90408e-02, 1.84398e-02, 1.80021e-02, & !16 + 1.75816e-02, 1.71775e-02, 1.67889e-02, 1.64152e-02, 1.60554e-02, & !16 + 1.57089e-02, 1.53751e-02, 1.50531e-02, 1.47426e-02, 1.44428e-02, & !16 + 1.41532e-02, 1.38734e-02, 1.36028e-02, 1.33410e-02, 1.30875e-02, & !16 + 1.28420e-02, 1.26041e-02, 1.23735e-02, 1.21497e-02, 1.19325e-02, & !16 + 1.17216e-02, 1.15168e-02, 1.13177e-02, 1.11241e-02, 1.09358e-02, & !16 + 1.07525e-02, 1.05741e-02, 1.04003e-02/), & !16 + shape=(/58,nBandsLW_RRTMG/)) + + real(kind_phys), dimension(2),parameter :: & + absice0 = (/0.005,1.0/) + + real(kind_phys), dimension(2,5),parameter :: & + absice1 = reshape(source=(/ & + 0.0036, 1.136, 0.0068, 0.600, 0.0003, 1.338, 0.0016, 1.166, 0.0020, 1.118 /),& + shape=(/2,5/)) + + real(kind_phys), dimension(43, nBandsLW_RRTMG),parameter :: & + absice2 = reshape(source=(/ & + 7.798999e-02, 6.340479e-02, 5.417973e-02, 4.766245e-02, 4.272663e-02, & !1 + 3.880939e-02, 3.559544e-02, 3.289241e-02, 3.057511e-02, 2.855800e-02, & !1 + 2.678022e-02, 2.519712e-02, 2.377505e-02, 2.248806e-02, 2.131578e-02, & !1 + 2.024194e-02, 1.925337e-02, 1.833926e-02, 1.749067e-02, 1.670007e-02, & !1 + 1.596113e-02, 1.526845e-02, 1.461739e-02, 1.400394e-02, 1.342462e-02, & !1 + 1.287639e-02, 1.235656e-02, 1.186279e-02, 1.139297e-02, 1.094524e-02, & !1 + 1.051794e-02, 1.010956e-02, 9.718755e-03, 9.344316e-03, 8.985139e-03, & !1 + 8.640223e-03, 8.308656e-03, 7.989606e-03, 7.682312e-03, 7.386076e-03, & !1 + 7.100255e-03, 6.824258e-03, 6.557540e-03, & !1 + 2.784879e-02, 2.709863e-02, 2.619165e-02, 2.529230e-02, 2.443225e-02, & !2 + 2.361575e-02, 2.284021e-02, 2.210150e-02, 2.139548e-02, 2.071840e-02, & !2 + 2.006702e-02, 1.943856e-02, 1.883064e-02, 1.824120e-02, 1.766849e-02, & !2 + 1.711099e-02, 1.656737e-02, 1.603647e-02, 1.551727e-02, 1.500886e-02, & !2 + 1.451045e-02, 1.402132e-02, 1.354084e-02, 1.306842e-02, 1.260355e-02, & !2 + 1.214575e-02, 1.169460e-02, 1.124971e-02, 1.081072e-02, 1.037731e-02, & !2 + 9.949167e-03, 9.526021e-03, 9.107615e-03, 8.693714e-03, 8.284096e-03, & !2 + 7.878558e-03, 7.476910e-03, 7.078974e-03, 6.684586e-03, 6.293589e-03, & !2 + 5.905839e-03, 5.521200e-03, 5.139543e-03, & !2 + 1.065397e-01, 8.005726e-02, 6.546428e-02, 5.589131e-02, 4.898681e-02, & !3 + 4.369932e-02, 3.947901e-02, 3.600676e-02, 3.308299e-02, 3.057561e-02, & !3 + 2.839325e-02, 2.647040e-02, 2.475872e-02, 2.322164e-02, 2.183091e-02, & !3 + 2.056430e-02, 1.940407e-02, 1.833586e-02, 1.734787e-02, 1.643034e-02, & !3 + 1.557512e-02, 1.477530e-02, 1.402501e-02, 1.331924e-02, 1.265364e-02, & !3 + 1.202445e-02, 1.142838e-02, 1.086257e-02, 1.032445e-02, 9.811791e-03, & !3 + 9.322587e-03, 8.855053e-03, 8.407591e-03, 7.978763e-03, 7.567273e-03, & !3 + 7.171949e-03, 6.791728e-03, 6.425642e-03, 6.072809e-03, 5.732424e-03, & !3 + 5.403748e-03, 5.086103e-03, 4.778865e-03, & !3 + 1.804566e-01, 1.168987e-01, 8.680442e-02, 6.910060e-02, 5.738174e-02, & !4 + 4.902332e-02, 4.274585e-02, 3.784923e-02, 3.391734e-02, 3.068690e-02, & !4 + 2.798301e-02, 2.568480e-02, 2.370600e-02, 2.198337e-02, 2.046940e-02, & !4 + 1.912777e-02, 1.793016e-02, 1.685420e-02, 1.588193e-02, 1.499882e-02, & !4 + 1.419293e-02, 1.345440e-02, 1.277496e-02, 1.214769e-02, 1.156669e-02, & !4 + 1.102694e-02, 1.052412e-02, 1.005451e-02, 9.614854e-03, 9.202335e-03, & !4 + 8.814470e-03, 8.449077e-03, 8.104223e-03, 7.778195e-03, 7.469466e-03, & !4 + 7.176671e-03, 6.898588e-03, 6.634117e-03, 6.382264e-03, 6.142134e-03, & !4 + 5.912913e-03, 5.693862e-03, 5.484308e-03, & !4 + 2.131806e-01, 1.311372e-01, 9.407171e-02, 7.299442e-02, 5.941273e-02, & !5 + 4.994043e-02, 4.296242e-02, 3.761113e-02, 3.337910e-02, 2.994978e-02, & !5 + 2.711556e-02, 2.473461e-02, 2.270681e-02, 2.095943e-02, 1.943839e-02, & !5 + 1.810267e-02, 1.692057e-02, 1.586719e-02, 1.492275e-02, 1.407132e-02, & !5 + 1.329989e-02, 1.259780e-02, 1.195618e-02, 1.136761e-02, 1.082583e-02, & !5 + 1.032552e-02, 9.862158e-03, 9.431827e-03, 9.031157e-03, 8.657217e-03, & !5 + 8.307449e-03, 7.979609e-03, 7.671724e-03, 7.382048e-03, 7.109032e-03, & !5 + 6.851298e-03, 6.607615e-03, 6.376881e-03, 6.158105e-03, 5.950394e-03, & !5 + 5.752942e-03, 5.565019e-03, 5.385963e-03, & !5 + 1.546177e-01, 1.039251e-01, 7.910347e-02, 6.412429e-02, 5.399997e-02, & !6 + 4.664937e-02, 4.104237e-02, 3.660781e-02, 3.300218e-02, 3.000586e-02, & !6 + 2.747148e-02, 2.529633e-02, 2.340647e-02, 2.174723e-02, 2.027731e-02, & !6 + 1.896487e-02, 1.778492e-02, 1.671761e-02, 1.574692e-02, 1.485978e-02, & !6 + 1.404543e-02, 1.329489e-02, 1.260066e-02, 1.195636e-02, 1.135657e-02, & !6 + 1.079664e-02, 1.027257e-02, 9.780871e-03, 9.318505e-03, 8.882815e-03, & !6 + 8.471458e-03, 8.082364e-03, 7.713696e-03, 7.363817e-03, 7.031264e-03, & !6 + 6.714725e-03, 6.413021e-03, 6.125086e-03, 5.849958e-03, 5.586764e-03, & !6 + 5.334707e-03, 5.093066e-03, 4.861179e-03, & !6 + 7.583404e-02, 6.181558e-02, 5.312027e-02, 4.696039e-02, 4.225986e-02, & !7 + 3.849735e-02, 3.538340e-02, 3.274182e-02, 3.045798e-02, 2.845343e-02, & !7 + 2.667231e-02, 2.507353e-02, 2.362606e-02, 2.230595e-02, 2.109435e-02, & !7 + 1.997617e-02, 1.893916e-02, 1.797328e-02, 1.707016e-02, 1.622279e-02, & !7 + 1.542523e-02, 1.467241e-02, 1.395997e-02, 1.328414e-02, 1.264164e-02, & !7 + 1.202958e-02, 1.144544e-02, 1.088697e-02, 1.035218e-02, 9.839297e-03, & !7 + 9.346733e-03, 8.873057e-03, 8.416980e-03, 7.977335e-03, 7.553066e-03, & !7 + 7.143210e-03, 6.746888e-03, 6.363297e-03, 5.991700e-03, 5.631422e-03, & !7 + 5.281840e-03, 4.942378e-03, 4.612505e-03, & !7 + 9.022185e-02, 6.922700e-02, 5.710674e-02, 4.898377e-02, 4.305946e-02, & !8 + 3.849553e-02, 3.484183e-02, 3.183220e-02, 2.929794e-02, 2.712627e-02, & !8 + 2.523856e-02, 2.357810e-02, 2.210286e-02, 2.078089e-02, 1.958747e-02, & !8 + 1.850310e-02, 1.751218e-02, 1.660205e-02, 1.576232e-02, 1.498440e-02, & !8 + 1.426107e-02, 1.358624e-02, 1.295474e-02, 1.236212e-02, 1.180456e-02, & !8 + 1.127874e-02, 1.078175e-02, 1.031106e-02, 9.864433e-03, 9.439878e-03, & !8 + 9.035637e-03, 8.650140e-03, 8.281981e-03, 7.929895e-03, 7.592746e-03, & !8 + 7.269505e-03, 6.959238e-03, 6.661100e-03, 6.374317e-03, 6.098185e-03, & !8 + 5.832059e-03, 5.575347e-03, 5.327504e-03, & !8 + 1.294087e-01, 8.788217e-02, 6.728288e-02, 5.479720e-02, 4.635049e-02, & !9 + 4.022253e-02, 3.555576e-02, 3.187259e-02, 2.888498e-02, 2.640843e-02, & !9 + 2.431904e-02, 2.253038e-02, 2.098024e-02, 1.962267e-02, 1.842293e-02, & !9 + 1.735426e-02, 1.639571e-02, 1.553060e-02, 1.474552e-02, 1.402953e-02, & !9 + 1.337363e-02, 1.277033e-02, 1.221336e-02, 1.169741e-02, 1.121797e-02, & !9 + 1.077117e-02, 1.035369e-02, 9.962643e-03, 9.595509e-03, 9.250088e-03, & !9 + 8.924447e-03, 8.616876e-03, 8.325862e-03, 8.050057e-03, 7.788258e-03, & !9 + 7.539388e-03, 7.302478e-03, 7.076656e-03, 6.861134e-03, 6.655197e-03, & !9 + 6.458197e-03, 6.269543e-03, 6.088697e-03, & !9 + 1.593628e-01, 1.014552e-01, 7.458955e-02, 5.903571e-02, 4.887582e-02, & !10 + 4.171159e-02, 3.638480e-02, 3.226692e-02, 2.898717e-02, 2.631256e-02, & !10 + 2.408925e-02, 2.221156e-02, 2.060448e-02, 1.921325e-02, 1.799699e-02, & !10 + 1.692456e-02, 1.597177e-02, 1.511961e-02, 1.435289e-02, 1.365933e-02, & !10 + 1.302890e-02, 1.245334e-02, 1.192576e-02, 1.144037e-02, 1.099230e-02, & !10 + 1.057739e-02, 1.019208e-02, 9.833302e-03, 9.498395e-03, 9.185047e-03, & !10 + 8.891237e-03, 8.615185e-03, 8.355325e-03, 8.110267e-03, 7.878778e-03, & !10 + 7.659759e-03, 7.452224e-03, 7.255291e-03, 7.068166e-03, 6.890130e-03, & !10 + 6.720536e-03, 6.558794e-03, 6.404371e-03, & !10 + 1.656227e-01, 1.032129e-01, 7.487359e-02, 5.871431e-02, 4.828355e-02, & !11 + 4.099989e-02, 3.562924e-02, 3.150755e-02, 2.824593e-02, 2.560156e-02, & !11 + 2.341503e-02, 2.157740e-02, 2.001169e-02, 1.866199e-02, 1.748669e-02, & !11 + 1.645421e-02, 1.554015e-02, 1.472535e-02, 1.399457e-02, 1.333553e-02, & !11 + 1.273821e-02, 1.219440e-02, 1.169725e-02, 1.124104e-02, 1.082096e-02, & !11 + 1.043290e-02, 1.007336e-02, 9.739338e-03, 9.428223e-03, 9.137756e-03, & !11 + 8.865964e-03, 8.611115e-03, 8.371686e-03, 8.146330e-03, 7.933852e-03, & !11 + 7.733187e-03, 7.543386e-03, 7.363597e-03, 7.193056e-03, 7.031072e-03, & !11 + 6.877024e-03, 6.730348e-03, 6.590531e-03, & !11 + 9.194591e-02, 6.446867e-02, 4.962034e-02, 4.042061e-02, 3.418456e-02, & !12 + 2.968856e-02, 2.629900e-02, 2.365572e-02, 2.153915e-02, 1.980791e-02, & !12 + 1.836689e-02, 1.714979e-02, 1.610900e-02, 1.520946e-02, 1.442476e-02, & !12 + 1.373468e-02, 1.312345e-02, 1.257858e-02, 1.209010e-02, 1.164990e-02, & !12 + 1.125136e-02, 1.088901e-02, 1.055827e-02, 1.025531e-02, 9.976896e-03, & !12 + 9.720255e-03, 9.483022e-03, 9.263160e-03, 9.058902e-03, 8.868710e-03, & !12 + 8.691240e-03, 8.525312e-03, 8.369886e-03, 8.224042e-03, 8.086961e-03, & !12 + 7.957917e-03, 7.836258e-03, 7.721400e-03, 7.612821e-03, 7.510045e-03, & !12 + 7.412648e-03, 7.320242e-03, 7.232476e-03, & !12 + 1.437021e-01, 8.872535e-02, 6.392420e-02, 4.991833e-02, 4.096790e-02, & !13 + 3.477881e-02, 3.025782e-02, 2.681909e-02, 2.412102e-02, 2.195132e-02, & !13 + 2.017124e-02, 1.868641e-02, 1.743044e-02, 1.635529e-02, 1.542540e-02, & !13 + 1.461388e-02, 1.390003e-02, 1.326766e-02, 1.270395e-02, 1.219860e-02, & !13 + 1.174326e-02, 1.133107e-02, 1.095637e-02, 1.061442e-02, 1.030126e-02, & !13 + 1.001352e-02, 9.748340e-03, 9.503256e-03, 9.276155e-03, 9.065205e-03, & !13 + 8.868808e-03, 8.685571e-03, 8.514268e-03, 8.353820e-03, 8.203272e-03, & !13 + 8.061776e-03, 7.928578e-03, 7.803001e-03, 7.684443e-03, 7.572358e-03, & !13 + 7.466258e-03, 7.365701e-03, 7.270286e-03, & !13 + 1.288870e-01, 8.160295e-02, 5.964745e-02, 4.703790e-02, 3.888637e-02, & !14 + 3.320115e-02, 2.902017e-02, 2.582259e-02, 2.330224e-02, 2.126754e-02, & !14 + 1.959258e-02, 1.819130e-02, 1.700289e-02, 1.598320e-02, 1.509942e-02, & !14 + 1.432666e-02, 1.364572e-02, 1.304156e-02, 1.250220e-02, 1.201803e-02, & !14 + 1.158123e-02, 1.118537e-02, 1.082513e-02, 1.049605e-02, 1.019440e-02, & !14 + 9.916989e-03, 9.661116e-03, 9.424457e-03, 9.205005e-03, 9.001022e-03, & !14 + 8.810992e-03, 8.633588e-03, 8.467646e-03, 8.312137e-03, 8.166151e-03, & !14 + 8.028878e-03, 7.899597e-03, 7.777663e-03, 7.662498e-03, 7.553581e-03, & !14 + 7.450444e-03, 7.352662e-03, 7.259851e-03, & !14 + 8.254229e-02, 5.808787e-02, 4.492166e-02, 3.675028e-02, 3.119623e-02, & !15 + 2.718045e-02, 2.414450e-02, 2.177073e-02, 1.986526e-02, 1.830306e-02, & !15 + 1.699991e-02, 1.589698e-02, 1.495199e-02, 1.413374e-02, 1.341870e-02, & !15 + 1.278883e-02, 1.223002e-02, 1.173114e-02, 1.128322e-02, 1.087900e-02, & !15 + 1.051254e-02, 1.017890e-02, 9.873991e-03, 9.594347e-03, 9.337044e-03, & !15 + 9.099589e-03, 8.879842e-03, 8.675960e-03, 8.486341e-03, 8.309594e-03, & !15 + 8.144500e-03, 7.989986e-03, 7.845109e-03, 7.709031e-03, 7.581007e-03, & !15 + 7.460376e-03, 7.346544e-03, 7.238978e-03, 7.137201e-03, 7.040780e-03, & !15 + 6.949325e-03, 6.862483e-03, 6.779931e-03, & !15 + 1.382062e-01, 8.643227e-02, 6.282935e-02, 4.934783e-02, 4.063891e-02, & !16 + 3.455591e-02, 3.007059e-02, 2.662897e-02, 2.390631e-02, 2.169972e-02, & !16 + 1.987596e-02, 1.834393e-02, 1.703924e-02, 1.591513e-02, 1.493679e-02, & !16 + 1.407780e-02, 1.331775e-02, 1.264061e-02, 1.203364e-02, 1.148655e-02, & !16 + 1.099099e-02, 1.054006e-02, 1.012807e-02, 9.750215e-03, 9.402477e-03, & !16 + 9.081428e-03, 8.784143e-03, 8.508107e-03, 8.251146e-03, 8.011373e-03, & !16 + 7.787140e-03, 7.577002e-03, 7.379687e-03, 7.194071e-03, 7.019158e-03, & !16 + 6.854061e-03, 6.697986e-03, 6.550224e-03, 6.410138e-03, 6.277153e-03, & !16 + 6.150751e-03, 6.030462e-03, 5.915860e-03/), & !16 + shape=(/43,nBandsLW_RRTMG/)) + + real(kind_phys) , dimension(46,nBandsLW_RRTMG),parameter :: & + absice3 = reshape(source=(/ & + 3.110649e-03, 4.666352e-02, 6.606447e-02, 6.531678e-02, 6.012598e-02, & !1 + 5.437494e-02, 4.906411e-02, 4.441146e-02, 4.040585e-02, 3.697334e-02, & !1 + 3.403027e-02, 3.149979e-02, 2.931596e-02, 2.742365e-02, 2.577721e-02, & !1 + 2.433888e-02, 2.307732e-02, 2.196644e-02, 2.098437e-02, 2.011264e-02, & !1 + 1.933561e-02, 1.863992e-02, 1.801407e-02, 1.744812e-02, 1.693346e-02, & !1 + 1.646252e-02, 1.602866e-02, 1.562600e-02, 1.524933e-02, 1.489399e-02, & !1 + 1.455580e-02, 1.423098e-02, 1.391612e-02, 1.360812e-02, 1.330413e-02, & !1 + 1.300156e-02, 1.269801e-02, 1.239127e-02, 1.207928e-02, 1.176014e-02, & !1 + 1.143204e-02, 1.109334e-02, 1.074243e-02, 1.037786e-02, 9.998198e-03, & !1 + 9.602126e-03, & !1 + 3.984966e-04, 1.681097e-02, 2.627680e-02, 2.767465e-02, 2.700722e-02, & !2 + 2.579180e-02, 2.448677e-02, 2.323890e-02, 2.209096e-02, 2.104882e-02, & !2 + 2.010547e-02, 1.925003e-02, 1.847128e-02, 1.775883e-02, 1.710358e-02, & !2 + 1.649769e-02, 1.593449e-02, 1.540829e-02, 1.491429e-02, 1.444837e-02, & !2 + 1.400704e-02, 1.358729e-02, 1.318654e-02, 1.280258e-02, 1.243346e-02, & !2 + 1.207750e-02, 1.173325e-02, 1.139941e-02, 1.107487e-02, 1.075861e-02, & !2 + 1.044975e-02, 1.014753e-02, 9.851229e-03, 9.560240e-03, 9.274003e-03, & !2 + 8.992020e-03, 8.713845e-03, 8.439074e-03, 8.167346e-03, 7.898331e-03, & !2 + 7.631734e-03, 7.367286e-03, 7.104742e-03, 6.843882e-03, 6.584504e-03, & !2 + 6.326424e-03, & !2 + 6.933163e-02, 8.540475e-02, 7.701816e-02, 6.771158e-02, 5.986953e-02, & !3 + 5.348120e-02, 4.824962e-02, 4.390563e-02, 4.024411e-02, 3.711404e-02, & !3 + 3.440426e-02, 3.203200e-02, 2.993478e-02, 2.806474e-02, 2.638464e-02, & !3 + 2.486516e-02, 2.348288e-02, 2.221890e-02, 2.105780e-02, 1.998687e-02, & !3 + 1.899552e-02, 1.807490e-02, 1.721750e-02, 1.641693e-02, 1.566773e-02, & !3 + 1.496515e-02, 1.430509e-02, 1.368398e-02, 1.309865e-02, 1.254634e-02, & !3 + 1.202456e-02, 1.153114e-02, 1.106409e-02, 1.062166e-02, 1.020224e-02, & !3 + 9.804381e-03, 9.426771e-03, 9.068205e-03, 8.727578e-03, 8.403876e-03, & !3 + 8.096160e-03, 7.803564e-03, 7.525281e-03, 7.260560e-03, 7.008697e-03, & !3 + 6.769036e-03, & !3 + 1.765735e-01, 1.382700e-01, 1.095129e-01, 8.987475e-02, 7.591185e-02, & !4 + 6.554169e-02, 5.755500e-02, 5.122083e-02, 4.607610e-02, 4.181475e-02, & !4 + 3.822697e-02, 3.516432e-02, 3.251897e-02, 3.021073e-02, 2.817876e-02, & !4 + 2.637607e-02, 2.476582e-02, 2.331871e-02, 2.201113e-02, 2.082388e-02, & !4 + 1.974115e-02, 1.874983e-02, 1.783894e-02, 1.699922e-02, 1.622280e-02, & !4 + 1.550296e-02, 1.483390e-02, 1.421064e-02, 1.362880e-02, 1.308460e-02, & !4 + 1.257468e-02, 1.209611e-02, 1.164628e-02, 1.122287e-02, 1.082381e-02, & !4 + 1.044725e-02, 1.009154e-02, 9.755166e-03, 9.436783e-03, 9.135163e-03, & !4 + 8.849193e-03, 8.577856e-03, 8.320225e-03, 8.075451e-03, 7.842755e-03, & !4 + 7.621418e-03, & !4 + 2.339673e-01, 1.692124e-01, 1.291656e-01, 1.033837e-01, 8.562949e-02, & !5 + 7.273526e-02, 6.298262e-02, 5.537015e-02, 4.927787e-02, 4.430246e-02, & !5 + 4.017061e-02, 3.669072e-02, 3.372455e-02, 3.116995e-02, 2.894977e-02, & !5 + 2.700471e-02, 2.528842e-02, 2.376420e-02, 2.240256e-02, 2.117959e-02, & !5 + 2.007567e-02, 1.907456e-02, 1.816271e-02, 1.732874e-02, 1.656300e-02, & !5 + 1.585725e-02, 1.520445e-02, 1.459852e-02, 1.403419e-02, 1.350689e-02, & !5 + 1.301260e-02, 1.254781e-02, 1.210941e-02, 1.169468e-02, 1.130118e-02, & !5 + 1.092675e-02, 1.056945e-02, 1.022757e-02, 9.899560e-03, 9.584021e-03, & !5 + 9.279705e-03, 8.985479e-03, 8.700322e-03, 8.423306e-03, 8.153590e-03, & !5 + 7.890412e-03, & !5 + 1.145369e-01, 1.174566e-01, 9.917866e-02, 8.332990e-02, 7.104263e-02, & !6 + 6.153370e-02, 5.405472e-02, 4.806281e-02, 4.317918e-02, 3.913795e-02, & !6 + 3.574916e-02, 3.287437e-02, 3.041067e-02, 2.828017e-02, 2.642292e-02, & !6 + 2.479206e-02, 2.335051e-02, 2.206851e-02, 2.092195e-02, 1.989108e-02, & !6 + 1.895958e-02, 1.811385e-02, 1.734245e-02, 1.663573e-02, 1.598545e-02, & !6 + 1.538456e-02, 1.482700e-02, 1.430750e-02, 1.382150e-02, 1.336499e-02, & !6 + 1.293447e-02, 1.252685e-02, 1.213939e-02, 1.176968e-02, 1.141555e-02, & !6 + 1.107508e-02, 1.074655e-02, 1.042839e-02, 1.011923e-02, 9.817799e-03, & !6 + 9.522962e-03, 9.233688e-03, 8.949041e-03, 8.668171e-03, 8.390301e-03, & !6 + 8.114723e-03, & !6 + 1.222345e-02, 5.344230e-02, 5.523465e-02, 5.128759e-02, 4.676925e-02, & !7 + 4.266150e-02, 3.910561e-02, 3.605479e-02, 3.342843e-02, 3.115052e-02, & !7 + 2.915776e-02, 2.739935e-02, 2.583499e-02, 2.443266e-02, 2.316681e-02, & !7 + 2.201687e-02, 2.096619e-02, 2.000112e-02, 1.911044e-02, 1.828481e-02, & !7 + 1.751641e-02, 1.679866e-02, 1.612598e-02, 1.549360e-02, 1.489742e-02, & !7 + 1.433392e-02, 1.380002e-02, 1.329305e-02, 1.281068e-02, 1.235084e-02, & !7 + 1.191172e-02, 1.149171e-02, 1.108936e-02, 1.070341e-02, 1.033271e-02, & !7 + 9.976220e-03, 9.633021e-03, 9.302273e-03, 8.983216e-03, 8.675161e-03, & !7 + 8.377478e-03, 8.089595e-03, 7.810986e-03, 7.541170e-03, 7.279706e-03, & !7 + 7.026186e-03, & !7 + 6.711058e-02, 6.918198e-02, 6.127484e-02, 5.411944e-02, 4.836902e-02, & !8 + 4.375293e-02, 3.998077e-02, 3.683587e-02, 3.416508e-02, 3.186003e-02, & !8 + 2.984290e-02, 2.805671e-02, 2.645895e-02, 2.501733e-02, 2.370689e-02, & !8 + 2.250808e-02, 2.140532e-02, 2.038609e-02, 1.944018e-02, 1.855918e-02, & !8 + 1.773609e-02, 1.696504e-02, 1.624106e-02, 1.555990e-02, 1.491793e-02, & !8 + 1.431197e-02, 1.373928e-02, 1.319743e-02, 1.268430e-02, 1.219799e-02, & !8 + 1.173682e-02, 1.129925e-02, 1.088393e-02, 1.048961e-02, 1.011516e-02, & !8 + 9.759543e-03, 9.421813e-03, 9.101089e-03, 8.796559e-03, 8.507464e-03, & !8 + 8.233098e-03, 7.972798e-03, 7.725942e-03, 7.491940e-03, 7.270238e-03, & !8 + 7.060305e-03, & !8 + 1.236780e-01, 9.222386e-02, 7.383997e-02, 6.204072e-02, 5.381029e-02, & !9 + 4.770678e-02, 4.296928e-02, 3.916131e-02, 3.601540e-02, 3.335878e-02, & !9 + 3.107493e-02, 2.908247e-02, 2.732282e-02, 2.575276e-02, 2.433968e-02, & !9 + 2.305852e-02, 2.188966e-02, 2.081757e-02, 1.982974e-02, 1.891599e-02, & !9 + 1.806794e-02, 1.727865e-02, 1.654227e-02, 1.585387e-02, 1.520924e-02, & !9 + 1.460476e-02, 1.403730e-02, 1.350416e-02, 1.300293e-02, 1.253153e-02, & !9 + 1.208808e-02, 1.167094e-02, 1.127862e-02, 1.090979e-02, 1.056323e-02, & !9 + 1.023786e-02, 9.932665e-03, 9.646744e-03, 9.379250e-03, 9.129409e-03, & !9 + 8.896500e-03, 8.679856e-03, 8.478852e-03, 8.292904e-03, 8.121463e-03, & !9 + 7.964013e-03, & !9 + 1.655966e-01, 1.134205e-01, 8.714344e-02, 7.129241e-02, 6.063739e-02, & !10 + 5.294203e-02, 4.709309e-02, 4.247476e-02, 3.871892e-02, 3.559206e-02, & !10 + 3.293893e-02, 3.065226e-02, 2.865558e-02, 2.689288e-02, 2.532221e-02, & !10 + 2.391150e-02, 2.263582e-02, 2.147549e-02, 2.041476e-02, 1.944089e-02, & !10 + 1.854342e-02, 1.771371e-02, 1.694456e-02, 1.622989e-02, 1.556456e-02, & !10 + 1.494415e-02, 1.436491e-02, 1.382354e-02, 1.331719e-02, 1.284339e-02, & !10 + 1.239992e-02, 1.198486e-02, 1.159647e-02, 1.123323e-02, 1.089375e-02, & !10 + 1.057679e-02, 1.028124e-02, 1.000607e-02, 9.750376e-03, 9.513303e-03, & !10 + 9.294082e-03, 9.092003e-03, 8.906412e-03, 8.736702e-03, 8.582314e-03, & !10 + 8.442725e-03, & !10 + 1.775615e-01, 1.180046e-01, 8.929607e-02, 7.233500e-02, 6.108333e-02, & !11 + 5.303642e-02, 4.696927e-02, 4.221206e-02, 3.836768e-02, 3.518576e-02, & !11 + 3.250063e-02, 3.019825e-02, 2.819758e-02, 2.643943e-02, 2.487953e-02, & !11 + 2.348414e-02, 2.222705e-02, 2.108762e-02, 2.004936e-02, 1.909892e-02, & !11 + 1.822539e-02, 1.741975e-02, 1.667449e-02, 1.598330e-02, 1.534084e-02, & !11 + 1.474253e-02, 1.418446e-02, 1.366325e-02, 1.317597e-02, 1.272004e-02, & !11 + 1.229321e-02, 1.189350e-02, 1.151915e-02, 1.116859e-02, 1.084042e-02, & !11 + 1.053338e-02, 1.024636e-02, 9.978326e-03, 9.728357e-03, 9.495613e-03, & !11 + 9.279327e-03, 9.078798e-03, 8.893383e-03, 8.722488e-03, 8.565568e-03, & !11 + 8.422115e-03, & !11 + 9.465447e-02, 6.432047e-02, 5.060973e-02, 4.267283e-02, 3.741843e-02, & !12 + 3.363096e-02, 3.073531e-02, 2.842405e-02, 2.651789e-02, 2.490518e-02, & !12 + 2.351273e-02, 2.229056e-02, 2.120335e-02, 2.022541e-02, 1.933763e-02, & !12 + 1.852546e-02, 1.777763e-02, 1.708528e-02, 1.644134e-02, 1.584009e-02, & !12 + 1.527684e-02, 1.474774e-02, 1.424955e-02, 1.377957e-02, 1.333549e-02, & !12 + 1.291534e-02, 1.251743e-02, 1.214029e-02, 1.178265e-02, 1.144337e-02, & !12 + 1.112148e-02, 1.081609e-02, 1.052642e-02, 1.025178e-02, 9.991540e-03, & !12 + 9.745130e-03, 9.512038e-03, 9.291797e-03, 9.083980e-03, 8.888195e-03, & !12 + 8.704081e-03, 8.531306e-03, 8.369560e-03, 8.218558e-03, 8.078032e-03, & !12 + 7.947730e-03, & !12 + 1.560311e-01, 9.961097e-02, 7.502949e-02, 6.115022e-02, 5.214952e-02, & !13 + 4.578149e-02, 4.099731e-02, 3.724174e-02, 3.419343e-02, 3.165356e-02, & !13 + 2.949251e-02, 2.762222e-02, 2.598073e-02, 2.452322e-02, 2.321642e-02, & !13 + 2.203516e-02, 2.096002e-02, 1.997579e-02, 1.907036e-02, 1.823401e-02, & !13 + 1.745879e-02, 1.673819e-02, 1.606678e-02, 1.544003e-02, 1.485411e-02, & !13 + 1.430574e-02, 1.379215e-02, 1.331092e-02, 1.285996e-02, 1.243746e-02, & !13 + 1.204183e-02, 1.167164e-02, 1.132567e-02, 1.100281e-02, 1.070207e-02, & !13 + 1.042258e-02, 1.016352e-02, 9.924197e-03, 9.703953e-03, 9.502199e-03, & !13 + 9.318400e-03, 9.152066e-03, 9.002749e-03, 8.870038e-03, 8.753555e-03, & !13 + 8.652951e-03, & !13 + 1.559547e-01, 9.896700e-02, 7.441231e-02, 6.061469e-02, 5.168730e-02, & !14 + 4.537821e-02, 4.064106e-02, 3.692367e-02, 3.390714e-02, 3.139438e-02, & !14 + 2.925702e-02, 2.740783e-02, 2.578547e-02, 2.434552e-02, 2.305506e-02, & !14 + 2.188910e-02, 2.082842e-02, 1.985789e-02, 1.896553e-02, 1.814165e-02, & !14 + 1.737839e-02, 1.666927e-02, 1.600891e-02, 1.539279e-02, 1.481712e-02, & !14 + 1.427865e-02, 1.377463e-02, 1.330266e-02, 1.286068e-02, 1.244689e-02, & !14 + 1.205973e-02, 1.169780e-02, 1.135989e-02, 1.104492e-02, 1.075192e-02, & !14 + 1.048004e-02, 1.022850e-02, 9.996611e-03, 9.783753e-03, 9.589361e-03, & !14 + 9.412924e-03, 9.253977e-03, 9.112098e-03, 8.986903e-03, 8.878039e-03, & !14 + 8.785184e-03, & !14 + 1.102926e-01, 7.176622e-02, 5.530316e-02, 4.606056e-02, 4.006116e-02, & !15 + 3.579628e-02, 3.256909e-02, 3.001360e-02, 2.791920e-02, 2.615617e-02, & !15 + 2.464023e-02, 2.331426e-02, 2.213817e-02, 2.108301e-02, 2.012733e-02, & !15 + 1.925493e-02, 1.845331e-02, 1.771269e-02, 1.702531e-02, 1.638493e-02, & !15 + 1.578648e-02, 1.522579e-02, 1.469940e-02, 1.420442e-02, 1.373841e-02, & !15 + 1.329931e-02, 1.288535e-02, 1.249502e-02, 1.212700e-02, 1.178015e-02, & !15 + 1.145348e-02, 1.114612e-02, 1.085730e-02, 1.058633e-02, 1.033263e-02, & !15 + 1.009564e-02, 9.874895e-03, 9.669960e-03, 9.480449e-03, 9.306014e-03, & !15 + 9.146339e-03, 9.001138e-03, 8.870154e-03, 8.753148e-03, 8.649907e-03, & !15 + 8.560232e-03, & !15 + 1.688344e-01, 1.077072e-01, 7.994467e-02, 6.403862e-02, 5.369850e-02, & !16 + 4.641582e-02, 4.099331e-02, 3.678724e-02, 3.342069e-02, 3.065831e-02, & !16 + 2.834557e-02, 2.637680e-02, 2.467733e-02, 2.319286e-02, 2.188299e-02, & !16 + 2.071701e-02, 1.967121e-02, 1.872692e-02, 1.786931e-02, 1.708641e-02, & !16 + 1.636846e-02, 1.570743e-02, 1.509665e-02, 1.453052e-02, 1.400433e-02, & !16 + 1.351407e-02, 1.305631e-02, 1.262810e-02, 1.222688e-02, 1.185044e-02, & !16 + 1.149683e-02, 1.116436e-02, 1.085153e-02, 1.055701e-02, 1.027961e-02, & !16 + 1.001831e-02, 9.772141e-03, 9.540280e-03, 9.321966e-03, 9.116517e-03, & !16 + 8.923315e-03, 8.741803e-03, 8.571472e-03, 8.411860e-03, 8.262543e-03, & !16 + 8.123136e-03/), & !16 + shape=(/46,nBandsLW_RRTMG/)) +contains + ! ####################################################################################### + ! subroutine rrtmg_lw_cloud_optics + ! ####################################################################################### + subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld_iwp, & + cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, tau_cld) + ! Inputs + integer,intent(in) :: & + nBandsLW, & ! Number of spectral bands + ncol, & ! Number of horizontal gridpoints + nlay ! Number of vertical layers + real(kind_phys), dimension(ncol,nlay), intent(in) :: & + cld_frac, & ! Cloud-fraction (1) + cld_lwp, & ! Cloud liquid water path (g/m2) + cld_ref_liq, & ! Effective radius (liquid) (micron) + cld_iwp, & ! Cloud ice water path (g/m2) + cld_ref_ice, & ! Effective radius (ice) (micron) + cld_rwp, & ! Cloud rain water path (g/m2) + cld_ref_rain, & ! Effective radius (rain-drop) (micron) + cld_swp, & ! Cloud snow-water path (g/m2) + cld_ref_snow ! Effective radius (snow-flake) (micron) + + ! Outputs + real(kind_phys),dimension(ncol,nlay,nBandsLW),intent(out) :: & + tau_cld + + ! Local variables + integer :: ij,ik,ib,index,ia + real(kind_phys) :: factor,fint,cld_ref_iceTemp,tau_snow, tau_rain + real(kind_phys),dimension(nBandsLW) :: tau_liq, tau_ice + + tau_cld(:,:,:) = 0._kind_phys + + if (ilwcliq .gt. 0) then + do ij=1,ncol + do ik=1,nlay + if (cld_frac(ij,ik) .gt. 0.) then + ! Rain optical-depth (No band dependence) + tau_rain = absrain*cld_rwp(ij,ik) + + ! Snow optical-depth (No band dependence) + if (cld_swp(ij,ik) .gt. 0. .and. cld_ref_snow(ij,ik) .gt. 10._kind_phys) then + tau_snow = abssnow0*1.05756*cld_swp(ij,ik)/cld_ref_snow(ij,ik) + else + tau_snow = 0. + endif + + ! Liquid water opitcal-depth + if (cld_lwp(ij,ik) .le. 0.) then + tau_liq(:) = 0. + else + if (ilwcliq .eq. 1) then + factor = cld_ref_liq(ij,ik) - 1.5 + index = max( 1, min( 57, int( factor ) )) + fint = factor - float(index) + do ib=1,nBandsLW + tau_liq(ib) = max(0., cld_lwp(ij,ik)*(absliq1(index,ib) + & + fint*(absliq1(index+1,ib)-absliq1(index,ib)) )) + enddo + endif + endif + + ! Ice water optical-depth + if (cld_iwp(ij,ik) .le. 0.) then + tau_ice(:) = 0. + else + ! 1) Ebert and curry approach for all particle sizes. (bound between 13-130microns) + if (ilwcice .eq. 1) then + cld_ref_iceTemp = min(130., max(13.,real(cld_ref_ice(ij,ik)))) + do ib=1,nBandsLW + ia = ipat(ib) ! eb_&_c band index for ice cloud coeff + tau_ice(ib) = max(0., cld_iwp(ij,ik)*(absice1(1,ia) + absice1(2,ia)/cld_ref_iceTemp) ) + enddo + + ! 2) Streamer approach for ice effective radius between 5.0 and 131.0 microns + ! and ebert and curry approach for ice eff radius greater than 131.0 microns. + ! no smoothing between the transition of the two methods + elseif (ilwcice .eq. 2) then + factor = (cld_ref_ice(ij,ik) - 2.) / 3. + index = max( 1, min( 42, int( factor ) )) + fint = factor - float(index) + do ib = 1, nBandsLW + tau_ice(ib) = max(0., cld_iwp(ij,ik)*(absice2(index,ib) + & + fint*(absice2(index+1,ib) - absice2(index,ib)) )) + enddo + ! 3) Fu's approach for ice effective radius between 4.8 and 135 microns + ! (generalized effective size from 5 to 140 microns) + elseif (ilwcice .eq. 3) then + cld_ref_iceTemp = max(5., 1.0315*cld_ref_ice(ij,ik)) ! v4.71 value + factor = (cld_ref_iceTemp - 2.) / 3. + index = max( 1, min( 45, int( factor ) )) + fint = factor - float(index) + do ib = 1, nBandsLW + tau_ice(ib) = max(0., cld_iwp(ij,ik)*(absice3(index,ib) + & + fint*(absice3(index+1,ib) - absice3(index,ib)) )) + enddo + endif + endif + else + tau_rain = 0. + tau_snow = 0. + tau_liq(:) = 0. + tau_ice(:) = 0. + endif + ! Cloud optical depth + do ib = 1, nBandsLW + tau_cld(ij,ik,ib) = tau_ice(ib) + tau_liq(ib) + tau_rain + tau_snow + enddo + end do + end do + endif + end subroutine rrtmg_lw_cloud_optics + ! ####################################################################################### + ! SUBROUTINE mcica_subcol_lw + ! ####################################################################################### + subroutine mcica_subcol_lw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth, cld_frac_mcica) + ! Inputs + integer,intent(in) :: & + ncol, & ! Number of horizontal gridpoints + nlay, & ! Number of vertical layers + ngpts ! Number of spectral g-points + integer,dimension(ncol),intent(in) :: & + icseed ! Permutation seed for each column. + real(kind_phys), dimension(ncol), intent(in) :: & + de_lgth ! Cloud decorrelation length (km) + real(kind_phys), dimension(ncol,nlay), intent(in) :: & + cld_frac, & ! Cloud-fraction + dzlyr ! Layer thinkness (km) + ! Outputs + !real(kind_phys),dimension(ncol,nlay,ngpts),intent(out) :: & + logical,dimension(ncol,nlay,ngpts),intent(out) :: & + cld_frac_mcica + ! Local variables + type(random_stat) :: stat + integer :: icol,n,k,k1 + real(kind_phys) :: tem1 + real(kind_phys),dimension(ngpts) :: rand1D + real(kind_phys),dimension(nlay*ngpts) :: rand2D + real(kind_phys),dimension(ngpts,nlay) :: cdfunc,cdfun2 + real(kind_phys),dimension(nlay) :: fac_lcf + logical,dimension(ngpts,nlay) :: lcloudy + + ! Loop over all columns + do icol=1,ncol + ! Call random_setseed() to advance random number generator by "icseed" values. + call random_setseed(icseed(icol),stat) + + ! ################################################################################### + ! Sub-column set up according to overlapping assumption: + ! - For random overlap, pick a random value at every level + ! - For max-random overlap, pick a random value at every level + ! - For maximum overlap, pick same random numebr at every level + ! ################################################################################### + select case ( iovrlw ) + ! ################################################################################### + ! 0) Random overlap + ! ################################################################################### + case( 0 ) + call random_number(rand2D,stat) + k1 = 0 + do n = 1, ngpts + do k = 1, nlay + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + ! ################################################################################### + ! 1) Maximum-random overlap + ! ################################################################################### + case(1) + call random_number(rand2D,stat) + k1 = 0 + do n = 1, ngpts + do k = 1, nlay + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + ! First pick a random number for bottom (or top) layer. + ! then walk up the column: (aer's code) + ! if layer below is cloudy, use the same rand num in the layer below + ! if layer below is clear, use a new random number + do k = 2, nlay + k1 = k - 1 + tem1 = 1._kind_phys - cld_frac(icol,k1) + do n = 1, ngpts + if ( cdfunc(n,k1) > tem1 ) then + cdfunc(n,k) = cdfunc(n,k1) + else + cdfunc(n,k) = cdfunc(n,k) * tem1 + endif + enddo + enddo + + ! ################################################################################### + ! 2) Maximum overlap + ! ################################################################################### + case(2) + call random_number(rand1d,stat) + do n = 1, ngpts + tem1 = rand1d(n) + do k = 1, nlay + cdfunc(n,k) = tem1 + enddo + enddo + + ! ################################################################################### + ! 3) Decorrelation length + ! ################################################################################### + case(3) + ! Compute overlapping factors based on layer midpoint distances and decorrelation + ! depths + do k = nlay, 2, -1 + fac_lcf(k) = exp( -0.5 * (dzlyr(iCol,k)+dzlyr(iCol,k-1)) / de_lgth(iCol) ) + enddo + + ! Setup 2 sets of random numbers + call random_number ( rand2d, stat ) + k1 = 0 + do k = 1, nlay + do n = 1, ngpts + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + ! + call random_number ( rand2d, stat ) + k1 = 0 + do k = 1, nlay + do n = 1, ngpts + k1 = k1 + 1 + cdfun2(n,k) = rand2d(k1) + enddo + enddo + + ! Then working from the top down: + ! if a random number (from an independent set -cdfun2) is smaller then the + ! scale factor: use the upper layer's number, otherwise use a new random + ! number (keep the original assigned one). + do k = nlay-1, 1, -1 + k1 = k + 1 + do n = 1, ngpts + if ( cdfun2(n,k) <= fac_lcf(k1) ) then + cdfunc(n,k) = cdfunc(n,k1) + endif + enddo + enddo + + end select + + ! ################################################################################### + ! Generate subcolumn cloud mask (.false./.true. for clear/cloudy) + ! ################################################################################### + do k = 1, nlay + tem1 = 1._kind_phys - cld_frac(icol,k) + do n = 1, ngpts + lcloudy(n,k) = cdfunc(n,k) >= tem1 + if (lcloudy(n,k)) then + cld_frac_mcica(icol,k,n) = .true. + else + cld_frac_mcica(icol,k,n) = .false. + endif + enddo + enddo + enddo ! END LOOP OVER COLUMNS + end subroutine mcica_subcol_lw + +end module mo_rrtmg_lw_cloud_optics diff --git a/physics/rrtmg_sw_cloud_optics.F90 b/physics/rrtmg_sw_cloud_optics.F90 new file mode 100644 index 000000000..7ff57039e --- /dev/null +++ b/physics/rrtmg_sw_cloud_optics.F90 @@ -0,0 +1,2412 @@ +module mo_rrtmg_sw_cloud_optics + use machine, only: kind_phys + use physparam, only: iswcliq, iswcice, iovrsw + use mersenne_twister, only: random_setseed, random_number, random_stat + implicit none + + ! Parameters used for RRTMG cloud-optics + integer,parameter :: & + nBandsSW_RRTMG = 14 + real(kind_phys),parameter :: & + a0r = 3.07e-3 + real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & + b0r = (/0.466, 0.437, 0.416, 0.391, 0.374, 0.352, 0.183, & + 0.048, 0.012, 0.000, 0.000, 0.000, 0.000, 0.496/) + real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & + b0s = (/0.460, 0.460, 0.460, 0.460, 0.460, 0.460, 0.460, & + 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.460/) + real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & + b1s = (/0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & + 1.62e-5, 1.62e-5, 0.000, 0.000, 0.000, 0.000, 0.000/) + real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & + c0r = (/0.975, 0.965, 0.960, 0.955, 0.952, 0.950, 0.944, & + 0.894, 0.884, 0.883, 0.883, 0.883, 0.883, 0.980/) + real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & + c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & + 0.970, 0.970, 0.700, 0.700, 0.700, 0.700, 0.970/) + + ! RRTMG SW cloud property coefficients + ! Liquid + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + extliq1 = reshape(source= (/ & ! + 8.981463e-01, 6.317895e-01, 4.557508e-01, 3.481624e-01, 2.797950e-01, & ! 1 + 2.342753e-01, 2.026934e-01, 1.800102e-01, 1.632408e-01, 1.505384e-01, & ! + 1.354524e-01, 1.246520e-01, 1.154342e-01, 1.074756e-01, 1.005353e-01, & ! + 9.442987e-02, 8.901760e-02, 8.418693e-02, 7.984904e-02, 7.593229e-02, & ! + 7.237827e-02, 6.913887e-02, 6.617415e-02, 6.345061e-02, 6.094001e-02, & ! + 5.861834e-02, 5.646506e-02, 5.446250e-02, 5.249596e-02, 5.081114e-02, & ! + 4.922243e-02, 4.772189e-02, 4.630243e-02, 4.495766e-02, 4.368189e-02, & ! + 4.246995e-02, 4.131720e-02, 4.021941e-02, 3.917276e-02, 3.817376e-02, & ! + 3.721926e-02, 3.630635e-02, 3.543237e-02, 3.459491e-02, 3.379171e-02, & ! + 3.302073e-02, 3.228007e-02, 3.156798e-02, 3.088284e-02, 3.022315e-02, & ! + 2.958753e-02, 2.897468e-02, 2.838340e-02, 2.781258e-02, 2.726117e-02, & ! + 2.672821e-02, 2.621278e-02, 2.5714e-02, & ! + 8.293797e-01, 6.048371e-01, 4.465706e-01, 3.460387e-01, 2.800064e-01, & ! 2 + 2.346584e-01, 2.022399e-01, 1.782626e-01, 1.600153e-01, 1.457903e-01, & ! + 1.334061e-01, 1.228548e-01, 1.138396e-01, 1.060486e-01, 9.924856e-02, & ! + 9.326208e-02, 8.795158e-02, 8.320883e-02, 7.894750e-02, 7.509792e-02, & ! + 7.160323e-02, 6.841653e-02, 6.549889e-02, 6.281763e-02, 6.034516e-02, & ! + 5.805802e-02, 5.593615e-02, 5.396226e-02, 5.202302e-02, 5.036246e-02, & ! + 4.879606e-02, 4.731610e-02, 4.591565e-02, 4.458852e-02, 4.332912e-02, & ! + 4.213243e-02, 4.099390e-02, 3.990941e-02, 3.887522e-02, 3.788792e-02, & ! + 3.694440e-02, 3.604183e-02, 3.517760e-02, 3.434934e-02, 3.355485e-02, & ! + 3.279211e-02, 3.205925e-02, 3.135458e-02, 3.067648e-02, 3.002349e-02, & ! + 2.939425e-02, 2.878748e-02, 2.820200e-02, 2.763673e-02, 2.709062e-02, & ! + 2.656272e-02, 2.605214e-02, 2.5558e-02, & ! + 9.193685e-01, 6.128292e-01, 4.344150e-01, 3.303048e-01, 2.659500e-01, & ! 3 + 2.239727e-01, 1.953457e-01, 1.751012e-01, 1.603515e-01, 1.493360e-01, & ! + 1.323791e-01, 1.219335e-01, 1.130076e-01, 1.052926e-01, 9.855839e-02, & ! + 9.262925e-02, 8.736918e-02, 8.267112e-02, 7.844965e-02, 7.463585e-02, & ! + 7.117343e-02, 6.801601e-02, 6.512503e-02, 6.246815e-02, 6.001806e-02, & ! + 5.775154e-02, 5.564872e-02, 5.369250e-02, 5.176284e-02, 5.011536e-02, & ! + 4.856099e-02, 4.709211e-02, 4.570193e-02, 4.438430e-02, 4.313375e-02, & ! + 4.194529e-02, 4.081443e-02, 3.973712e-02, 3.870966e-02, 3.772866e-02, & ! + 3.679108e-02, 3.589409e-02, 3.503514e-02, 3.421185e-02, 3.342206e-02, & ! + 3.266377e-02, 3.193513e-02, 3.123447e-02, 3.056018e-02, 2.991081e-02, & ! + 2.928502e-02, 2.868154e-02, 2.809920e-02, 2.753692e-02, 2.699367e-02, & ! + 2.646852e-02, 2.596057e-02, 2.5469e-02, & ! + 9.136931e-01, 5.743244e-01, 4.080708e-01, 3.150572e-01, 2.577261e-01, & ! 4 + 2.197900e-01, 1.933037e-01, 1.740212e-01, 1.595056e-01, 1.482756e-01, & ! + 1.312164e-01, 1.209246e-01, 1.121227e-01, 1.045095e-01, 9.785967e-02, & ! + 9.200149e-02, 8.680170e-02, 8.215531e-02, 7.797850e-02, 7.420361e-02, & ! + 7.077530e-02, 6.764798e-02, 6.478369e-02, 6.215063e-02, 5.972189e-02, & ! + 5.747458e-02, 5.538913e-02, 5.344866e-02, 5.153216e-02, 4.989745e-02, & ! + 4.835476e-02, 4.689661e-02, 4.551629e-02, 4.420777e-02, 4.296563e-02, & ! + 4.178497e-02, 4.066137e-02, 3.959081e-02, 3.856963e-02, 3.759452e-02, & ! + 3.666244e-02, 3.577061e-02, 3.491650e-02, 3.409777e-02, 3.331227e-02, & ! + 3.255803e-02, 3.183322e-02, 3.113617e-02, 3.046530e-02, 2.981918e-02, & ! + 2.919646e-02, 2.859591e-02, 2.801635e-02, 2.745671e-02, 2.691599e-02, & ! + 2.639324e-02, 2.588759e-02, 2.5398e-02, & ! + 8.447548e-01, 5.326840e-01, 3.921523e-01, 3.119082e-01, 2.597055e-01, & ! 5 + 2.228737e-01, 1.954157e-01, 1.741155e-01, 1.570881e-01, 1.431520e-01, & ! + 1.302034e-01, 1.200491e-01, 1.113571e-01, 1.038330e-01, 9.725657e-02, & ! + 9.145949e-02, 8.631112e-02, 8.170840e-02, 7.756901e-02, 7.382641e-02, & ! + 7.042616e-02, 6.732338e-02, 6.448069e-02, 6.186672e-02, 5.945494e-02, & ! + 5.722277e-02, 5.515089e-02, 5.322262e-02, 5.132153e-02, 4.969799e-02, & ! + 4.816556e-02, 4.671686e-02, 4.534525e-02, 4.404480e-02, 4.281014e-02, & ! + 4.163643e-02, 4.051930e-02, 3.945479e-02, 3.843927e-02, 3.746945e-02, & ! + 3.654234e-02, 3.565518e-02, 3.480547e-02, 3.399088e-02, 3.320930e-02, & ! + 3.245876e-02, 3.173745e-02, 3.104371e-02, 3.037600e-02, 2.973287e-02, & ! + 2.911300e-02, 2.851516e-02, 2.793818e-02, 2.738101e-02, 2.684264e-02, & ! + 2.632214e-02, 2.581863e-02, 2.5331e-02, & ! + 7.727642e-01, 5.034865e-01, 3.808673e-01, 3.080333e-01, 2.586453e-01, & ! 6 + 2.224989e-01, 1.947060e-01, 1.725821e-01, 1.545096e-01, 1.394456e-01, & ! + 1.288683e-01, 1.188852e-01, 1.103317e-01, 1.029214e-01, 9.643967e-02, & ! + 9.072239e-02, 8.564194e-02, 8.109758e-02, 7.700875e-02, 7.331026e-02, & ! + 6.994879e-02, 6.688028e-02, 6.406807e-02, 6.148133e-02, 5.909400e-02, & ! + 5.688388e-02, 5.483197e-02, 5.292185e-02, 5.103763e-02, 4.942905e-02, & ! + 4.791039e-02, 4.647438e-02, 4.511453e-02, 4.382497e-02, 4.260043e-02, & ! + 4.143616e-02, 4.032784e-02, 3.927155e-02, 3.826375e-02, 3.730117e-02, & ! + 3.638087e-02, 3.550013e-02, 3.465646e-02, 3.384759e-02, 3.307141e-02, & ! + 3.232598e-02, 3.160953e-02, 3.092040e-02, 3.025706e-02, 2.961810e-02, & ! + 2.900220e-02, 2.840814e-02, 2.783478e-02, 2.728106e-02, 2.674599e-02, & ! + 2.622864e-02, 2.572816e-02, 2.5244e-02, & ! + 7.416833e-01, 4.959591e-01, 3.775057e-01, 3.056353e-01, 2.565943e-01, & ! 7 + 2.206935e-01, 1.931479e-01, 1.712860e-01, 1.534837e-01, 1.386906e-01, & ! + 1.281198e-01, 1.182344e-01, 1.097595e-01, 1.024137e-01, 9.598552e-02, & ! + 9.031320e-02, 8.527093e-02, 8.075927e-02, 7.669869e-02, 7.302481e-02, & ! + 6.968491e-02, 6.663542e-02, 6.384008e-02, 6.126838e-02, 5.889452e-02, & ! + 5.669654e-02, 5.465558e-02, 5.275540e-02, 5.087937e-02, 4.927904e-02, & ! + 4.776796e-02, 4.633895e-02, 4.498557e-02, 4.370202e-02, 4.248306e-02, & ! + 4.132399e-02, 4.022052e-02, 3.916878e-02, 3.816523e-02, 3.720665e-02, & ! + 3.629011e-02, 3.541290e-02, 3.457257e-02, 3.376685e-02, 3.299365e-02, & ! + 3.225105e-02, 3.153728e-02, 3.085069e-02, 3.018977e-02, 2.955310e-02, & ! + 2.893940e-02, 2.834742e-02, 2.777606e-02, 2.722424e-02, 2.669099e-02, & ! + 2.617539e-02, 2.567658e-02, 2.5194e-02, & ! + 7.058580e-01, 4.866573e-01, 3.712238e-01, 2.998638e-01, 2.513441e-01, & ! 8 + 2.161972e-01, 1.895576e-01, 1.686669e-01, 1.518437e-01, 1.380046e-01, & ! + 1.267564e-01, 1.170399e-01, 1.087026e-01, 1.014704e-01, 9.513729e-02, & ! + 8.954555e-02, 8.457221e-02, 8.012009e-02, 7.611136e-02, 7.248294e-02, & ! + 6.918317e-02, 6.616934e-02, 6.340584e-02, 6.086273e-02, 5.851465e-02, & ! + 5.634001e-02, 5.432027e-02, 5.243946e-02, 5.058070e-02, 4.899628e-02, & ! + 4.749975e-02, 4.608411e-02, 4.474303e-02, 4.347082e-02, 4.226237e-02, & ! + 4.111303e-02, 4.001861e-02, 3.897528e-02, 3.797959e-02, 3.702835e-02, & ! + 3.611867e-02, 3.524791e-02, 3.441364e-02, 3.361360e-02, 3.284577e-02, & ! + 3.210823e-02, 3.139923e-02, 3.071716e-02, 3.006052e-02, 2.942791e-02, & ! + 2.881806e-02, 2.822974e-02, 2.766185e-02, 2.711335e-02, 2.658326e-02, & ! + 2.607066e-02, 2.557473e-02, 2.5095e-02, & ! + 6.822779e-01, 4.750373e-01, 3.634834e-01, 2.940726e-01, 2.468060e-01, & ! 9 + 2.125768e-01, 1.866586e-01, 1.663588e-01, 1.500326e-01, 1.366192e-01, & ! + 1.253472e-01, 1.158052e-01, 1.076101e-01, 1.004954e-01, 9.426089e-02, & ! + 8.875268e-02, 8.385090e-02, 7.946063e-02, 7.550578e-02, 7.192466e-02, & ! + 6.866669e-02, 6.569001e-02, 6.295971e-02, 6.044642e-02, 5.812526e-02, & ! + 5.597500e-02, 5.397746e-02, 5.211690e-02, 5.027505e-02, 4.870703e-02, & ! + 4.722555e-02, 4.582373e-02, 4.449540e-02, 4.323497e-02, 4.203742e-02, & ! + 4.089821e-02, 3.981321e-02, 3.877867e-02, 3.779118e-02, 3.684762e-02, & ! + 3.594514e-02, 3.508114e-02, 3.425322e-02, 3.345917e-02, 3.269698e-02, & ! + 3.196477e-02, 3.126082e-02, 3.058352e-02, 2.993141e-02, 2.930310e-02, & ! + 2.869732e-02, 2.811289e-02, 2.754869e-02, 2.700371e-02, 2.647698e-02, & ! + 2.596760e-02, 2.547473e-02, 2.4998e-02, & ! + 6.666233e-01, 4.662044e-01, 3.579517e-01, 2.902984e-01, 2.440475e-01, & ! 10 + 2.104431e-01, 1.849277e-01, 1.648970e-01, 1.487555e-01, 1.354714e-01, & ! + 1.244173e-01, 1.149913e-01, 1.068903e-01, 9.985323e-02, 9.368351e-02, & ! + 8.823009e-02, 8.337507e-02, 7.902511e-02, 7.510529e-02, 7.155482e-02, & ! + 6.832386e-02, 6.537113e-02, 6.266218e-02, 6.016802e-02, 5.786408e-02, & ! + 5.572939e-02, 5.374598e-02, 5.189830e-02, 5.006825e-02, 4.851081e-02, & ! + 4.703906e-02, 4.564623e-02, 4.432621e-02, 4.307349e-02, 4.188312e-02, & ! + 4.075060e-02, 3.967183e-02, 3.864313e-02, 3.766111e-02, 3.672269e-02, & ! + 3.582505e-02, 3.496559e-02, 3.414196e-02, 3.335198e-02, 3.259362e-02, & ! + 3.186505e-02, 3.116454e-02, 3.049052e-02, 2.984152e-02, 2.921617e-02, & ! + 2.861322e-02, 2.803148e-02, 2.746986e-02, 2.692733e-02, 2.640295e-02, & ! + 2.589582e-02, 2.540510e-02, 2.4930e-02, & ! + 6.535669e-01, 4.585865e-01, 3.529226e-01, 2.867245e-01, 2.413848e-01, & ! 11 + 2.083956e-01, 1.833191e-01, 1.636150e-01, 1.477247e-01, 1.346392e-01, & ! + 1.236449e-01, 1.143095e-01, 1.062828e-01, 9.930773e-02, 9.319029e-02, & ! + 8.778150e-02, 8.296497e-02, 7.864847e-02, 7.475799e-02, 7.123343e-02, & ! + 6.802549e-02, 6.509332e-02, 6.240285e-02, 5.992538e-02, 5.763657e-02, & ! + 5.551566e-02, 5.354483e-02, 5.170870e-02, 4.988866e-02, 4.834061e-02, & ! + 4.687751e-02, 4.549264e-02, 4.417999e-02, 4.293410e-02, 4.175006e-02, & ! + 4.062344e-02, 3.955019e-02, 3.852663e-02, 3.754943e-02, 3.661553e-02, & ! + 3.572214e-02, 3.486669e-02, 3.404683e-02, 3.326040e-02, 3.250542e-02, & ! + 3.178003e-02, 3.108254e-02, 3.041139e-02, 2.976511e-02, 2.914235e-02, & ! + 2.854187e-02, 2.796247e-02, 2.740309e-02, 2.686271e-02, 2.634038e-02, & ! + 2.583520e-02, 2.534636e-02, 2.4873e-02, & ! + 6.448790e-01, 4.541425e-01, 3.503348e-01, 2.850494e-01, 2.401966e-01, & ! 12 + 2.074811e-01, 1.825631e-01, 1.629515e-01, 1.471142e-01, 1.340574e-01, & ! + 1.231462e-01, 1.138628e-01, 1.058802e-01, 9.894286e-02, 9.285818e-02, & ! + 8.747802e-02, 8.268676e-02, 7.839271e-02, 7.452230e-02, 7.101580e-02, & ! + 6.782418e-02, 6.490685e-02, 6.222991e-02, 5.976484e-02, 5.748742e-02, & ! + 5.537703e-02, 5.341593e-02, 5.158883e-02, 4.977355e-02, 4.823172e-02, & ! + 4.677430e-02, 4.539465e-02, 4.408680e-02, 4.284533e-02, 4.166539e-02, & ! + 4.054257e-02, 3.947283e-02, 3.845256e-02, 3.747842e-02, 3.654737e-02, & ! + 3.565665e-02, 3.480370e-02, 3.398620e-02, 3.320198e-02, 3.244908e-02, & ! + 3.172566e-02, 3.103002e-02, 3.036062e-02, 2.971600e-02, 2.909482e-02, & ! + 2.849582e-02, 2.791785e-02, 2.735982e-02, 2.682072e-02, 2.629960e-02, & ! + 2.579559e-02, 2.530786e-02, 2.4836e-02, & ! + 6.422688e-01, 4.528453e-01, 3.497232e-01, 2.847724e-01, 2.400815e-01, & ! 13 + 2.074403e-01, 1.825502e-01, 1.629415e-01, 1.470934e-01, 1.340183e-01, & ! + 1.230935e-01, 1.138049e-01, 1.058201e-01, 9.888245e-02, 9.279878e-02, & ! + 8.742053e-02, 8.263175e-02, 7.834058e-02, 7.447327e-02, 7.097000e-02, & ! + 6.778167e-02, 6.486765e-02, 6.219400e-02, 5.973215e-02, 5.745790e-02, & ! + 5.535059e-02, 5.339250e-02, 5.156831e-02, 4.975308e-02, 4.821235e-02, & ! + 4.675596e-02, 4.537727e-02, 4.407030e-02, 4.282968e-02, 4.165053e-02, & ! + 4.052845e-02, 3.945941e-02, 3.843980e-02, 3.746628e-02, 3.653583e-02, & ! + 3.564567e-02, 3.479326e-02, 3.397626e-02, 3.319253e-02, 3.244008e-02, & ! + 3.171711e-02, 3.102189e-02, 3.035289e-02, 2.970866e-02, 2.908784e-02, & ! + 2.848920e-02, 2.791156e-02, 2.735385e-02, 2.681507e-02, 2.629425e-02, & ! + 2.579053e-02, 2.530308e-02, 2.4831e-02, & ! + 4.614710e-01, 4.556116e-01, 4.056568e-01, 3.529833e-01, 3.060334e-01, & ! 14 + 2.658127e-01, 2.316095e-01, 2.024325e-01, 1.773749e-01, 1.556867e-01, & ! + 1.455558e-01, 1.332882e-01, 1.229052e-01, 1.140067e-01, 1.062981e-01, & ! + 9.955703e-02, 9.361333e-02, 8.833420e-02, 8.361467e-02, 7.937071e-02, & ! + 7.553420e-02, 7.204942e-02, 6.887031e-02, 6.595851e-02, 6.328178e-02, & ! + 6.081286e-02, 5.852854e-02, 5.640892e-02, 5.431269e-02, 5.252561e-02, & ! + 5.084345e-02, 4.925727e-02, 4.775910e-02, 4.634182e-02, 4.499907e-02, & ! + 4.372512e-02, 4.251484e-02, 4.136357e-02, 4.026710e-02, 3.922162e-02, & ! + 3.822365e-02, 3.727004e-02, 3.635790e-02, 3.548457e-02, 3.464764e-02, & ! + 3.384488e-02, 3.307424e-02, 3.233384e-02, 3.162192e-02, 3.093688e-02, & ! + 3.027723e-02, 2.964158e-02, 2.902864e-02, 2.843722e-02, 2.786621e-02, & ! + 2.731457e-02, 2.678133e-02, 2.6266e-02/), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + extliq2 = reshape(source= (/ & ! + 9.004493E-01, 6.366723E-01, 4.542354E-01, 3.468253E-01, 2.816431E-01, & ! 1 + 2.383415E-01, 2.070854E-01, 1.831854E-01, 1.642115E-01, 1.487539E-01, & ! + 1.359169E-01, 1.250900E-01, 1.158354E-01, 1.078400E-01, 1.008646E-01, & ! + 9.472307E-02, 8.928000E-02, 8.442308E-02, 8.005924E-02, 7.612231E-02, & ! + 7.255153E-02, 6.929539E-02, 6.631769E-02, 6.358153E-02, 6.106231E-02, & ! + 5.873077E-02, 5.656924E-02, 5.455769E-02, 5.267846E-02, 5.091923E-02, & ! + 4.926692E-02, 4.771154E-02, 4.623923E-02, 4.484385E-02, 4.351539E-02, & ! + 4.224615E-02, 4.103385E-02, 3.986538E-02, 3.874077E-02, 3.765462E-02, & ! + 3.660077E-02, 3.557384E-02, 3.457615E-02, 3.360308E-02, 3.265000E-02, & ! + 3.171770E-02, 3.080538E-02, 2.990846E-02, 2.903000E-02, 2.816461E-02, & ! + 2.731539E-02, 2.648231E-02, 2.566308E-02, 2.485923E-02, 2.407000E-02, & ! + 2.329615E-02, 2.253769E-02, 2.179615E-02, & ! + 6.741200e-01, 5.390739e-01, 4.198767e-01, 3.332553e-01, 2.735633e-01, & ! 2 + 2.317727e-01, 2.012760e-01, 1.780400e-01, 1.596927e-01, 1.447980e-01, & ! + 1.324480e-01, 1.220347e-01, 1.131327e-01, 1.054313e-01, 9.870534e-02, & ! + 9.278200e-02, 8.752599e-02, 8.282933e-02, 7.860600e-02, 7.479133e-02, & ! + 7.132800e-02, 6.816733e-02, 6.527401e-02, 6.261266e-02, 6.015934e-02, & ! + 5.788867e-02, 5.578134e-02, 5.381667e-02, 5.198133e-02, 5.026067e-02, & ! + 4.864466e-02, 4.712267e-02, 4.568066e-02, 4.431200e-02, 4.300867e-02, & ! + 4.176600e-02, 4.057400e-02, 3.942534e-02, 3.832066e-02, 3.725068e-02, & ! + 3.621400e-02, 3.520533e-02, 3.422333e-02, 3.326400e-02, 3.232467e-02, & ! + 3.140535e-02, 3.050400e-02, 2.962000e-02, 2.875267e-02, 2.789800e-02, & ! + 2.705934e-02, 2.623667e-02, 2.542667e-02, 2.463200e-02, 2.385267e-02, & ! + 2.308667e-02, 2.233667e-02, 2.160067e-02, & ! + 9.250861e-01, 6.245692e-01, 4.347038e-01, 3.320208e-01, 2.714869e-01, & ! 3 + 2.309516e-01, 2.012592e-01, 1.783315e-01, 1.600369e-01, 1.451000e-01, & ! + 1.326838e-01, 1.222069e-01, 1.132554e-01, 1.055146e-01, 9.876000e-02, & ! + 9.281386e-02, 8.754000e-02, 8.283078e-02, 7.860077e-02, 7.477769e-02, & ! + 7.130847e-02, 6.814461e-02, 6.524615e-02, 6.258462e-02, 6.012847e-02, & ! + 5.785462e-02, 5.574231e-02, 5.378000e-02, 5.194461e-02, 5.022462e-02, & ! + 4.860846e-02, 4.708462e-02, 4.564154e-02, 4.427462e-02, 4.297231e-02, & ! + 4.172769e-02, 4.053693e-02, 3.939000e-02, 3.828462e-02, 3.721692e-02, & ! + 3.618000e-02, 3.517077e-02, 3.418923e-02, 3.323077e-02, 3.229154e-02, & ! + 3.137154e-02, 3.047154e-02, 2.959077e-02, 2.872308e-02, 2.786846e-02, & ! + 2.703077e-02, 2.620923e-02, 2.540077e-02, 2.460615e-02, 2.382693e-02, & ! + 2.306231e-02, 2.231231e-02, 2.157923e-02, & ! + 9.298960e-01, 5.776460e-01, 4.083450e-01, 3.211160e-01, 2.666390e-01, & ! 4 + 2.281990e-01, 1.993250e-01, 1.768080e-01, 1.587810e-01, 1.440390e-01, & ! + 1.317720e-01, 1.214150e-01, 1.125540e-01, 1.048890e-01, 9.819600e-02, & ! + 9.230201e-02, 8.706900e-02, 8.239698e-02, 7.819500e-02, 7.439899e-02, & ! + 7.095300e-02, 6.780700e-02, 6.492900e-02, 6.228600e-02, 5.984600e-02, & ! + 5.758599e-02, 5.549099e-02, 5.353801e-02, 5.171400e-02, 5.000500e-02, & ! + 4.840000e-02, 4.688500e-02, 4.545100e-02, 4.409300e-02, 4.279700e-02, & ! + 4.156100e-02, 4.037700e-02, 3.923800e-02, 3.813800e-02, 3.707600e-02, & ! + 3.604500e-02, 3.504300e-02, 3.406500e-02, 3.310800e-02, 3.217700e-02, & ! + 3.126600e-02, 3.036800e-02, 2.948900e-02, 2.862400e-02, 2.777500e-02, & ! + 2.694200e-02, 2.612300e-02, 2.531700e-02, 2.452800e-02, 2.375100e-02, & ! + 2.299100e-02, 2.224300e-02, 2.151201e-02, & ! + 8.780964e-01, 5.407031e-01, 3.961100e-01, 3.166645e-01, 2.640455e-01, & ! 5 + 2.261070e-01, 1.974820e-01, 1.751775e-01, 1.573415e-01, 1.427725e-01, & ! + 1.306535e-01, 1.204195e-01, 1.116650e-01, 1.040915e-01, 9.747550e-02, & ! + 9.164800e-02, 8.647649e-02, 8.185501e-02, 7.770200e-02, 7.394749e-02, & ! + 7.053800e-02, 6.742700e-02, 6.457999e-02, 6.196149e-02, 5.954450e-02, & ! + 5.730650e-02, 5.522949e-02, 5.329450e-02, 5.148500e-02, 4.979000e-02, & ! + 4.819600e-02, 4.669301e-02, 4.527050e-02, 4.391899e-02, 4.263500e-02, & ! + 4.140500e-02, 4.022850e-02, 3.909500e-02, 3.800199e-02, 3.694600e-02, & ! + 3.592000e-02, 3.492250e-02, 3.395050e-02, 3.300150e-02, 3.207250e-02, & ! + 3.116250e-02, 3.027100e-02, 2.939500e-02, 2.853500e-02, 2.768900e-02, & ! + 2.686000e-02, 2.604350e-02, 2.524150e-02, 2.445350e-02, 2.368049e-02, & ! + 2.292150e-02, 2.217800e-02, 2.144800e-02, & ! + 7.937480e-01, 5.123036e-01, 3.858181e-01, 3.099622e-01, 2.586829e-01, & ! 6 + 2.217587e-01, 1.939755e-01, 1.723397e-01, 1.550258e-01, 1.408600e-01, & ! + 1.290545e-01, 1.190661e-01, 1.105039e-01, 1.030848e-01, 9.659387e-02, & ! + 9.086775e-02, 8.577807e-02, 8.122452e-02, 7.712711e-02, 7.342193e-02, & ! + 7.005387e-02, 6.697840e-02, 6.416000e-02, 6.156903e-02, 5.917484e-02, & ! + 5.695807e-02, 5.489968e-02, 5.298097e-02, 5.118806e-02, 4.950645e-02, & ! + 4.792710e-02, 4.643581e-02, 4.502484e-02, 4.368547e-02, 4.241001e-02, & ! + 4.118936e-02, 4.002193e-02, 3.889711e-02, 3.781322e-02, 3.676387e-02, & ! + 3.574549e-02, 3.475548e-02, 3.379033e-02, 3.284678e-02, 3.192420e-02, & ! + 3.102032e-02, 3.013484e-02, 2.926258e-02, 2.840839e-02, 2.756742e-02, & ! + 2.674258e-02, 2.593064e-02, 2.513258e-02, 2.435000e-02, 2.358064e-02, & ! + 2.282581e-02, 2.208548e-02, 2.135936e-02, & ! + 7.533129e-01, 5.033129e-01, 3.811271e-01, 3.062757e-01, 2.558729e-01, & ! 7 + 2.196828e-01, 1.924372e-01, 1.711714e-01, 1.541086e-01, 1.401114e-01, & ! + 1.284257e-01, 1.185200e-01, 1.100243e-01, 1.026529e-01, 9.620142e-02, & ! + 9.050714e-02, 8.544428e-02, 8.091714e-02, 7.684000e-02, 7.315429e-02, & ! + 6.980143e-02, 6.673999e-02, 6.394000e-02, 6.136000e-02, 5.897715e-02, & ! + 5.677000e-02, 5.472285e-02, 5.281286e-02, 5.102858e-02, 4.935429e-02, & ! + 4.778000e-02, 4.629714e-02, 4.489142e-02, 4.355857e-02, 4.228715e-02, & ! + 4.107285e-02, 3.990857e-02, 3.879000e-02, 3.770999e-02, 3.666429e-02, & ! + 3.565000e-02, 3.466286e-02, 3.370143e-02, 3.276143e-02, 3.184143e-02, & ! + 3.094000e-02, 3.005714e-02, 2.919000e-02, 2.833714e-02, 2.750000e-02, & ! + 2.667714e-02, 2.586714e-02, 2.507143e-02, 2.429143e-02, 2.352428e-02, & ! + 2.277143e-02, 2.203429e-02, 2.130857e-02, & ! + 7.079894e-01, 4.878198e-01, 3.719852e-01, 3.001873e-01, 2.514795e-01, & ! 8 + 2.163013e-01, 1.897100e-01, 1.689033e-01, 1.521793e-01, 1.384449e-01, & ! + 1.269666e-01, 1.172326e-01, 1.088745e-01, 1.016224e-01, 9.527085e-02, & ! + 8.966240e-02, 8.467543e-02, 8.021144e-02, 7.619344e-02, 7.255676e-02, & ! + 6.924996e-02, 6.623030e-02, 6.346261e-02, 6.091499e-02, 5.856325e-02, & ! + 5.638385e-02, 5.435930e-02, 5.247156e-02, 5.070699e-02, 4.905230e-02, & ! + 4.749499e-02, 4.602611e-02, 4.463581e-02, 4.331543e-02, 4.205647e-02, & ! + 4.085241e-02, 3.969978e-02, 3.859033e-02, 3.751877e-02, 3.648168e-02, & ! + 3.547468e-02, 3.449553e-02, 3.354072e-02, 3.260732e-02, 3.169438e-02, & ! + 3.079969e-02, 2.992146e-02, 2.905875e-02, 2.821201e-02, 2.737873e-02, & ! + 2.656052e-02, 2.575586e-02, 2.496511e-02, 2.418783e-02, 2.342500e-02, & ! + 2.267646e-02, 2.194177e-02, 2.122146e-02, & ! + 6.850164e-01, 4.762468e-01, 3.642001e-01, 2.946012e-01, 2.472001e-01, & ! 9 + 2.128588e-01, 1.868537e-01, 1.664893e-01, 1.501142e-01, 1.366620e-01, & ! + 1.254147e-01, 1.158721e-01, 1.076732e-01, 1.005530e-01, 9.431306e-02, & ! + 8.879891e-02, 8.389232e-02, 7.949714e-02, 7.553857e-02, 7.195474e-02, & ! + 6.869413e-02, 6.571444e-02, 6.298286e-02, 6.046779e-02, 5.814474e-02, & ! + 5.599141e-02, 5.399114e-02, 5.212443e-02, 5.037870e-02, 4.874321e-02, & ! + 4.720219e-02, 4.574813e-02, 4.437160e-02, 4.306460e-02, 4.181810e-02, & ! + 4.062603e-02, 3.948252e-02, 3.838256e-02, 3.732049e-02, 3.629192e-02, & ! + 3.529301e-02, 3.432190e-02, 3.337412e-02, 3.244842e-02, 3.154175e-02, & ! + 3.065253e-02, 2.978063e-02, 2.892367e-02, 2.808221e-02, 2.725478e-02, & ! + 2.644174e-02, 2.564175e-02, 2.485508e-02, 2.408303e-02, 2.332365e-02, & ! + 2.257890e-02, 2.184824e-02, 2.113224e-02, & ! + 6.673017e-01, 4.664520e-01, 3.579398e-01, 2.902234e-01, 2.439904e-01, & ! 10 + 2.104149e-01, 1.849277e-01, 1.649234e-01, 1.488087e-01, 1.355515e-01, & ! + 1.244562e-01, 1.150329e-01, 1.069321e-01, 9.989310e-02, 9.372070e-02, & ! + 8.826450e-02, 8.340622e-02, 7.905378e-02, 7.513109e-02, 7.157859e-02, & ! + 6.834588e-02, 6.539114e-02, 6.268150e-02, 6.018621e-02, 5.788098e-02, & ! + 5.574351e-02, 5.375699e-02, 5.190412e-02, 5.017099e-02, 4.854497e-02, & ! + 4.701490e-02, 4.557030e-02, 4.420249e-02, 4.290304e-02, 4.166427e-02, & ! + 4.047820e-02, 3.934232e-02, 3.824778e-02, 3.719236e-02, 3.616931e-02, & ! + 3.517597e-02, 3.420856e-02, 3.326566e-02, 3.234346e-02, 3.144122e-02, & ! + 3.055684e-02, 2.968798e-02, 2.883519e-02, 2.799635e-02, 2.717228e-02, & ! + 2.636182e-02, 2.556424e-02, 2.478114e-02, 2.401086e-02, 2.325657e-02, & ! + 2.251506e-02, 2.178594e-02, 2.107301e-02, & ! + 6.552414e-01, 4.599454e-01, 3.538626e-01, 2.873547e-01, 2.418033e-01, & ! 11 + 2.086660e-01, 1.834885e-01, 1.637142e-01, 1.477767e-01, 1.346583e-01, & ! + 1.236734e-01, 1.143412e-01, 1.063148e-01, 9.933905e-02, 9.322026e-02, & ! + 8.780979e-02, 8.299230e-02, 7.867554e-02, 7.478450e-02, 7.126053e-02, & ! + 6.805276e-02, 6.512143e-02, 6.243211e-02, 5.995541e-02, 5.766712e-02, & ! + 5.554484e-02, 5.357246e-02, 5.173222e-02, 5.001069e-02, 4.839505e-02, & ! + 4.687471e-02, 4.543861e-02, 4.407857e-02, 4.278577e-02, 4.155331e-02, & ! + 4.037322e-02, 3.924302e-02, 3.815376e-02, 3.710172e-02, 3.608296e-02, & ! + 3.509330e-02, 3.412980e-02, 3.319009e-02, 3.227106e-02, 3.137157e-02, & ! + 3.048950e-02, 2.962365e-02, 2.877297e-02, 2.793726e-02, 2.711500e-02, & ! + 2.630666e-02, 2.551206e-02, 2.473052e-02, 2.396287e-02, 2.320861e-02, & ! + 2.246810e-02, 2.174162e-02, 2.102927e-02, & ! + 6.430901e-01, 4.532134e-01, 3.496132e-01, 2.844655e-01, 2.397347e-01, & ! 12 + 2.071236e-01, 1.822976e-01, 1.627640e-01, 1.469961e-01, 1.340006e-01, & ! + 1.231069e-01, 1.138441e-01, 1.058706e-01, 9.893678e-02, 9.285166e-02, & ! + 8.746871e-02, 8.267411e-02, 7.837656e-02, 7.450257e-02, 7.099318e-02, & ! + 6.779929e-02, 6.487987e-02, 6.220168e-02, 5.973530e-02, 5.745636e-02, & ! + 5.534344e-02, 5.337986e-02, 5.154797e-02, 4.983404e-02, 4.822582e-02, & ! + 4.671228e-02, 4.528321e-02, 4.392997e-02, 4.264325e-02, 4.141647e-02, & ! + 4.024259e-02, 3.911767e-02, 3.803309e-02, 3.698782e-02, 3.597140e-02, & ! + 3.498774e-02, 3.402852e-02, 3.309340e-02, 3.217818e-02, 3.128292e-02, & ! + 3.040486e-02, 2.954230e-02, 2.869545e-02, 2.786261e-02, 2.704372e-02, & ! + 2.623813e-02, 2.544668e-02, 2.466788e-02, 2.390313e-02, 2.315136e-02, & ! + 2.241391e-02, 2.168921e-02, 2.097903e-02, & ! + 6.367074e-01, 4.495768e-01, 3.471263e-01, 2.826149e-01, 2.382868e-01, & ! 13 + 2.059640e-01, 1.813562e-01, 1.619881e-01, 1.463436e-01, 1.334402e-01, & ! + 1.226166e-01, 1.134096e-01, 1.054829e-01, 9.858838e-02, 9.253790e-02, & ! + 8.718582e-02, 8.241830e-02, 7.814482e-02, 7.429212e-02, 7.080165e-02, & ! + 6.762385e-02, 6.471838e-02, 6.205388e-02, 5.959726e-02, 5.732871e-02, & ! + 5.522402e-02, 5.326793e-02, 5.144230e-02, 4.973440e-02, 4.813188e-02, & ! + 4.662283e-02, 4.519798e-02, 4.384833e-02, 4.256541e-02, 4.134253e-02, & ! + 4.017136e-02, 3.904911e-02, 3.796779e-02, 3.692364e-02, 3.591182e-02, & ! + 3.492930e-02, 3.397230e-02, 3.303920e-02, 3.212572e-02, 3.123278e-02, & ! + 3.035519e-02, 2.949493e-02, 2.864985e-02, 2.781840e-02, 2.700197e-02, & ! + 2.619682e-02, 2.540674e-02, 2.462966e-02, 2.386613e-02, 2.311602e-02, & ! + 2.237846e-02, 2.165660e-02, 2.094756e-02, & ! + 4.298416e-01, 4.391639e-01, 3.975030e-01, 3.443028e-01, 2.957345e-01, & ! 14 + 2.556461e-01, 2.234755e-01, 1.976636e-01, 1.767428e-01, 1.595611e-01, & ! + 1.452636e-01, 1.332156e-01, 1.229481e-01, 1.141059e-01, 1.064208e-01, & ! + 9.968527e-02, 9.373833e-02, 8.845221e-02, 8.372112e-02, 7.946667e-02, & ! + 7.561807e-02, 7.212029e-02, 6.893166e-02, 6.600944e-02, 6.332277e-02, & ! + 6.084277e-02, 5.854721e-02, 5.641361e-02, 5.442639e-02, 5.256750e-02, & ! + 5.082499e-02, 4.918556e-02, 4.763694e-02, 4.617222e-02, 4.477861e-02, & ! + 4.344861e-02, 4.217999e-02, 4.096111e-02, 3.978638e-02, 3.865361e-02, & ! + 3.755473e-02, 3.649028e-02, 3.545361e-02, 3.444361e-02, 3.345666e-02, & ! + 3.249167e-02, 3.154722e-02, 3.062083e-02, 2.971250e-02, 2.882083e-02, & ! + 2.794611e-02, 2.708778e-02, 2.624500e-02, 2.541750e-02, 2.460528e-02, & ! + 2.381194e-02, 2.303250e-02, 2.226833e-02/), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + ssaliq1 = reshape(source= (/ & ! + 8.143821e-01, 7.836739e-01, 7.550722e-01, 7.306269e-01, 7.105612e-01, & ! 1 + 6.946649e-01, 6.825556e-01, 6.737762e-01, 6.678448e-01, 6.642830e-01, & ! + 6.679741e-01, 6.584607e-01, 6.505598e-01, 6.440951e-01, 6.388901e-01, & ! + 6.347689e-01, 6.315549e-01, 6.290718e-01, 6.271432e-01, 6.255928e-01, & ! + 6.242441e-01, 6.229207e-01, 6.214464e-01, 6.196445e-01, 6.173388e-01, & ! + 6.143527e-01, 6.105099e-01, 6.056339e-01, 6.108290e-01, 6.073939e-01, & ! + 6.043073e-01, 6.015473e-01, 5.990913e-01, 5.969173e-01, 5.950028e-01, & ! + 5.933257e-01, 5.918636e-01, 5.905944e-01, 5.894957e-01, 5.885453e-01, & ! + 5.877209e-01, 5.870003e-01, 5.863611e-01, 5.857811e-01, 5.852381e-01, & ! + 5.847098e-01, 5.841738e-01, 5.836081e-01, 5.829901e-01, 5.822979e-01, & ! + 5.815089e-01, 5.806011e-01, 5.795521e-01, 5.783396e-01, 5.769413e-01, & ! + 5.753351e-01, 5.734986e-01, 5.7141e-01, & ! + 8.165821e-01, 8.002015e-01, 7.816921e-01, 7.634131e-01, 7.463721e-01, & ! 2 + 7.312469e-01, 7.185883e-01, 7.088975e-01, 7.026671e-01, 7.004020e-01, & ! + 7.042138e-01, 6.960930e-01, 6.894243e-01, 6.840459e-01, 6.797957e-01, & ! + 6.765119e-01, 6.740325e-01, 6.721955e-01, 6.708391e-01, 6.698013e-01, & ! + 6.689201e-01, 6.680339e-01, 6.669805e-01, 6.655982e-01, 6.637250e-01, & ! + 6.611992e-01, 6.578588e-01, 6.535420e-01, 6.584449e-01, 6.553992e-01, & ! + 6.526547e-01, 6.501917e-01, 6.479905e-01, 6.460313e-01, 6.442945e-01, & ! + 6.427605e-01, 6.414094e-01, 6.402217e-01, 6.391775e-01, 6.382573e-01, & ! + 6.374413e-01, 6.367099e-01, 6.360433e-01, 6.354218e-01, 6.348257e-01, & ! + 6.342355e-01, 6.336313e-01, 6.329935e-01, 6.323023e-01, 6.315383e-01, & ! + 6.306814e-01, 6.297122e-01, 6.286110e-01, 6.273579e-01, 6.259333e-01, & ! + 6.243176e-01, 6.224910e-01, 6.2043e-01, & ! + 9.900163e-01, 9.854307e-01, 9.797730e-01, 9.733113e-01, 9.664245e-01, & ! 3 + 9.594976e-01, 9.529055e-01, 9.470112e-01, 9.421695e-01, 9.387304e-01, & ! + 9.344918e-01, 9.305302e-01, 9.267048e-01, 9.230072e-01, 9.194289e-01, & ! + 9.159616e-01, 9.125968e-01, 9.093260e-01, 9.061409e-01, 9.030330e-01, & ! + 8.999940e-01, 8.970154e-01, 8.940888e-01, 8.912058e-01, 8.883579e-01, & ! + 8.855368e-01, 8.827341e-01, 8.799413e-01, 8.777423e-01, 8.749566e-01, & ! + 8.722298e-01, 8.695605e-01, 8.669469e-01, 8.643875e-01, 8.618806e-01, & ! + 8.594246e-01, 8.570179e-01, 8.546589e-01, 8.523459e-01, 8.500773e-01, & ! + 8.478516e-01, 8.456670e-01, 8.435219e-01, 8.414148e-01, 8.393439e-01, & ! + 8.373078e-01, 8.353047e-01, 8.333330e-01, 8.313911e-01, 8.294774e-01, & ! + 8.275904e-01, 8.257282e-01, 8.238893e-01, 8.220721e-01, 8.202751e-01, & ! + 8.184965e-01, 8.167346e-01, 8.1499e-01, & ! + 9.999916e-01, 9.987396e-01, 9.966900e-01, 9.950738e-01, 9.937531e-01, & ! 4 + 9.925912e-01, 9.914525e-01, 9.902018e-01, 9.887046e-01, 9.868263e-01, & ! + 9.849039e-01, 9.832372e-01, 9.815265e-01, 9.797770e-01, 9.779940e-01, & ! + 9.761827e-01, 9.743481e-01, 9.724955e-01, 9.706303e-01, 9.687575e-01, & ! + 9.668823e-01, 9.650100e-01, 9.631457e-01, 9.612947e-01, 9.594622e-01, & ! + 9.576534e-01, 9.558734e-01, 9.541275e-01, 9.522059e-01, 9.504258e-01, & ! + 9.486459e-01, 9.468676e-01, 9.450921e-01, 9.433208e-01, 9.415548e-01, & ! + 9.397955e-01, 9.380441e-01, 9.363022e-01, 9.345706e-01, 9.328510e-01, & ! + 9.311445e-01, 9.294524e-01, 9.277761e-01, 9.261167e-01, 9.244755e-01, & ! + 9.228540e-01, 9.212534e-01, 9.196748e-01, 9.181197e-01, 9.165894e-01, & ! + 9.150851e-01, 9.136080e-01, 9.121596e-01, 9.107410e-01, 9.093536e-01, & ! + 9.079987e-01, 9.066775e-01, 9.0539e-01, & ! + 9.979493e-01, 9.964113e-01, 9.950014e-01, 9.937045e-01, 9.924964e-01, & ! 5 + 9.913546e-01, 9.902575e-01, 9.891843e-01, 9.881136e-01, 9.870238e-01, & ! + 9.859934e-01, 9.849372e-01, 9.838873e-01, 9.828434e-01, 9.818052e-01, & ! + 9.807725e-01, 9.797450e-01, 9.787225e-01, 9.777047e-01, 9.766914e-01, & ! + 9.756823e-01, 9.746771e-01, 9.736756e-01, 9.726775e-01, 9.716827e-01, & ! + 9.706907e-01, 9.697014e-01, 9.687145e-01, 9.678060e-01, 9.668108e-01, & ! + 9.658218e-01, 9.648391e-01, 9.638629e-01, 9.628936e-01, 9.619313e-01, & ! + 9.609763e-01, 9.600287e-01, 9.590888e-01, 9.581569e-01, 9.572330e-01, & ! + 9.563176e-01, 9.554108e-01, 9.545128e-01, 9.536239e-01, 9.527443e-01, & ! + 9.518741e-01, 9.510137e-01, 9.501633e-01, 9.493230e-01, 9.484931e-01, & ! + 9.476740e-01, 9.468656e-01, 9.460683e-01, 9.452824e-01, 9.445080e-01, & ! + 9.437454e-01, 9.429948e-01, 9.4226e-01, & ! + 9.988742e-01, 9.982668e-01, 9.976935e-01, 9.971497e-01, 9.966314e-01, & ! 6 + 9.961344e-01, 9.956545e-01, 9.951873e-01, 9.947286e-01, 9.942741e-01, & ! + 9.938457e-01, 9.933947e-01, 9.929473e-01, 9.925032e-01, 9.920621e-01, & ! + 9.916237e-01, 9.911875e-01, 9.907534e-01, 9.903209e-01, 9.898898e-01, & ! + 9.894597e-01, 9.890304e-01, 9.886015e-01, 9.881726e-01, 9.877435e-01, & ! + 9.873138e-01, 9.868833e-01, 9.864516e-01, 9.860698e-01, 9.856317e-01, & ! + 9.851957e-01, 9.847618e-01, 9.843302e-01, 9.839008e-01, 9.834739e-01, & ! + 9.830494e-01, 9.826275e-01, 9.822083e-01, 9.817918e-01, 9.813782e-01, & ! + 9.809675e-01, 9.805598e-01, 9.801552e-01, 9.797538e-01, 9.793556e-01, & ! + 9.789608e-01, 9.785695e-01, 9.781817e-01, 9.777975e-01, 9.774171e-01, & ! + 9.770404e-01, 9.766676e-01, 9.762988e-01, 9.759340e-01, 9.755733e-01, & ! + 9.752169e-01, 9.748649e-01, 9.7452e-01, & ! + 9.994441e-01, 9.991608e-01, 9.988949e-01, 9.986439e-01, 9.984054e-01, & ! 7 + 9.981768e-01, 9.979557e-01, 9.977396e-01, 9.975258e-01, 9.973120e-01, & ! + 9.971011e-01, 9.968852e-01, 9.966708e-01, 9.964578e-01, 9.962462e-01, & ! + 9.960357e-01, 9.958264e-01, 9.956181e-01, 9.954108e-01, 9.952043e-01, & ! + 9.949987e-01, 9.947937e-01, 9.945892e-01, 9.943853e-01, 9.941818e-01, & ! + 9.939786e-01, 9.937757e-01, 9.935728e-01, 9.933922e-01, 9.931825e-01, & ! + 9.929739e-01, 9.927661e-01, 9.925592e-01, 9.923534e-01, 9.921485e-01, & ! + 9.919447e-01, 9.917421e-01, 9.915406e-01, 9.913403e-01, 9.911412e-01, & ! + 9.909435e-01, 9.907470e-01, 9.905519e-01, 9.903581e-01, 9.901659e-01, & ! + 9.899751e-01, 9.897858e-01, 9.895981e-01, 9.894120e-01, 9.892276e-01, & ! + 9.890447e-01, 9.888637e-01, 9.886845e-01, 9.885070e-01, 9.883314e-01, & ! + 9.881576e-01, 9.879859e-01, 9.8782e-01, & ! + 9.999138e-01, 9.998730e-01, 9.998338e-01, 9.997965e-01, 9.997609e-01, & ! 8 + 9.997270e-01, 9.996944e-01, 9.996629e-01, 9.996321e-01, 9.996016e-01, & ! + 9.995690e-01, 9.995372e-01, 9.995057e-01, 9.994744e-01, 9.994433e-01, & ! + 9.994124e-01, 9.993817e-01, 9.993510e-01, 9.993206e-01, 9.992903e-01, & ! + 9.992600e-01, 9.992299e-01, 9.991998e-01, 9.991698e-01, 9.991398e-01, & ! + 9.991098e-01, 9.990799e-01, 9.990499e-01, 9.990231e-01, 9.989920e-01, & ! + 9.989611e-01, 9.989302e-01, 9.988996e-01, 9.988690e-01, 9.988386e-01, & ! + 9.988084e-01, 9.987783e-01, 9.987485e-01, 9.987187e-01, 9.986891e-01, & ! + 9.986598e-01, 9.986306e-01, 9.986017e-01, 9.985729e-01, 9.985443e-01, & ! + 9.985160e-01, 9.984879e-01, 9.984600e-01, 9.984324e-01, 9.984050e-01, & ! + 9.983778e-01, 9.983509e-01, 9.983243e-01, 9.982980e-01, 9.982719e-01, & ! + 9.982461e-01, 9.982206e-01, 9.9820e-01, & ! + 9.999985e-01, 9.999979e-01, 9.999972e-01, 9.999966e-01, 9.999961e-01, & ! 9 + 9.999955e-01, 9.999950e-01, 9.999944e-01, 9.999938e-01, 9.999933e-01, & ! + 9.999927e-01, 9.999921e-01, 9.999915e-01, 9.999910e-01, 9.999904e-01, & ! + 9.999899e-01, 9.999893e-01, 9.999888e-01, 9.999882e-01, 9.999877e-01, & ! + 9.999871e-01, 9.999866e-01, 9.999861e-01, 9.999855e-01, 9.999850e-01, & ! + 9.999844e-01, 9.999839e-01, 9.999833e-01, 9.999828e-01, 9.999823e-01, & ! + 9.999817e-01, 9.999812e-01, 9.999807e-01, 9.999801e-01, 9.999796e-01, & ! + 9.999791e-01, 9.999786e-01, 9.999781e-01, 9.999776e-01, 9.999770e-01, & ! + 9.999765e-01, 9.999761e-01, 9.999756e-01, 9.999751e-01, 9.999746e-01, & ! + 9.999741e-01, 9.999736e-01, 9.999732e-01, 9.999727e-01, 9.999722e-01, & ! + 9.999718e-01, 9.999713e-01, 9.999709e-01, 9.999705e-01, 9.999701e-01, & ! + 9.999697e-01, 9.999692e-01, 9.9997e-01, & ! + 9.999999e-01, 9.999998e-01, 9.999997e-01, 9.999997e-01, 9.999997e-01, & ! 10 + 9.999996e-01, 9.999996e-01, 9.999995e-01, 9.999995e-01, 9.999994e-01, & ! + 9.999994e-01, 9.999993e-01, 9.999993e-01, 9.999992e-01, 9.999992e-01, & ! + 9.999991e-01, 9.999991e-01, 9.999991e-01, 9.999990e-01, 9.999989e-01, & ! + 9.999989e-01, 9.999989e-01, 9.999988e-01, 9.999988e-01, 9.999987e-01, & ! + 9.999987e-01, 9.999986e-01, 9.999986e-01, 9.999985e-01, 9.999985e-01, & ! + 9.999984e-01, 9.999984e-01, 9.999984e-01, 9.999983e-01, 9.999983e-01, & ! + 9.999982e-01, 9.999982e-01, 9.999982e-01, 9.999981e-01, 9.999980e-01, & ! + 9.999980e-01, 9.999980e-01, 9.999979e-01, 9.999979e-01, 9.999978e-01, & ! + 9.999978e-01, 9.999977e-01, 9.999977e-01, 9.999977e-01, 9.999976e-01, & ! + 9.999976e-01, 9.999975e-01, 9.999975e-01, 9.999974e-01, 9.999974e-01, & ! + 9.999974e-01, 9.999973e-01, 1.0000e+00, & ! + 9.999997e-01, 9.999995e-01, 9.999993e-01, 9.999992e-01, 9.999990e-01, & ! 11 + 9.999989e-01, 9.999988e-01, 9.999987e-01, 9.999986e-01, 9.999985e-01, & ! + 9.999984e-01, 9.999983e-01, 9.999982e-01, 9.999981e-01, 9.999980e-01, & ! + 9.999978e-01, 9.999977e-01, 9.999976e-01, 9.999975e-01, 9.999974e-01, & ! + 9.999973e-01, 9.999972e-01, 9.999970e-01, 9.999969e-01, 9.999968e-01, & ! + 9.999967e-01, 9.999966e-01, 9.999965e-01, 9.999964e-01, 9.999963e-01, & ! + 9.999962e-01, 9.999961e-01, 9.999959e-01, 9.999958e-01, 9.999957e-01, & ! + 9.999956e-01, 9.999955e-01, 9.999954e-01, 9.999953e-01, 9.999952e-01, & ! + 9.999951e-01, 9.999949e-01, 9.999949e-01, 9.999947e-01, 9.999946e-01, & ! + 9.999945e-01, 9.999944e-01, 9.999943e-01, 9.999942e-01, 9.999941e-01, & ! + 9.999940e-01, 9.999939e-01, 9.999938e-01, 9.999937e-01, 9.999936e-01, & ! + 9.999935e-01, 9.999934e-01, 9.9999e-01, & ! + 9.999984e-01, 9.999976e-01, 9.999969e-01, 9.999962e-01, 9.999956e-01, & ! 12 + 9.999950e-01, 9.999945e-01, 9.999940e-01, 9.999935e-01, 9.999931e-01, & ! + 9.999926e-01, 9.999920e-01, 9.999914e-01, 9.999908e-01, 9.999903e-01, & ! + 9.999897e-01, 9.999891e-01, 9.999886e-01, 9.999880e-01, 9.999874e-01, & ! + 9.999868e-01, 9.999863e-01, 9.999857e-01, 9.999851e-01, 9.999846e-01, & ! + 9.999840e-01, 9.999835e-01, 9.999829e-01, 9.999824e-01, 9.999818e-01, & ! + 9.999812e-01, 9.999806e-01, 9.999800e-01, 9.999795e-01, 9.999789e-01, & ! + 9.999783e-01, 9.999778e-01, 9.999773e-01, 9.999767e-01, 9.999761e-01, & ! + 9.999756e-01, 9.999750e-01, 9.999745e-01, 9.999739e-01, 9.999734e-01, & ! + 9.999729e-01, 9.999723e-01, 9.999718e-01, 9.999713e-01, 9.999708e-01, & ! + 9.999703e-01, 9.999697e-01, 9.999692e-01, 9.999687e-01, 9.999683e-01, & ! + 9.999678e-01, 9.999673e-01, 9.9997e-01, & ! + 9.999981e-01, 9.999973e-01, 9.999965e-01, 9.999958e-01, 9.999951e-01, & ! 13 + 9.999943e-01, 9.999937e-01, 9.999930e-01, 9.999924e-01, 9.999918e-01, & ! + 9.999912e-01, 9.999905e-01, 9.999897e-01, 9.999890e-01, 9.999883e-01, & ! + 9.999876e-01, 9.999869e-01, 9.999862e-01, 9.999855e-01, 9.999847e-01, & ! + 9.999840e-01, 9.999834e-01, 9.999827e-01, 9.999819e-01, 9.999812e-01, & ! + 9.999805e-01, 9.999799e-01, 9.999791e-01, 9.999785e-01, 9.999778e-01, & ! + 9.999771e-01, 9.999764e-01, 9.999757e-01, 9.999750e-01, 9.999743e-01, & ! + 9.999736e-01, 9.999729e-01, 9.999722e-01, 9.999715e-01, 9.999709e-01, & ! + 9.999701e-01, 9.999695e-01, 9.999688e-01, 9.999682e-01, 9.999675e-01, & ! + 9.999669e-01, 9.999662e-01, 9.999655e-01, 9.999649e-01, 9.999642e-01, & ! + 9.999636e-01, 9.999630e-01, 9.999624e-01, 9.999618e-01, 9.999612e-01, & ! + 9.999606e-01, 9.999600e-01, 9.9996e-01, & ! + 8.505737e-01, 8.465102e-01, 8.394829e-01, 8.279508e-01, 8.110806e-01, & ! 14 + 7.900397e-01, 7.669615e-01, 7.444422e-01, 7.253055e-01, 7.124831e-01, & ! + 7.016434e-01, 6.885485e-01, 6.767340e-01, 6.661029e-01, 6.565577e-01, & ! + 6.480013e-01, 6.403373e-01, 6.334697e-01, 6.273034e-01, 6.217440e-01, & ! + 6.166983e-01, 6.120740e-01, 6.077796e-01, 6.037249e-01, 5.998207e-01, & ! + 5.959788e-01, 5.921123e-01, 5.881354e-01, 5.891285e-01, 5.851143e-01, & ! + 5.814653e-01, 5.781606e-01, 5.751792e-01, 5.724998e-01, 5.701016e-01, & ! + 5.679634e-01, 5.660642e-01, 5.643829e-01, 5.628984e-01, 5.615898e-01, & ! + 5.604359e-01, 5.594158e-01, 5.585083e-01, 5.576924e-01, 5.569470e-01, & ! + 5.562512e-01, 5.555838e-01, 5.549239e-01, 5.542503e-01, 5.535420e-01, & ! + 5.527781e-01, 5.519374e-01, 5.509989e-01, 5.499417e-01, 5.487445e-01, & ! + 5.473865e-01, 5.458466e-01, 5.4410e-01 /), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + ssaliq2 = reshape(source= (/ & ! + 8.362119e-01, 8.098460e-01, 7.762291e-01, 7.486042e-01, 7.294172e-01, & ! 1 + 7.161000e-01, 7.060656e-01, 6.978387e-01, 6.907193e-01, 6.843551e-01, & ! + 6.785668e-01, 6.732450e-01, 6.683191e-01, 6.637264e-01, 6.594307e-01, & ! + 6.554033e-01, 6.516115e-01, 6.480295e-01, 6.446429e-01, 6.414306e-01, & ! + 6.383783e-01, 6.354750e-01, 6.327068e-01, 6.300665e-01, 6.275376e-01, & ! + 6.251245e-01, 6.228136e-01, 6.205944e-01, 6.184720e-01, 6.164330e-01, & ! + 6.144742e-01, 6.125962e-01, 6.108004e-01, 6.090740e-01, 6.074200e-01, & ! + 6.058381e-01, 6.043209e-01, 6.028681e-01, 6.014836e-01, 6.001626e-01, & ! + 5.988957e-01, 5.976864e-01, 5.965390e-01, 5.954379e-01, 5.943972e-01, & ! + 5.934019e-01, 5.924624e-01, 5.915579e-01, 5.907025e-01, 5.898913e-01, & ! + 5.891213e-01, 5.883815e-01, 5.876851e-01, 5.870158e-01, 5.863868e-01, & ! + 5.857821e-01, 5.852111e-01, 5.846579e-01, & ! + 6.995459e-01, 7.158012e-01, 7.076001e-01, 6.927244e-01, 6.786434e-01, & ! 2 + 6.673545e-01, 6.585859e-01, 6.516314e-01, 6.459010e-01, 6.410225e-01, & ! + 6.367574e-01, 6.329554e-01, 6.295119e-01, 6.263595e-01, 6.234462e-01, & ! + 6.207274e-01, 6.181755e-01, 6.157678e-01, 6.134880e-01, 6.113173e-01, & ! + 6.092495e-01, 6.072689e-01, 6.053717e-01, 6.035507e-01, 6.018001e-01, & ! + 6.001134e-01, 5.984951e-01, 5.969294e-01, 5.954256e-01, 5.939698e-01, & ! + 5.925716e-01, 5.912265e-01, 5.899270e-01, 5.886771e-01, 5.874746e-01, & ! + 5.863185e-01, 5.852077e-01, 5.841460e-01, 5.831249e-01, 5.821474e-01, & ! + 5.812078e-01, 5.803173e-01, 5.794616e-01, 5.786443e-01, 5.778617e-01, & ! + 5.771236e-01, 5.764191e-01, 5.757400e-01, 5.750971e-01, 5.744842e-01, & ! + 5.739012e-01, 5.733482e-01, 5.728175e-01, 5.723214e-01, 5.718383e-01, & ! + 5.713827e-01, 5.709471e-01, 5.705330e-01, & ! + 9.929711e-01, 9.896942e-01, 9.852408e-01, 9.806820e-01, 9.764512e-01, & ! 3 + 9.725375e-01, 9.688677e-01, 9.653832e-01, 9.620552e-01, 9.588522e-01, & ! + 9.557475e-01, 9.527265e-01, 9.497731e-01, 9.468756e-01, 9.440270e-01, & ! + 9.412230e-01, 9.384592e-01, 9.357287e-01, 9.330369e-01, 9.303778e-01, & ! + 9.277502e-01, 9.251546e-01, 9.225907e-01, 9.200553e-01, 9.175521e-01, & ! + 9.150773e-01, 9.126352e-01, 9.102260e-01, 9.078485e-01, 9.055057e-01, & ! + 9.031978e-01, 9.009306e-01, 8.987010e-01, 8.965177e-01, 8.943774e-01, & ! + 8.922869e-01, 8.902430e-01, 8.882551e-01, 8.863182e-01, 8.844373e-01, & ! + 8.826143e-01, 8.808499e-01, 8.791413e-01, 8.774940e-01, 8.759019e-01, & ! + 8.743650e-01, 8.728941e-01, 8.714712e-01, 8.701065e-01, 8.688008e-01, & ! + 8.675409e-01, 8.663295e-01, 8.651714e-01, 8.640637e-01, 8.629943e-01, & ! + 8.619762e-01, 8.609995e-01, 8.600581e-01, & ! + 9.910612e-01, 9.854226e-01, 9.795008e-01, 9.742920e-01, 9.695996e-01, & ! 4 + 9.652274e-01, 9.610648e-01, 9.570521e-01, 9.531397e-01, 9.493086e-01, & ! + 9.455413e-01, 9.418362e-01, 9.381902e-01, 9.346016e-01, 9.310718e-01, & ! + 9.275957e-01, 9.241757e-01, 9.208038e-01, 9.174802e-01, 9.142058e-01, & ! + 9.109753e-01, 9.077895e-01, 9.046433e-01, 9.015409e-01, 8.984784e-01, & ! + 8.954572e-01, 8.924748e-01, 8.895367e-01, 8.866395e-01, 8.837864e-01, & ! + 8.809819e-01, 8.782267e-01, 8.755231e-01, 8.728712e-01, 8.702802e-01, & ! + 8.677443e-01, 8.652733e-01, 8.628678e-01, 8.605300e-01, 8.582593e-01, & ! + 8.560596e-01, 8.539352e-01, 8.518782e-01, 8.498915e-01, 8.479790e-01, & ! + 8.461384e-01, 8.443645e-01, 8.426613e-01, 8.410229e-01, 8.394495e-01, & ! + 8.379428e-01, 8.364967e-01, 8.351117e-01, 8.337820e-01, 8.325091e-01, & ! + 8.312874e-01, 8.301169e-01, 8.289985e-01, & ! + 9.969802e-01, 9.950445e-01, 9.931448e-01, 9.914272e-01, 9.898652e-01, & ! 5 + 9.884250e-01, 9.870637e-01, 9.857482e-01, 9.844558e-01, 9.831755e-01, & ! + 9.819068e-01, 9.806477e-01, 9.794000e-01, 9.781666e-01, 9.769461e-01, & ! + 9.757386e-01, 9.745459e-01, 9.733650e-01, 9.721953e-01, 9.710398e-01, & ! + 9.698936e-01, 9.687583e-01, 9.676334e-01, 9.665192e-01, 9.654132e-01, & ! + 9.643208e-01, 9.632374e-01, 9.621625e-01, 9.611003e-01, 9.600518e-01, & ! + 9.590144e-01, 9.579922e-01, 9.569864e-01, 9.559948e-01, 9.550239e-01, & ! + 9.540698e-01, 9.531382e-01, 9.522280e-01, 9.513409e-01, 9.504772e-01, & ! + 9.496360e-01, 9.488220e-01, 9.480327e-01, 9.472693e-01, 9.465333e-01, & ! + 9.458211e-01, 9.451344e-01, 9.444732e-01, 9.438372e-01, 9.432268e-01, & ! + 9.426391e-01, 9.420757e-01, 9.415308e-01, 9.410102e-01, 9.405115e-01, & ! + 9.400326e-01, 9.395716e-01, 9.391313e-01, & ! + 9.980034e-01, 9.968572e-01, 9.958696e-01, 9.949747e-01, 9.941241e-01, & ! 6 + 9.933043e-01, 9.924971e-01, 9.916978e-01, 9.909023e-01, 9.901046e-01, & ! + 9.893087e-01, 9.885146e-01, 9.877195e-01, 9.869283e-01, 9.861379e-01, & ! + 9.853523e-01, 9.845715e-01, 9.837945e-01, 9.830217e-01, 9.822567e-01, & ! + 9.814935e-01, 9.807356e-01, 9.799815e-01, 9.792332e-01, 9.784845e-01, & ! + 9.777424e-01, 9.770042e-01, 9.762695e-01, 9.755416e-01, 9.748152e-01, & ! + 9.740974e-01, 9.733873e-01, 9.726813e-01, 9.719861e-01, 9.713010e-01, & ! + 9.706262e-01, 9.699647e-01, 9.693144e-01, 9.686794e-01, 9.680596e-01, & ! + 9.674540e-01, 9.668657e-01, 9.662926e-01, 9.657390e-01, 9.652019e-01, & ! + 9.646820e-01, 9.641784e-01, 9.636945e-01, 9.632260e-01, 9.627743e-01, & ! + 9.623418e-01, 9.619227e-01, 9.615194e-01, 9.611341e-01, 9.607629e-01, & ! + 9.604057e-01, 9.600622e-01, 9.597322e-01, & ! + 9.988219e-01, 9.981767e-01, 9.976168e-01, 9.971066e-01, 9.966195e-01, & ! 7 + 9.961566e-01, 9.956995e-01, 9.952481e-01, 9.947982e-01, 9.943495e-01, & ! + 9.938955e-01, 9.934368e-01, 9.929825e-01, 9.925239e-01, 9.920653e-01, & ! + 9.916096e-01, 9.911552e-01, 9.907067e-01, 9.902594e-01, 9.898178e-01, & ! + 9.893791e-01, 9.889453e-01, 9.885122e-01, 9.880837e-01, 9.876567e-01, & ! + 9.872331e-01, 9.868121e-01, 9.863938e-01, 9.859790e-01, 9.855650e-01, & ! + 9.851548e-01, 9.847491e-01, 9.843496e-01, 9.839521e-01, 9.835606e-01, & ! + 9.831771e-01, 9.827975e-01, 9.824292e-01, 9.820653e-01, 9.817124e-01, & ! + 9.813644e-01, 9.810291e-01, 9.807020e-01, 9.803864e-01, 9.800782e-01, & ! + 9.797821e-01, 9.794958e-01, 9.792179e-01, 9.789509e-01, 9.786940e-01, & ! + 9.784460e-01, 9.782090e-01, 9.779789e-01, 9.777553e-01, 9.775425e-01, & ! + 9.773387e-01, 9.771420e-01, 9.769529e-01, & ! + 9.998902e-01, 9.998395e-01, 9.997915e-01, 9.997442e-01, 9.997016e-01, & ! 8 + 9.996600e-01, 9.996200e-01, 9.995806e-01, 9.995411e-01, 9.995005e-01, & ! + 9.994589e-01, 9.994178e-01, 9.993766e-01, 9.993359e-01, 9.992948e-01, & ! + 9.992533e-01, 9.992120e-01, 9.991723e-01, 9.991313e-01, 9.990906e-01, & ! + 9.990510e-01, 9.990113e-01, 9.989716e-01, 9.989323e-01, 9.988923e-01, & ! + 9.988532e-01, 9.988140e-01, 9.987761e-01, 9.987373e-01, 9.986989e-01, & ! + 9.986597e-01, 9.986239e-01, 9.985861e-01, 9.985485e-01, 9.985123e-01, & ! + 9.984762e-01, 9.984415e-01, 9.984065e-01, 9.983722e-01, 9.983398e-01, & ! + 9.983078e-01, 9.982758e-01, 9.982461e-01, 9.982157e-01, 9.981872e-01, & ! + 9.981595e-01, 9.981324e-01, 9.981068e-01, 9.980811e-01, 9.980580e-01, & ! + 9.980344e-01, 9.980111e-01, 9.979908e-01, 9.979690e-01, 9.979492e-01, & ! + 9.979316e-01, 9.979116e-01, 9.978948e-01, & ! + 9.999978e-01, 9.999948e-01, 9.999915e-01, 9.999905e-01, 9.999896e-01, & ! 9 + 9.999887e-01, 9.999888e-01, 9.999888e-01, 9.999870e-01, 9.999854e-01, & ! + 9.999855e-01, 9.999856e-01, 9.999839e-01, 9.999834e-01, 9.999829e-01, & ! + 9.999809e-01, 9.999816e-01, 9.999793e-01, 9.999782e-01, 9.999779e-01, & ! + 9.999772e-01, 9.999764e-01, 9.999756e-01, 9.999744e-01, 9.999744e-01, & ! + 9.999736e-01, 9.999729e-01, 9.999716e-01, 9.999706e-01, 9.999692e-01, & ! + 9.999690e-01, 9.999675e-01, 9.999673e-01, 9.999660e-01, 9.999654e-01, & ! + 9.999647e-01, 9.999647e-01, 9.999625e-01, 9.999620e-01, 9.999614e-01, & ! + 9.999613e-01, 9.999607e-01, 9.999604e-01, 9.999594e-01, 9.999589e-01, & ! + 9.999586e-01, 9.999567e-01, 9.999550e-01, 9.999557e-01, 9.999542e-01, & ! + 9.999546e-01, 9.999539e-01, 9.999536e-01, 9.999526e-01, 9.999523e-01, & ! + 9.999508e-01, 9.999534e-01, 9.999507e-01, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! 10 + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 9.999995e-01, & ! + 9.999995e-01, 9.999990e-01, 9.999991e-01, 9.999991e-01, 9.999990e-01, & ! + 9.999989e-01, 9.999988e-01, 9.999988e-01, 9.999986e-01, 9.999988e-01, & ! + 9.999986e-01, 9.999987e-01, 9.999986e-01, 9.999985e-01, 9.999985e-01, & ! + 9.999985e-01, 9.999985e-01, 9.999983e-01, 9.999983e-01, 9.999981e-01, & ! + 9.999981e-01, 9.999986e-01, 9.999985e-01, 9.999983e-01, 9.999984e-01, & ! + 9.999982e-01, 9.999983e-01, 9.999982e-01, 9.999980e-01, 9.999981e-01, & ! + 9.999978e-01, 9.999979e-01, 9.999985e-01, 9.999985e-01, 9.999983e-01, & ! + 9.999983e-01, 9.999983e-01, 9.999983e-01, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! 11 + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 9.999991e-01, & ! + 9.999990e-01, 9.999992e-01, 9.999995e-01, 9.999986e-01, 9.999994e-01, & ! + 9.999985e-01, 9.999980e-01, 9.999984e-01, 9.999983e-01, 9.999979e-01, & ! + 9.999969e-01, 9.999977e-01, 9.999971e-01, 9.999969e-01, 9.999969e-01, & ! + 9.999965e-01, 9.999970e-01, 9.999985e-01, 9.999973e-01, 9.999961e-01, & ! + 9.999968e-01, 9.999952e-01, 9.999970e-01, 9.999974e-01, 9.999965e-01, & ! + 9.999969e-01, 9.999970e-01, 9.999970e-01, 9.999960e-01, 9.999923e-01, & ! + 9.999958e-01, 9.999937e-01, 9.999960e-01, 9.999953e-01, 9.999946e-01, & ! + 9.999946e-01, 9.999957e-01, 9.999951e-01, & ! + 1.000000e+00, 1.000000e+00, 9.999983e-01, 9.999979e-01, 9.999965e-01, & ! 12 + 9.999949e-01, 9.999948e-01, 9.999918e-01, 9.999917e-01, 9.999923e-01, & ! + 9.999908e-01, 9.999889e-01, 9.999902e-01, 9.999895e-01, 9.999881e-01, & ! + 9.999882e-01, 9.999876e-01, 9.999866e-01, 9.999866e-01, 9.999858e-01, & ! + 9.999860e-01, 9.999852e-01, 9.999836e-01, 9.999831e-01, 9.999818e-01, & ! + 9.999808e-01, 9.999816e-01, 9.999800e-01, 9.999783e-01, 9.999780e-01, & ! + 9.999763e-01, 9.999746e-01, 9.999731e-01, 9.999713e-01, 9.999762e-01, & ! + 9.999740e-01, 9.999670e-01, 9.999703e-01, 9.999687e-01, 9.999666e-01, & ! + 9.999683e-01, 9.999667e-01, 9.999611e-01, 9.999635e-01, 9.999600e-01, & ! + 9.999635e-01, 9.999594e-01, 9.999601e-01, 9.999586e-01, 9.999559e-01, & ! + 9.999569e-01, 9.999558e-01, 9.999523e-01, 9.999535e-01, 9.999529e-01, & ! + 9.999553e-01, 9.999495e-01, 9.999490e-01, & ! + 9.999920e-01, 9.999873e-01, 9.999855e-01, 9.999832e-01, 9.999807e-01, & ! 13 + 9.999778e-01, 9.999754e-01, 9.999721e-01, 9.999692e-01, 9.999651e-01, & ! + 9.999621e-01, 9.999607e-01, 9.999567e-01, 9.999546e-01, 9.999521e-01, & ! + 9.999491e-01, 9.999457e-01, 9.999439e-01, 9.999403e-01, 9.999374e-01, & ! + 9.999353e-01, 9.999315e-01, 9.999282e-01, 9.999244e-01, 9.999234e-01, & ! + 9.999189e-01, 9.999130e-01, 9.999117e-01, 9.999073e-01, 9.999020e-01, & ! + 9.998993e-01, 9.998987e-01, 9.998922e-01, 9.998893e-01, 9.998869e-01, & ! + 9.998805e-01, 9.998778e-01, 9.998751e-01, 9.998708e-01, 9.998676e-01, & ! + 9.998624e-01, 9.998642e-01, 9.998582e-01, 9.998547e-01, 9.998546e-01, & ! + 9.998477e-01, 9.998487e-01, 9.998466e-01, 9.998403e-01, 9.998412e-01, & ! + 9.998406e-01, 9.998342e-01, 9.998326e-01, 9.998333e-01, 9.998328e-01, & ! + 9.998290e-01, 9.998276e-01, 9.998249e-01, & ! + 8.383753e-01, 8.461471e-01, 8.373325e-01, 8.212889e-01, 8.023834e-01, & ! 14 + 7.829501e-01, 7.641777e-01, 7.466000e-01, 7.304023e-01, 7.155998e-01, & ! + 7.021259e-01, 6.898840e-01, 6.787615e-01, 6.686479e-01, 6.594414e-01, & ! + 6.510417e-01, 6.433668e-01, 6.363335e-01, 6.298788e-01, 6.239398e-01, & ! + 6.184633e-01, 6.134055e-01, 6.087228e-01, 6.043786e-01, 6.003439e-01, & ! + 5.965910e-01, 5.930917e-01, 5.898280e-01, 5.867798e-01, 5.839264e-01, & ! + 5.812576e-01, 5.787592e-01, 5.764163e-01, 5.742189e-01, 5.721598e-01, & ! + 5.702286e-01, 5.684182e-01, 5.667176e-01, 5.651237e-01, 5.636253e-01, & ! + 5.622228e-01, 5.609074e-01, 5.596713e-01, 5.585089e-01, 5.574223e-01, & ! + 5.564002e-01, 5.554411e-01, 5.545397e-01, 5.536914e-01, 5.528967e-01, & ! + 5.521495e-01, 5.514457e-01, 5.507818e-01, 5.501623e-01, 5.495750e-01, & ! + 5.490192e-01, 5.484980e-01, 5.480046e-01/), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + asyliq1 = reshape(source= (/ & ! + 8.133297e-01, 8.133528e-01, 8.173865e-01, 8.243205e-01, 8.333063e-01, & ! 1 + 8.436317e-01, 8.546611e-01, 8.657934e-01, 8.764345e-01, 8.859837e-01, & ! + 8.627394e-01, 8.824569e-01, 8.976887e-01, 9.089541e-01, 9.167699e-01, & ! + 9.216517e-01, 9.241147e-01, 9.246743e-01, 9.238469e-01, 9.221504e-01, & ! + 9.201045e-01, 9.182299e-01, 9.170491e-01, 9.170862e-01, 9.188653e-01, & ! + 9.229111e-01, 9.297468e-01, 9.398950e-01, 9.203269e-01, 9.260693e-01, & ! + 9.309373e-01, 9.349918e-01, 9.382935e-01, 9.409030e-01, 9.428809e-01, & ! + 9.442881e-01, 9.451851e-01, 9.456331e-01, 9.456926e-01, 9.454247e-01, & ! + 9.448902e-01, 9.441503e-01, 9.432661e-01, 9.422987e-01, 9.413094e-01, & ! + 9.403594e-01, 9.395102e-01, 9.388230e-01, 9.383594e-01, 9.381810e-01, & ! + 9.383489e-01, 9.389251e-01, 9.399707e-01, 9.415475e-01, 9.437167e-01, & ! + 9.465399e-01, 9.500786e-01, 9.5439e-01, & ! + 8.794448e-01, 8.819306e-01, 8.837667e-01, 8.853832e-01, 8.871010e-01, & ! 2 + 8.892675e-01, 8.922584e-01, 8.964666e-01, 9.022940e-01, 9.101456e-01, & ! + 8.839999e-01, 9.035610e-01, 9.184568e-01, 9.292315e-01, 9.364282e-01, & ! + 9.405887e-01, 9.422554e-01, 9.419703e-01, 9.402759e-01, 9.377159e-01, & ! + 9.348345e-01, 9.321769e-01, 9.302888e-01, 9.297166e-01, 9.310075e-01, & ! + 9.347080e-01, 9.413643e-01, 9.515216e-01, 9.306286e-01, 9.361781e-01, & ! + 9.408374e-01, 9.446692e-01, 9.477363e-01, 9.501013e-01, 9.518268e-01, & ! + 9.529756e-01, 9.536105e-01, 9.537938e-01, 9.535886e-01, 9.530574e-01, & ! + 9.522633e-01, 9.512688e-01, 9.501370e-01, 9.489306e-01, 9.477126e-01, & ! + 9.465459e-01, 9.454934e-01, 9.446183e-01, 9.439833e-01, 9.436519e-01, & ! + 9.436866e-01, 9.441508e-01, 9.451073e-01, 9.466195e-01, 9.487501e-01, & ! + 9.515621e-01, 9.551185e-01, 9.5948e-01, & ! + 8.478817e-01, 8.269312e-01, 8.161352e-01, 8.135960e-01, 8.173586e-01, & ! 3 + 8.254167e-01, 8.357072e-01, 8.461167e-01, 8.544952e-01, 8.586776e-01, & ! + 8.335562e-01, 8.524273e-01, 8.669052e-01, 8.775014e-01, 8.847277e-01, & ! + 8.890958e-01, 8.911173e-01, 8.913038e-01, 8.901669e-01, 8.882182e-01, & ! + 8.859692e-01, 8.839315e-01, 8.826164e-01, 8.825356e-01, 8.842004e-01, & ! + 8.881223e-01, 8.948131e-01, 9.047837e-01, 8.855951e-01, 8.911796e-01, & ! + 8.959229e-01, 8.998837e-01, 9.031209e-01, 9.056939e-01, 9.076609e-01, & ! + 9.090812e-01, 9.100134e-01, 9.105167e-01, 9.106496e-01, 9.104712e-01, & ! + 9.100404e-01, 9.094159e-01, 9.086568e-01, 9.078218e-01, 9.069697e-01, & ! + 9.061595e-01, 9.054499e-01, 9.048999e-01, 9.045683e-01, 9.045142e-01, & ! + 9.047962e-01, 9.054730e-01, 9.066037e-01, 9.082472e-01, 9.104623e-01, & ! + 9.133079e-01, 9.168427e-01, 9.2113e-01, & ! + 8.216697e-01, 7.982871e-01, 7.891147e-01, 7.909083e-01, 8.003833e-01, & ! 4 + 8.142516e-01, 8.292290e-01, 8.420356e-01, 8.493945e-01, 8.480316e-01, & ! + 8.212381e-01, 8.394984e-01, 8.534095e-01, 8.634813e-01, 8.702242e-01, & ! + 8.741483e-01, 8.757638e-01, 8.755808e-01, 8.741095e-01, 8.718604e-01, & ! + 8.693433e-01, 8.670686e-01, 8.655464e-01, 8.652872e-01, 8.668006e-01, & ! + 8.705973e-01, 8.771874e-01, 8.870809e-01, 8.678284e-01, 8.732315e-01, & ! + 8.778084e-01, 8.816166e-01, 8.847146e-01, 8.871603e-01, 8.890116e-01, & ! + 8.903266e-01, 8.911632e-01, 8.915796e-01, 8.916337e-01, 8.913834e-01, & ! + 8.908869e-01, 8.902022e-01, 8.893873e-01, 8.885001e-01, 8.875986e-01, & ! + 8.867411e-01, 8.859852e-01, 8.853891e-01, 8.850111e-01, 8.849089e-01, & ! + 8.851405e-01, 8.857639e-01, 8.868372e-01, 8.884185e-01, 8.905656e-01, & ! + 8.933368e-01, 8.967899e-01, 9.0098e-01, & ! + 8.063610e-01, 7.938147e-01, 7.921304e-01, 7.985092e-01, 8.101339e-01, & ! 5 + 8.242175e-01, 8.379913e-01, 8.486920e-01, 8.535547e-01, 8.498083e-01, & ! + 8.224849e-01, 8.405509e-01, 8.542436e-01, 8.640770e-01, 8.705653e-01, & ! + 8.742227e-01, 8.755630e-01, 8.751004e-01, 8.733491e-01, 8.708231e-01, & ! + 8.680365e-01, 8.655035e-01, 8.637381e-01, 8.632544e-01, 8.645665e-01, & ! + 8.681885e-01, 8.746346e-01, 8.844188e-01, 8.648180e-01, 8.700563e-01, & ! + 8.744672e-01, 8.781087e-01, 8.810393e-01, 8.833174e-01, 8.850011e-01, & ! + 8.861485e-01, 8.868183e-01, 8.870687e-01, 8.869579e-01, 8.865441e-01, & ! + 8.858857e-01, 8.850412e-01, 8.840686e-01, 8.830263e-01, 8.819726e-01, & ! + 8.809658e-01, 8.800642e-01, 8.793260e-01, 8.788099e-01, 8.785737e-01, & ! + 8.786758e-01, 8.791746e-01, 8.801283e-01, 8.815955e-01, 8.836340e-01, & ! + 8.863024e-01, 8.896592e-01, 8.9376e-01, & ! + 7.885899e-01, 7.937172e-01, 8.020658e-01, 8.123971e-01, 8.235502e-01, & ! 6 + 8.343776e-01, 8.437336e-01, 8.504711e-01, 8.534421e-01, 8.514978e-01, & ! + 8.238888e-01, 8.417463e-01, 8.552057e-01, 8.647853e-01, 8.710038e-01, & ! + 8.743798e-01, 8.754319e-01, 8.746786e-01, 8.726386e-01, 8.698303e-01, & ! + 8.667724e-01, 8.639836e-01, 8.619823e-01, 8.612870e-01, 8.624165e-01, & ! + 8.658893e-01, 8.722241e-01, 8.819394e-01, 8.620216e-01, 8.671239e-01, & ! + 8.713983e-01, 8.749032e-01, 8.776970e-01, 8.798385e-01, 8.813860e-01, & ! + 8.823980e-01, 8.829332e-01, 8.830500e-01, 8.828068e-01, 8.822623e-01, & ! + 8.814750e-01, 8.805031e-01, 8.794056e-01, 8.782407e-01, 8.770672e-01, & ! + 8.759432e-01, 8.749275e-01, 8.740784e-01, 8.734547e-01, 8.731146e-01, & ! + 8.731170e-01, 8.735199e-01, 8.743823e-01, 8.757625e-01, 8.777191e-01, & ! + 8.803105e-01, 8.835953e-01, 8.8763e-01, & ! + 7.811516e-01, 7.962229e-01, 8.096199e-01, 8.212996e-01, 8.312212e-01, & ! 7 + 8.393430e-01, 8.456236e-01, 8.500214e-01, 8.524950e-01, 8.530031e-01, & ! + 8.251485e-01, 8.429043e-01, 8.562461e-01, 8.656954e-01, 8.717737e-01, & ! + 8.750020e-01, 8.759022e-01, 8.749953e-01, 8.728027e-01, 8.698461e-01, & ! + 8.666466e-01, 8.637257e-01, 8.616047e-01, 8.608051e-01, 8.618483e-01, & ! + 8.652557e-01, 8.715487e-01, 8.812485e-01, 8.611645e-01, 8.662052e-01, & ! + 8.704173e-01, 8.738594e-01, 8.765901e-01, 8.786678e-01, 8.801517e-01, & ! + 8.810999e-01, 8.815713e-01, 8.816246e-01, 8.813185e-01, 8.807114e-01, & ! + 8.798621e-01, 8.788290e-01, 8.776713e-01, 8.764470e-01, 8.752152e-01, & ! + 8.740343e-01, 8.729631e-01, 8.720602e-01, 8.713842e-01, 8.709936e-01, & ! + 8.709475e-01, 8.713041e-01, 8.721221e-01, 8.734602e-01, 8.753774e-01, & ! + 8.779319e-01, 8.811825e-01, 8.8519e-01, & ! + 7.865744e-01, 8.093340e-01, 8.257596e-01, 8.369940e-01, 8.441574e-01, & ! 8 + 8.483602e-01, 8.507096e-01, 8.523139e-01, 8.542834e-01, 8.577321e-01, & ! + 8.288960e-01, 8.465308e-01, 8.597175e-01, 8.689830e-01, 8.748542e-01, & ! + 8.778584e-01, 8.785222e-01, 8.773728e-01, 8.749370e-01, 8.717419e-01, & ! + 8.683145e-01, 8.651816e-01, 8.628704e-01, 8.619077e-01, 8.628205e-01, & ! + 8.661356e-01, 8.723803e-01, 8.820815e-01, 8.616715e-01, 8.666389e-01, & ! + 8.707753e-01, 8.741398e-01, 8.767912e-01, 8.787885e-01, 8.801908e-01, & ! + 8.810570e-01, 8.814460e-01, 8.814167e-01, 8.810283e-01, 8.803395e-01, & ! + 8.794095e-01, 8.782971e-01, 8.770613e-01, 8.757610e-01, 8.744553e-01, & ! + 8.732031e-01, 8.720634e-01, 8.710951e-01, 8.703572e-01, 8.699086e-01, & ! + 8.698084e-01, 8.701155e-01, 8.708887e-01, 8.721872e-01, 8.740698e-01, & ! + 8.765957e-01, 8.798235e-01, 8.8381e-01, & ! + 8.069513e-01, 8.262939e-01, 8.398241e-01, 8.486352e-01, 8.538213e-01, & ! 9 + 8.564743e-01, 8.576854e-01, 8.585455e-01, 8.601452e-01, 8.635755e-01, & ! + 8.337383e-01, 8.512655e-01, 8.643049e-01, 8.733896e-01, 8.790535e-01, & ! + 8.818295e-01, 8.822518e-01, 8.808533e-01, 8.781676e-01, 8.747284e-01, & ! + 8.710690e-01, 8.677229e-01, 8.652236e-01, 8.641047e-01, 8.648993e-01, & ! + 8.681413e-01, 8.743640e-01, 8.841007e-01, 8.633558e-01, 8.682719e-01, & ! + 8.723543e-01, 8.756621e-01, 8.782547e-01, 8.801915e-01, 8.815318e-01, & ! + 8.823347e-01, 8.826598e-01, 8.825663e-01, 8.821135e-01, 8.813608e-01, & ! + 8.803674e-01, 8.791928e-01, 8.778960e-01, 8.765366e-01, 8.751738e-01, & ! + 8.738670e-01, 8.726755e-01, 8.716585e-01, 8.708755e-01, 8.703856e-01, & ! + 8.702483e-01, 8.705229e-01, 8.712687e-01, 8.725448e-01, 8.744109e-01, & ! + 8.769260e-01, 8.801496e-01, 8.8414e-01, & ! + 8.252182e-01, 8.379244e-01, 8.471709e-01, 8.535760e-01, 8.577540e-01, & ! 10 + 8.603183e-01, 8.618820e-01, 8.630578e-01, 8.644587e-01, 8.666970e-01, & ! + 8.362159e-01, 8.536817e-01, 8.666387e-01, 8.756240e-01, 8.811746e-01, & ! + 8.838273e-01, 8.841191e-01, 8.825871e-01, 8.797681e-01, 8.761992e-01, & ! + 8.724174e-01, 8.689593e-01, 8.663623e-01, 8.651632e-01, 8.658988e-01, & ! + 8.691064e-01, 8.753226e-01, 8.850847e-01, 8.641620e-01, 8.690500e-01, & ! + 8.731026e-01, 8.763795e-01, 8.789400e-01, 8.808438e-01, 8.821503e-01, & ! + 8.829191e-01, 8.832095e-01, 8.830813e-01, 8.825938e-01, 8.818064e-01, & ! + 8.807787e-01, 8.795704e-01, 8.782408e-01, 8.768493e-01, 8.754557e-01, & ! + 8.741193e-01, 8.728995e-01, 8.718561e-01, 8.710484e-01, 8.705360e-01, & ! + 8.703782e-01, 8.706347e-01, 8.713650e-01, 8.726285e-01, 8.744849e-01, & ! + 8.769933e-01, 8.802136e-01, 8.8421e-01, & ! + 8.370583e-01, 8.467920e-01, 8.537769e-01, 8.585136e-01, 8.615034e-01, & ! 11 + 8.632474e-01, 8.642468e-01, 8.650026e-01, 8.660161e-01, 8.677882e-01, & ! + 8.369760e-01, 8.543821e-01, 8.672699e-01, 8.761782e-01, 8.816454e-01, & ! + 8.842103e-01, 8.844114e-01, 8.827872e-01, 8.798766e-01, 8.762179e-01, & ! + 8.723500e-01, 8.688112e-01, 8.661403e-01, 8.648758e-01, 8.655563e-01, & ! + 8.687206e-01, 8.749072e-01, 8.846546e-01, 8.636289e-01, 8.684849e-01, & ! + 8.725054e-01, 8.757501e-01, 8.782785e-01, 8.801503e-01, 8.814249e-01, & ! + 8.821620e-01, 8.824211e-01, 8.822620e-01, 8.817440e-01, 8.809268e-01, & ! + 8.798699e-01, 8.786330e-01, 8.772756e-01, 8.758572e-01, 8.744374e-01, & ! + 8.730760e-01, 8.718323e-01, 8.707660e-01, 8.699366e-01, 8.694039e-01, & ! + 8.692271e-01, 8.694661e-01, 8.701803e-01, 8.714293e-01, 8.732727e-01, & ! + 8.757702e-01, 8.789811e-01, 8.8297e-01, & ! + 8.430819e-01, 8.510060e-01, 8.567270e-01, 8.606533e-01, 8.631934e-01, & ! 12 + 8.647554e-01, 8.657471e-01, 8.665760e-01, 8.676496e-01, 8.693754e-01, & ! + 8.384298e-01, 8.557913e-01, 8.686214e-01, 8.774605e-01, 8.828495e-01, & ! + 8.853287e-01, 8.854393e-01, 8.837215e-01, 8.807161e-01, 8.769639e-01, & ! + 8.730053e-01, 8.693812e-01, 8.666321e-01, 8.652988e-01, 8.659219e-01, & ! + 8.690419e-01, 8.751999e-01, 8.849360e-01, 8.638013e-01, 8.686371e-01, & ! + 8.726369e-01, 8.758605e-01, 8.783674e-01, 8.802176e-01, 8.814705e-01, & ! + 8.821859e-01, 8.824234e-01, 8.822429e-01, 8.817038e-01, 8.808658e-01, & ! + 8.797887e-01, 8.785323e-01, 8.771560e-01, 8.757196e-01, 8.742828e-01, & ! + 8.729052e-01, 8.716467e-01, 8.705666e-01, 8.697250e-01, 8.691812e-01, & ! + 8.689950e-01, 8.692264e-01, 8.699346e-01, 8.711795e-01, 8.730209e-01, & ! + 8.755181e-01, 8.787312e-01, 8.8272e-01, & ! + 8.452284e-01, 8.522700e-01, 8.572973e-01, 8.607031e-01, 8.628802e-01, & ! 13 + 8.642215e-01, 8.651198e-01, 8.659679e-01, 8.671588e-01, 8.690853e-01, & ! + 8.383803e-01, 8.557485e-01, 8.685851e-01, 8.774303e-01, 8.828245e-01, & ! + 8.853077e-01, 8.854207e-01, 8.837034e-01, 8.806962e-01, 8.769398e-01, & ! + 8.729740e-01, 8.693393e-01, 8.665761e-01, 8.652247e-01, 8.658253e-01, & ! + 8.689182e-01, 8.750438e-01, 8.847424e-01, 8.636140e-01, 8.684449e-01, & ! + 8.724400e-01, 8.756589e-01, 8.781613e-01, 8.800072e-01, 8.812559e-01, & ! + 8.819671e-01, 8.822007e-01, 8.820165e-01, 8.814737e-01, 8.806322e-01, & ! + 8.795518e-01, 8.782923e-01, 8.769129e-01, 8.754737e-01, 8.740342e-01, & ! + 8.726542e-01, 8.713934e-01, 8.703111e-01, 8.694677e-01, 8.689222e-01, & ! + 8.687344e-01, 8.689646e-01, 8.696715e-01, 8.709156e-01, 8.727563e-01, & ! + 8.752531e-01, 8.784659e-01, 8.8245e-01, & ! + 7.800869e-01, 8.091120e-01, 8.325369e-01, 8.466266e-01, 8.515495e-01, & ! 14 + 8.499371e-01, 8.456203e-01, 8.430521e-01, 8.470286e-01, 8.625431e-01, & ! + 8.402261e-01, 8.610822e-01, 8.776608e-01, 8.904485e-01, 8.999294e-01, & ! + 9.065860e-01, 9.108995e-01, 9.133503e-01, 9.144187e-01, 9.145855e-01, & ! + 9.143320e-01, 9.141402e-01, 9.144933e-01, 9.158754e-01, 9.187716e-01, & ! + 9.236677e-01, 9.310503e-01, 9.414058e-01, 9.239108e-01, 9.300719e-01, & ! + 9.353612e-01, 9.398378e-01, 9.435609e-01, 9.465895e-01, 9.489829e-01, & ! + 9.508000e-01, 9.521002e-01, 9.529424e-01, 9.533860e-01, 9.534902e-01, & ! + 9.533143e-01, 9.529177e-01, 9.523596e-01, 9.516997e-01, 9.509973e-01, & ! + 9.503121e-01, 9.497037e-01, 9.492317e-01, 9.489558e-01, 9.489356e-01, & ! + 9.492311e-01, 9.499019e-01, 9.510077e-01, 9.526084e-01, 9.547636e-01, & ! + 9.575331e-01, 9.609766e-01, 9.6515e-01 /), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + asyliq2 = reshape(source= (/ & ! + 8.038165e-01, 8.014154e-01, 7.942381e-01, 7.970521e-01, 8.086621e-01, & ! 1 + 8.233392e-01, 8.374127e-01, 8.495742e-01, 8.596945e-01, 8.680497e-01, & ! + 8.750005e-01, 8.808589e-01, 8.858749e-01, 8.902403e-01, 8.940939e-01, & ! + 8.975379e-01, 9.006450e-01, 9.034741e-01, 9.060659e-01, 9.084561e-01, & ! + 9.106675e-01, 9.127198e-01, 9.146332e-01, 9.164194e-01, 9.180970e-01, & ! + 9.196658e-01, 9.211421e-01, 9.225352e-01, 9.238443e-01, 9.250841e-01, & ! + 9.262541e-01, 9.273620e-01, 9.284081e-01, 9.294002e-01, 9.303395e-01, & ! + 9.312285e-01, 9.320715e-01, 9.328716e-01, 9.336271e-01, 9.343427e-01, & ! + 9.350219e-01, 9.356647e-01, 9.362728e-01, 9.368495e-01, 9.373956e-01, & ! + 9.379113e-01, 9.383987e-01, 9.388608e-01, 9.392986e-01, 9.397132e-01, & ! + 9.401063e-01, 9.404776e-01, 9.408299e-01, 9.411641e-01, 9.414800e-01, & ! + 9.417787e-01, 9.420633e-01, 9.423364e-01, & ! + 8.941000e-01, 9.054049e-01, 9.049510e-01, 9.027216e-01, 9.021636e-01, & ! 2 + 9.037878e-01, 9.069852e-01, 9.109817e-01, 9.152013e-01, 9.193040e-01, & ! + 9.231177e-01, 9.265712e-01, 9.296606e-01, 9.324048e-01, 9.348419e-01, & ! + 9.370131e-01, 9.389529e-01, 9.406954e-01, 9.422727e-01, 9.437088e-01, & ! + 9.450221e-01, 9.462308e-01, 9.473488e-01, 9.483830e-01, 9.493492e-01, & ! + 9.502541e-01, 9.510999e-01, 9.518971e-01, 9.526455e-01, 9.533554e-01, & ! + 9.540249e-01, 9.546571e-01, 9.552551e-01, 9.558258e-01, 9.563603e-01, & ! + 9.568713e-01, 9.573569e-01, 9.578141e-01, 9.582485e-01, 9.586604e-01, & ! + 9.590525e-01, 9.594218e-01, 9.597710e-01, 9.601052e-01, 9.604181e-01, & ! + 9.607159e-01, 9.609979e-01, 9.612655e-01, 9.615184e-01, 9.617564e-01, & ! + 9.619860e-01, 9.622009e-01, 9.624031e-01, 9.625957e-01, 9.627792e-01, & ! + 9.629530e-01, 9.631171e-01, 9.632746e-01, & ! + 8.574638e-01, 8.351383e-01, 8.142977e-01, 8.083068e-01, 8.129284e-01, & ! 3 + 8.215827e-01, 8.307238e-01, 8.389963e-01, 8.460481e-01, 8.519273e-01, & ! + 8.568153e-01, 8.609116e-01, 8.643892e-01, 8.673941e-01, 8.700248e-01, & ! + 8.723707e-01, 8.744902e-01, 8.764240e-01, 8.782057e-01, 8.798593e-01, & ! + 8.814063e-01, 8.828573e-01, 8.842261e-01, 8.855196e-01, 8.867497e-01, & ! + 8.879164e-01, 8.890316e-01, 8.900941e-01, 8.911118e-01, 8.920832e-01, & ! + 8.930156e-01, 8.939091e-01, 8.947663e-01, 8.955888e-01, 8.963786e-01, & ! + 8.971350e-01, 8.978617e-01, 8.985590e-01, 8.992243e-01, 8.998631e-01, & ! + 9.004753e-01, 9.010602e-01, 9.016192e-01, 9.021542e-01, 9.026644e-01, & ! + 9.031535e-01, 9.036194e-01, 9.040656e-01, 9.044894e-01, 9.048933e-01, & ! + 9.052789e-01, 9.056481e-01, 9.060004e-01, 9.063343e-01, 9.066544e-01, & ! + 9.069604e-01, 9.072512e-01, 9.075290e-01, & ! + 8.349569e-01, 8.034579e-01, 7.932136e-01, 8.010156e-01, 8.137083e-01, & ! 4 + 8.255339e-01, 8.351938e-01, 8.428286e-01, 8.488944e-01, 8.538187e-01, & ! + 8.579255e-01, 8.614473e-01, 8.645338e-01, 8.672908e-01, 8.697947e-01, & ! + 8.720843e-01, 8.742015e-01, 8.761718e-01, 8.780160e-01, 8.797479e-01, & ! + 8.813810e-01, 8.829250e-01, 8.843907e-01, 8.857822e-01, 8.871059e-01, & ! + 8.883724e-01, 8.895810e-01, 8.907384e-01, 8.918456e-01, 8.929083e-01, & ! + 8.939284e-01, 8.949060e-01, 8.958463e-01, 8.967486e-01, 8.976129e-01, & ! + 8.984463e-01, 8.992439e-01, 9.000094e-01, 9.007438e-01, 9.014496e-01, & ! + 9.021235e-01, 9.027699e-01, 9.033859e-01, 9.039772e-01, 9.045419e-01, & ! + 9.050819e-01, 9.055975e-01, 9.060907e-01, 9.065607e-01, 9.070093e-01, & ! + 9.074389e-01, 9.078475e-01, 9.082388e-01, 9.086117e-01, 9.089678e-01, & ! + 9.093081e-01, 9.096307e-01, 9.099410e-01, & ! + 8.109692e-01, 7.846657e-01, 7.881928e-01, 8.009509e-01, 8.131208e-01, & ! 5 + 8.230400e-01, 8.309448e-01, 8.372920e-01, 8.424837e-01, 8.468166e-01, & ! + 8.504947e-01, 8.536642e-01, 8.564256e-01, 8.588513e-01, 8.610011e-01, & ! + 8.629122e-01, 8.646262e-01, 8.661720e-01, 8.675752e-01, 8.688582e-01, & ! + 8.700379e-01, 8.711300e-01, 8.721485e-01, 8.731027e-01, 8.740010e-01, & ! + 8.748499e-01, 8.756564e-01, 8.764239e-01, 8.771542e-01, 8.778523e-01, & ! + 8.785211e-01, 8.791601e-01, 8.797725e-01, 8.803589e-01, 8.809173e-01, & ! + 8.814552e-01, 8.819705e-01, 8.824611e-01, 8.829311e-01, 8.833791e-01, & ! + 8.838078e-01, 8.842148e-01, 8.846044e-01, 8.849756e-01, 8.853291e-01, & ! + 8.856645e-01, 8.859841e-01, 8.862904e-01, 8.865801e-01, 8.868551e-01, & ! + 8.871182e-01, 8.873673e-01, 8.876059e-01, 8.878307e-01, 8.880462e-01, & ! + 8.882501e-01, 8.884453e-01, 8.886339e-01, & ! + 7.838510e-01, 7.803151e-01, 7.980477e-01, 8.144160e-01, 8.261784e-01, & ! 6 + 8.344240e-01, 8.404278e-01, 8.450391e-01, 8.487593e-01, 8.518741e-01, & ! + 8.545484e-01, 8.568890e-01, 8.589560e-01, 8.607983e-01, 8.624504e-01, & ! + 8.639408e-01, 8.652945e-01, 8.665301e-01, 8.676634e-01, 8.687121e-01, & ! + 8.696855e-01, 8.705933e-01, 8.714448e-01, 8.722454e-01, 8.730014e-01, & ! + 8.737180e-01, 8.743982e-01, 8.750436e-01, 8.756598e-01, 8.762481e-01, & ! + 8.768089e-01, 8.773427e-01, 8.778532e-01, 8.783434e-01, 8.788089e-01, & ! + 8.792530e-01, 8.796784e-01, 8.800845e-01, 8.804716e-01, 8.808411e-01, & ! + 8.811923e-01, 8.815276e-01, 8.818472e-01, 8.821504e-01, 8.824408e-01, & ! + 8.827155e-01, 8.829777e-01, 8.832269e-01, 8.834631e-01, 8.836892e-01, & ! + 8.839034e-01, 8.841075e-01, 8.843021e-01, 8.844866e-01, 8.846631e-01, & ! + 8.848304e-01, 8.849910e-01, 8.851425e-01, & ! + 7.760783e-01, 7.890215e-01, 8.090192e-01, 8.230252e-01, 8.321369e-01, & ! 7 + 8.384258e-01, 8.431529e-01, 8.469558e-01, 8.501499e-01, 8.528899e-01, & ! + 8.552899e-01, 8.573956e-01, 8.592570e-01, 8.609098e-01, 8.623897e-01, & ! + 8.637169e-01, 8.649184e-01, 8.660097e-01, 8.670096e-01, 8.679338e-01, & ! + 8.687896e-01, 8.695880e-01, 8.703365e-01, 8.710422e-01, 8.717092e-01, & ! + 8.723378e-01, 8.729363e-01, 8.735063e-01, 8.740475e-01, 8.745661e-01, & ! + 8.750560e-01, 8.755275e-01, 8.759731e-01, 8.764000e-01, 8.768071e-01, & ! + 8.771942e-01, 8.775628e-01, 8.779126e-01, 8.782483e-01, 8.785626e-01, & ! + 8.788610e-01, 8.791482e-01, 8.794180e-01, 8.796765e-01, 8.799207e-01, & ! + 8.801522e-01, 8.803707e-01, 8.805777e-01, 8.807749e-01, 8.809605e-01, & ! + 8.811362e-01, 8.813047e-01, 8.814647e-01, 8.816131e-01, 8.817588e-01, & ! + 8.818930e-01, 8.820230e-01, 8.821445e-01, & ! + 7.847907e-01, 8.099917e-01, 8.257428e-01, 8.350423e-01, 8.411971e-01, & ! 8 + 8.457241e-01, 8.493010e-01, 8.522565e-01, 8.547660e-01, 8.569311e-01, & ! + 8.588181e-01, 8.604729e-01, 8.619296e-01, 8.632208e-01, 8.643725e-01, & ! + 8.654050e-01, 8.663363e-01, 8.671835e-01, 8.679590e-01, 8.686707e-01, & ! + 8.693308e-01, 8.699433e-01, 8.705147e-01, 8.710490e-01, 8.715497e-01, & ! + 8.720219e-01, 8.724669e-01, 8.728849e-01, 8.732806e-01, 8.736550e-01, & ! + 8.740099e-01, 8.743435e-01, 8.746601e-01, 8.749610e-01, 8.752449e-01, & ! + 8.755143e-01, 8.757688e-01, 8.760095e-01, 8.762375e-01, 8.764532e-01, & ! + 8.766579e-01, 8.768506e-01, 8.770323e-01, 8.772049e-01, 8.773690e-01, & ! + 8.775226e-01, 8.776679e-01, 8.778062e-01, 8.779360e-01, 8.780587e-01, & ! + 8.781747e-01, 8.782852e-01, 8.783892e-01, 8.784891e-01, 8.785824e-01, & ! + 8.786705e-01, 8.787546e-01, 8.788336e-01, & ! + 8.054324e-01, 8.266282e-01, 8.378075e-01, 8.449848e-01, 8.502166e-01, & ! 9 + 8.542268e-01, 8.573477e-01, 8.598022e-01, 8.617689e-01, 8.633859e-01, & ! + 8.647536e-01, 8.659354e-01, 8.669807e-01, 8.679143e-01, 8.687577e-01, & ! + 8.695222e-01, 8.702207e-01, 8.708591e-01, 8.714446e-01, 8.719836e-01, & ! + 8.724812e-01, 8.729426e-01, 8.733689e-01, 8.737665e-01, 8.741373e-01, & ! + 8.744834e-01, 8.748070e-01, 8.751131e-01, 8.754011e-01, 8.756676e-01, & ! + 8.759219e-01, 8.761599e-01, 8.763857e-01, 8.765984e-01, 8.767999e-01, & ! + 8.769889e-01, 8.771669e-01, 8.773373e-01, 8.774969e-01, 8.776469e-01, & ! + 8.777894e-01, 8.779237e-01, 8.780505e-01, 8.781703e-01, 8.782820e-01, & ! + 8.783886e-01, 8.784894e-01, 8.785844e-01, 8.786736e-01, 8.787584e-01, & ! + 8.788379e-01, 8.789130e-01, 8.789849e-01, 8.790506e-01, 8.791141e-01, & ! + 8.791750e-01, 8.792324e-01, 8.792867e-01, & ! + 8.249534e-01, 8.391988e-01, 8.474107e-01, 8.526860e-01, 8.563983e-01, & ! 10 + 8.592389e-01, 8.615144e-01, 8.633790e-01, 8.649325e-01, 8.662504e-01, & ! + 8.673841e-01, 8.683741e-01, 8.692495e-01, 8.700309e-01, 8.707328e-01, & ! + 8.713650e-01, 8.719432e-01, 8.724676e-01, 8.729498e-01, 8.733922e-01, & ! + 8.737981e-01, 8.741745e-01, 8.745225e-01, 8.748467e-01, 8.751512e-01, & ! + 8.754315e-01, 8.756962e-01, 8.759450e-01, 8.761774e-01, 8.763945e-01, & ! + 8.766021e-01, 8.767970e-01, 8.769803e-01, 8.771511e-01, 8.773151e-01, & ! + 8.774689e-01, 8.776147e-01, 8.777533e-01, 8.778831e-01, 8.780050e-01, & ! + 8.781197e-01, 8.782301e-01, 8.783323e-01, 8.784312e-01, 8.785222e-01, & ! + 8.786096e-01, 8.786916e-01, 8.787688e-01, 8.788411e-01, 8.789122e-01, & ! + 8.789762e-01, 8.790373e-01, 8.790954e-01, 8.791514e-01, 8.792018e-01, & ! + 8.792517e-01, 8.792990e-01, 8.793429e-01, & ! + 8.323091e-01, 8.429776e-01, 8.498123e-01, 8.546929e-01, 8.584295e-01, & ! 11 + 8.613489e-01, 8.636324e-01, 8.654303e-01, 8.668675e-01, 8.680404e-01, & ! + 8.690174e-01, 8.698495e-01, 8.705666e-01, 8.711961e-01, 8.717556e-01, & ! + 8.722546e-01, 8.727063e-01, 8.731170e-01, 8.734933e-01, 8.738382e-01, & ! + 8.741590e-01, 8.744525e-01, 8.747295e-01, 8.749843e-01, 8.752210e-01, & ! + 8.754437e-01, 8.756524e-01, 8.758472e-01, 8.760288e-01, 8.762030e-01, & ! + 8.763603e-01, 8.765122e-01, 8.766539e-01, 8.767894e-01, 8.769130e-01, & ! + 8.770310e-01, 8.771422e-01, 8.772437e-01, 8.773419e-01, 8.774355e-01, & ! + 8.775221e-01, 8.776047e-01, 8.776802e-01, 8.777539e-01, 8.778216e-01, & ! + 8.778859e-01, 8.779473e-01, 8.780031e-01, 8.780562e-01, 8.781097e-01, & ! + 8.781570e-01, 8.782021e-01, 8.782463e-01, 8.782845e-01, 8.783235e-01, & ! + 8.783610e-01, 8.783953e-01, 8.784273e-01, & ! + 8.396448e-01, 8.480172e-01, 8.535934e-01, 8.574145e-01, 8.600835e-01, & ! 12 + 8.620347e-01, 8.635500e-01, 8.648003e-01, 8.658758e-01, 8.668248e-01, & ! + 8.676697e-01, 8.684220e-01, 8.690893e-01, 8.696807e-01, 8.702046e-01, & ! + 8.706676e-01, 8.710798e-01, 8.714478e-01, 8.717778e-01, 8.720747e-01, & ! + 8.723431e-01, 8.725889e-01, 8.728144e-01, 8.730201e-01, 8.732129e-01, & ! + 8.733907e-01, 8.735541e-01, 8.737100e-01, 8.738533e-01, 8.739882e-01, & ! + 8.741164e-01, 8.742362e-01, 8.743485e-01, 8.744530e-01, 8.745512e-01, & ! + 8.746471e-01, 8.747373e-01, 8.748186e-01, 8.748973e-01, 8.749732e-01, & ! + 8.750443e-01, 8.751105e-01, 8.751747e-01, 8.752344e-01, 8.752902e-01, & ! + 8.753412e-01, 8.753917e-01, 8.754393e-01, 8.754843e-01, 8.755282e-01, & ! + 8.755662e-01, 8.756039e-01, 8.756408e-01, 8.756722e-01, 8.757072e-01, & ! + 8.757352e-01, 8.757653e-01, 8.757932e-01, & ! + 8.374590e-01, 8.465669e-01, 8.518701e-01, 8.547627e-01, 8.565745e-01, & ! 13 + 8.579065e-01, 8.589717e-01, 8.598632e-01, 8.606363e-01, 8.613268e-01, & ! + 8.619560e-01, 8.625340e-01, 8.630689e-01, 8.635601e-01, 8.640084e-01, & ! + 8.644180e-01, 8.647885e-01, 8.651220e-01, 8.654218e-01, 8.656908e-01, & ! + 8.659294e-01, 8.661422e-01, 8.663334e-01, 8.665037e-01, 8.666543e-01, & ! + 8.667913e-01, 8.669156e-01, 8.670242e-01, 8.671249e-01, 8.672161e-01, & ! + 8.672993e-01, 8.673733e-01, 8.674457e-01, 8.675103e-01, 8.675713e-01, & ! + 8.676267e-01, 8.676798e-01, 8.677286e-01, 8.677745e-01, 8.678178e-01, & ! + 8.678601e-01, 8.678986e-01, 8.679351e-01, 8.679693e-01, 8.680013e-01, & ! + 8.680334e-01, 8.680624e-01, 8.680915e-01, 8.681178e-01, 8.681428e-01, & ! + 8.681654e-01, 8.681899e-01, 8.682103e-01, 8.682317e-01, 8.682498e-01, & ! + 8.682677e-01, 8.682861e-01, 8.683041e-01, & ! + 7.877069e-01, 8.244281e-01, 8.367971e-01, 8.409074e-01, 8.429859e-01, & ! 14 + 8.454386e-01, 8.489350e-01, 8.534141e-01, 8.585814e-01, 8.641267e-01, & ! + 8.697999e-01, 8.754223e-01, 8.808785e-01, 8.860944e-01, 8.910354e-01, & ! + 8.956837e-01, 9.000392e-01, 9.041091e-01, 9.079071e-01, 9.114479e-01, & ! + 9.147462e-01, 9.178234e-01, 9.206903e-01, 9.233663e-01, 9.258668e-01, & ! + 9.282006e-01, 9.303847e-01, 9.324288e-01, 9.343418e-01, 9.361356e-01, & ! + 9.378176e-01, 9.393939e-01, 9.408736e-01, 9.422622e-01, 9.435670e-01, & ! + 9.447900e-01, 9.459395e-01, 9.470199e-01, 9.480335e-01, 9.489852e-01, & ! + 9.498782e-01, 9.507168e-01, 9.515044e-01, 9.522470e-01, 9.529409e-01, & ! + 9.535946e-01, 9.542071e-01, 9.547838e-01, 9.553256e-01, 9.558351e-01, & ! + 9.563139e-01, 9.567660e-01, 9.571915e-01, 9.575901e-01, 9.579685e-01, & ! + 9.583239e-01, 9.586602e-01, 9.589766e-01/), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(43,nBandsSW_RRTMG),parameter :: & ! + extice2 = reshape(source= (/ & ! + 4.101824e-01, 2.435514e-01, 1.713697e-01, 1.314865e-01, 1.063406e-01, & ! 1 + 8.910701e-02, 7.659480e-02, 6.711784e-02, 5.970353e-02, 5.375249e-02, & ! + 4.887577e-02, 4.481025e-02, 4.137171e-02, 3.842744e-02, 3.587948e-02, & ! + 3.365396e-02, 3.169419e-02, 2.995593e-02, 2.840419e-02, 2.701091e-02, & ! + 2.575336e-02, 2.461293e-02, 2.357423e-02, 2.262443e-02, 2.175276e-02, & ! + 2.095012e-02, 2.020875e-02, 1.952199e-02, 1.888412e-02, 1.829018e-02, & ! + 1.773586e-02, 1.721738e-02, 1.673144e-02, 1.627510e-02, 1.584579e-02, & ! + 1.544122e-02, 1.505934e-02, 1.469833e-02, 1.435654e-02, 1.403251e-02, & ! + 1.372492e-02, 1.343255e-02, 1.315433e-02, & ! + 3.836650e-01, 2.304055e-01, 1.637265e-01, 1.266681e-01, 1.031602e-01, & ! 2 + 8.695191e-02, 7.511544e-02, 6.610009e-02, 5.900909e-02, 5.328833e-02, & ! + 4.857728e-02, 4.463133e-02, 4.127880e-02, 3.839567e-02, 3.589013e-02, & ! + 3.369280e-02, 3.175027e-02, 3.002079e-02, 2.847121e-02, 2.707493e-02, & ! + 2.581031e-02, 2.465962e-02, 2.360815e-02, 2.264363e-02, 2.175571e-02, & ! + 2.093563e-02, 2.017592e-02, 1.947015e-02, 1.881278e-02, 1.819901e-02, & ! + 1.762463e-02, 1.708598e-02, 1.657982e-02, 1.610330e-02, 1.565390e-02, & ! + 1.522937e-02, 1.482768e-02, 1.444706e-02, 1.408588e-02, 1.374270e-02, & ! + 1.341619e-02, 1.310517e-02, 1.280857e-02, & ! + 4.152673e-01, 2.436816e-01, 1.702243e-01, 1.299704e-01, 1.047528e-01, & ! 3 + 8.756039e-02, 7.513327e-02, 6.575690e-02, 5.844616e-02, 5.259609e-02, & ! + 4.781531e-02, 4.383980e-02, 4.048517e-02, 3.761891e-02, 3.514342e-02, & ! + 3.298525e-02, 3.108814e-02, 2.940825e-02, 2.791096e-02, 2.656858e-02, & ! + 2.535869e-02, 2.426297e-02, 2.326627e-02, 2.235602e-02, 2.152164e-02, & ! + 2.075420e-02, 2.004613e-02, 1.939091e-02, 1.878296e-02, 1.821744e-02, & ! + 1.769015e-02, 1.719741e-02, 1.673600e-02, 1.630308e-02, 1.589615e-02, & ! + 1.551298e-02, 1.515159e-02, 1.481021e-02, 1.448726e-02, 1.418131e-02, & ! + 1.389109e-02, 1.361544e-02, 1.335330e-02, & ! + 3.873250e-01, 2.331609e-01, 1.655002e-01, 1.277753e-01, 1.038247e-01, & ! 4 + 8.731780e-02, 7.527638e-02, 6.611873e-02, 5.892850e-02, 5.313885e-02, & ! + 4.838068e-02, 4.440356e-02, 4.103167e-02, 3.813804e-02, 3.562870e-02, & ! + 3.343269e-02, 3.149539e-02, 2.977414e-02, 2.823510e-02, 2.685112e-02, & ! + 2.560015e-02, 2.446411e-02, 2.342805e-02, 2.247948e-02, 2.160789e-02, & ! + 2.080438e-02, 2.006139e-02, 1.937238e-02, 1.873177e-02, 1.813469e-02, & ! + 1.757689e-02, 1.705468e-02, 1.656479e-02, 1.610435e-02, 1.567081e-02, & ! + 1.526192e-02, 1.487565e-02, 1.451020e-02, 1.416396e-02, 1.383546e-02, & ! + 1.352339e-02, 1.322657e-02, 1.294392e-02, & ! + 3.784280e-01, 2.291396e-01, 1.632551e-01, 1.263775e-01, 1.028944e-01, & ! 5 + 8.666975e-02, 7.480952e-02, 6.577335e-02, 5.866714e-02, 5.293694e-02, & ! + 4.822153e-02, 4.427547e-02, 4.092626e-02, 3.804918e-02, 3.555184e-02, & ! + 3.336440e-02, 3.143307e-02, 2.971577e-02, 2.817912e-02, 2.679632e-02, & ! + 2.554558e-02, 2.440903e-02, 2.337187e-02, 2.242173e-02, 2.154821e-02, & ! + 2.074249e-02, 1.999706e-02, 1.930546e-02, 1.866212e-02, 1.806221e-02, & ! + 1.750152e-02, 1.697637e-02, 1.648352e-02, 1.602010e-02, 1.558358e-02, & ! + 1.517172e-02, 1.478250e-02, 1.441413e-02, 1.406498e-02, 1.373362e-02, & ! + 1.341872e-02, 1.311911e-02, 1.283371e-02, & ! + 3.719909e-01, 2.259490e-01, 1.613144e-01, 1.250648e-01, 1.019462e-01, & ! 6 + 8.595358e-02, 7.425064e-02, 6.532618e-02, 5.830218e-02, 5.263421e-02, & ! + 4.796697e-02, 4.405891e-02, 4.074013e-02, 3.788776e-02, 3.541071e-02, & ! + 3.324008e-02, 3.132280e-02, 2.961733e-02, 2.809071e-02, 2.671645e-02, & ! + 2.547302e-02, 2.434276e-02, 2.331102e-02, 2.236558e-02, 2.149614e-02, & ! + 2.069397e-02, 1.995163e-02, 1.926272e-02, 1.862174e-02, 1.802389e-02, & ! + 1.746500e-02, 1.694142e-02, 1.644994e-02, 1.598772e-02, 1.555225e-02, & ! + 1.514129e-02, 1.475286e-02, 1.438515e-02, 1.403659e-02, 1.370572e-02, & ! + 1.339124e-02, 1.309197e-02, 1.280685e-02, & ! + 3.713158e-01, 2.253816e-01, 1.608461e-01, 1.246718e-01, 1.016109e-01, & ! 7 + 8.566332e-02, 7.399666e-02, 6.510199e-02, 5.810290e-02, 5.245608e-02, & ! + 4.780702e-02, 4.391478e-02, 4.060989e-02, 3.776982e-02, 3.530374e-02, & ! + 3.314296e-02, 3.123458e-02, 2.953719e-02, 2.801794e-02, 2.665043e-02, & ! + 2.541321e-02, 2.428868e-02, 2.326224e-02, 2.232173e-02, 2.145688e-02, & ! + 2.065899e-02, 1.992067e-02, 1.923552e-02, 1.859808e-02, 1.800356e-02, & ! + 1.744782e-02, 1.692721e-02, 1.643855e-02, 1.597900e-02, 1.554606e-02, & ! + 1.513751e-02, 1.475137e-02, 1.438586e-02, 1.403938e-02, 1.371050e-02, & ! + 1.339793e-02, 1.310050e-02, 1.281713e-02, & ! + 3.605883e-01, 2.204388e-01, 1.580431e-01, 1.229033e-01, 1.004203e-01, & ! 8 + 8.482616e-02, 7.338941e-02, 6.465105e-02, 5.776176e-02, 5.219398e-02, & ! + 4.760288e-02, 4.375369e-02, 4.048111e-02, 3.766539e-02, 3.521771e-02, & ! + 3.307079e-02, 3.117277e-02, 2.948303e-02, 2.796929e-02, 2.660560e-02, & ! + 2.537086e-02, 2.424772e-02, 2.322182e-02, 2.228114e-02, 2.141556e-02, & ! + 2.061649e-02, 1.987661e-02, 1.918962e-02, 1.855009e-02, 1.795330e-02, & ! + 1.739514e-02, 1.687199e-02, 1.638069e-02, 1.591845e-02, 1.548276e-02, & ! + 1.507143e-02, 1.468249e-02, 1.431416e-02, 1.396486e-02, 1.363318e-02, & ! + 1.331781e-02, 1.301759e-02, 1.273147e-02, & ! + 3.527890e-01, 2.168469e-01, 1.560090e-01, 1.216216e-01, 9.955787e-02, & ! 9 + 8.421942e-02, 7.294827e-02, 6.432192e-02, 5.751081e-02, 5.199888e-02, & ! + 4.744835e-02, 4.362899e-02, 4.037847e-02, 3.757910e-02, 3.514351e-02, & ! + 3.300546e-02, 3.111382e-02, 2.942853e-02, 2.791775e-02, 2.655584e-02, & ! + 2.532195e-02, 2.419892e-02, 2.317255e-02, 2.223092e-02, 2.136402e-02, & ! + 2.056334e-02, 1.982160e-02, 1.913258e-02, 1.849087e-02, 1.789178e-02, & ! + 1.733124e-02, 1.680565e-02, 1.631187e-02, 1.584711e-02, 1.540889e-02, & ! + 1.499502e-02, 1.460354e-02, 1.423269e-02, 1.388088e-02, 1.354670e-02, & ! + 1.322887e-02, 1.292620e-02, 1.263767e-02, & ! + 3.477874e-01, 2.143515e-01, 1.544887e-01, 1.205942e-01, 9.881779e-02, & ! 10 + 8.366261e-02, 7.251586e-02, 6.397790e-02, 5.723183e-02, 5.176908e-02, & ! + 4.725658e-02, 4.346715e-02, 4.024055e-02, 3.746055e-02, 3.504080e-02, & ! + 3.291583e-02, 3.103507e-02, 2.935891e-02, 2.785582e-02, 2.650042e-02, & ! + 2.527206e-02, 2.415376e-02, 2.313142e-02, 2.219326e-02, 2.132934e-02, & ! + 2.053122e-02, 1.979169e-02, 1.910456e-02, 1.846448e-02, 1.786680e-02, & ! + 1.730745e-02, 1.678289e-02, 1.628998e-02, 1.582595e-02, 1.538835e-02, & ! + 1.497499e-02, 1.458393e-02, 1.421341e-02, 1.386187e-02, 1.352788e-02, & ! + 1.321019e-02, 1.290762e-02, 1.261913e-02, & ! + 3.453721e-01, 2.130744e-01, 1.536698e-01, 1.200140e-01, 9.838078e-02, & ! 11 + 8.331940e-02, 7.223803e-02, 6.374775e-02, 5.703770e-02, 5.160290e-02, & ! + 4.711259e-02, 4.334110e-02, 4.012923e-02, 3.736150e-02, 3.495208e-02, & ! + 3.283589e-02, 3.096267e-02, 2.929302e-02, 2.779560e-02, 2.644517e-02, & ! + 2.522119e-02, 2.410677e-02, 2.308788e-02, 2.215281e-02, 2.129165e-02, & ! + 2.049602e-02, 1.975874e-02, 1.907365e-02, 1.843542e-02, 1.783943e-02, & ! + 1.728162e-02, 1.675847e-02, 1.626685e-02, 1.580401e-02, 1.536750e-02, & ! + 1.495515e-02, 1.456502e-02, 1.419537e-02, 1.384463e-02, 1.351139e-02, & ! + 1.319438e-02, 1.289246e-02, 1.260456e-02, & ! + 3.417883e-01, 2.113379e-01, 1.526395e-01, 1.193347e-01, 9.790253e-02, & ! 12 + 8.296715e-02, 7.196979e-02, 6.353806e-02, 5.687024e-02, 5.146670e-02, & ! + 4.700001e-02, 4.324667e-02, 4.004894e-02, 3.729233e-02, 3.489172e-02, & ! + 3.278257e-02, 3.091499e-02, 2.924987e-02, 2.775609e-02, 2.640859e-02, & ! + 2.518695e-02, 2.407439e-02, 2.305697e-02, 2.212303e-02, 2.126273e-02, & ! + 2.046774e-02, 1.973090e-02, 1.904610e-02, 1.840801e-02, 1.781204e-02, & ! + 1.725417e-02, 1.673086e-02, 1.623902e-02, 1.577590e-02, 1.533906e-02, & ! + 1.492634e-02, 1.453580e-02, 1.416571e-02, 1.381450e-02, 1.348078e-02, & ! + 1.316327e-02, 1.286082e-02, 1.257240e-02, & ! + 3.416111e-01, 2.114124e-01, 1.527734e-01, 1.194809e-01, 9.804612e-02, & ! 13 + 8.310287e-02, 7.209595e-02, 6.365442e-02, 5.697710e-02, 5.156460e-02, & ! + 4.708957e-02, 4.332850e-02, 4.012361e-02, 3.736037e-02, 3.495364e-02, & ! + 3.283879e-02, 3.096593e-02, 2.929589e-02, 2.779751e-02, 2.644571e-02, & ! + 2.522004e-02, 2.410369e-02, 2.308271e-02, 2.214542e-02, 2.128195e-02, & ! + 2.048396e-02, 1.974429e-02, 1.905679e-02, 1.841614e-02, 1.781774e-02, & ! + 1.725754e-02, 1.673203e-02, 1.623807e-02, 1.577293e-02, 1.533416e-02, & ! + 1.491958e-02, 1.452727e-02, 1.415547e-02, 1.380262e-02, 1.346732e-02, & ! + 1.314830e-02, 1.284439e-02, 1.255456e-02, & ! + 4.196611e-01, 2.493642e-01, 1.761261e-01, 1.357197e-01, 1.102161e-01, & ! 14 + 9.269376e-02, 7.992985e-02, 7.022538e-02, 6.260168e-02, 5.645603e-02, & ! + 5.139732e-02, 4.716088e-02, 4.356133e-02, 4.046498e-02, 3.777303e-02, & ! + 3.541094e-02, 3.332137e-02, 3.145954e-02, 2.978998e-02, 2.828419e-02, & ! + 2.691905e-02, 2.567559e-02, 2.453811e-02, 2.349350e-02, 2.253072e-02, & ! + 2.164042e-02, 2.081464e-02, 2.004652e-02, 1.933015e-02, 1.866041e-02, & ! + 1.803283e-02, 1.744348e-02, 1.688894e-02, 1.636616e-02, 1.587244e-02, & ! + 1.540539e-02, 1.496287e-02, 1.454295e-02, 1.414392e-02, 1.376423e-02, & ! + 1.340247e-02, 1.305739e-02, 1.272784e-02/), & ! + shape = (/43,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(43,nBandsSW_RRTMG),parameter :: & ! + ssaice2 = reshape(source= (/ & ! + 6.630615e-01, 6.451169e-01, 6.333696e-01, 6.246927e-01, 6.178420e-01, & ! 1 + 6.121976e-01, 6.074069e-01, 6.032505e-01, 5.995830e-01, 5.963030e-01, & ! + 5.933372e-01, 5.906311e-01, 5.881427e-01, 5.858395e-01, 5.836955e-01, & ! + 5.816896e-01, 5.798046e-01, 5.780264e-01, 5.763429e-01, 5.747441e-01, & ! + 5.732213e-01, 5.717672e-01, 5.703754e-01, 5.690403e-01, 5.677571e-01, & ! + 5.665215e-01, 5.653297e-01, 5.641782e-01, 5.630643e-01, 5.619850e-01, & ! + 5.609381e-01, 5.599214e-01, 5.589328e-01, 5.579707e-01, 5.570333e-01, & ! + 5.561193e-01, 5.552272e-01, 5.543558e-01, 5.535041e-01, 5.526708e-01, & ! + 5.518551e-01, 5.510561e-01, 5.502729e-01, & ! + 7.689749e-01, 7.398171e-01, 7.205819e-01, 7.065690e-01, 6.956928e-01, & ! 2 + 6.868989e-01, 6.795813e-01, 6.733606e-01, 6.679838e-01, 6.632742e-01, & ! + 6.591036e-01, 6.553766e-01, 6.520197e-01, 6.489757e-01, 6.461991e-01, & ! + 6.436531e-01, 6.413075e-01, 6.391375e-01, 6.371221e-01, 6.352438e-01, & ! + 6.334876e-01, 6.318406e-01, 6.302918e-01, 6.288315e-01, 6.274512e-01, & ! + 6.261436e-01, 6.249022e-01, 6.237211e-01, 6.225953e-01, 6.215201e-01, & ! + 6.204914e-01, 6.195055e-01, 6.185592e-01, 6.176492e-01, 6.167730e-01, & ! + 6.159280e-01, 6.151120e-01, 6.143228e-01, 6.135587e-01, 6.128177e-01, & ! + 6.120984e-01, 6.113993e-01, 6.107189e-01, & ! + 9.956167e-01, 9.814770e-01, 9.716104e-01, 9.639746e-01, 9.577179e-01, & ! 3 + 9.524010e-01, 9.477672e-01, 9.436527e-01, 9.399467e-01, 9.365708e-01, & ! + 9.334672e-01, 9.305921e-01, 9.279118e-01, 9.253993e-01, 9.230330e-01, & ! + 9.207954e-01, 9.186719e-01, 9.166501e-01, 9.147199e-01, 9.128722e-01, & ! + 9.110997e-01, 9.093956e-01, 9.077544e-01, 9.061708e-01, 9.046406e-01, & ! + 9.031598e-01, 9.017248e-01, 9.003326e-01, 8.989804e-01, 8.976655e-01, & ! + 8.963857e-01, 8.951389e-01, 8.939233e-01, 8.927370e-01, 8.915785e-01, & ! + 8.904464e-01, 8.893392e-01, 8.882559e-01, 8.871951e-01, 8.861559e-01, & ! + 8.851373e-01, 8.841383e-01, 8.831581e-01, & ! + 9.723177e-01, 9.452119e-01, 9.267592e-01, 9.127393e-01, 9.014238e-01, & ! 4 + 8.919334e-01, 8.837584e-01, 8.765773e-01, 8.701736e-01, 8.643950e-01, & ! + 8.591299e-01, 8.542942e-01, 8.498230e-01, 8.456651e-01, 8.417794e-01, & ! + 8.381324e-01, 8.346964e-01, 8.314484e-01, 8.283687e-01, 8.254408e-01, & ! + 8.226505e-01, 8.199854e-01, 8.174348e-01, 8.149891e-01, 8.126403e-01, & ! + 8.103808e-01, 8.082041e-01, 8.061044e-01, 8.040765e-01, 8.021156e-01, & ! + 8.002174e-01, 7.983781e-01, 7.965941e-01, 7.948622e-01, 7.931795e-01, & ! + 7.915432e-01, 7.899508e-01, 7.884002e-01, 7.868891e-01, 7.854156e-01, & ! + 7.839779e-01, 7.825742e-01, 7.812031e-01, & ! + 9.933294e-01, 9.860917e-01, 9.811564e-01, 9.774008e-01, 9.743652e-01, & ! 5 + 9.718155e-01, 9.696159e-01, 9.676810e-01, 9.659531e-01, 9.643915e-01, & ! + 9.629667e-01, 9.616561e-01, 9.604426e-01, 9.593125e-01, 9.582548e-01, & ! + 9.572607e-01, 9.563227e-01, 9.554347e-01, 9.545915e-01, 9.537888e-01, & ! + 9.530226e-01, 9.522898e-01, 9.515874e-01, 9.509130e-01, 9.502643e-01, & ! + 9.496394e-01, 9.490366e-01, 9.484542e-01, 9.478910e-01, 9.473456e-01, & ! + 9.468169e-01, 9.463039e-01, 9.458056e-01, 9.453212e-01, 9.448499e-01, & ! + 9.443910e-01, 9.439438e-01, 9.435077e-01, 9.430821e-01, 9.426666e-01, & ! + 9.422607e-01, 9.418638e-01, 9.414756e-01, & ! + 9.900787e-01, 9.828880e-01, 9.779258e-01, 9.741173e-01, 9.710184e-01, & ! 6 + 9.684012e-01, 9.661332e-01, 9.641301e-01, 9.623352e-01, 9.607083e-01, & ! + 9.592198e-01, 9.578474e-01, 9.565739e-01, 9.553856e-01, 9.542715e-01, & ! + 9.532226e-01, 9.522314e-01, 9.512919e-01, 9.503986e-01, 9.495472e-01, & ! + 9.487337e-01, 9.479549e-01, 9.472077e-01, 9.464897e-01, 9.457985e-01, & ! + 9.451322e-01, 9.444890e-01, 9.438673e-01, 9.432656e-01, 9.426826e-01, & ! + 9.421173e-01, 9.415684e-01, 9.410351e-01, 9.405164e-01, 9.400115e-01, & ! + 9.395198e-01, 9.390404e-01, 9.385728e-01, 9.381164e-01, 9.376707e-01, & ! + 9.372350e-01, 9.368091e-01, 9.363923e-01, & ! + 9.986793e-01, 9.985239e-01, 9.983911e-01, 9.982715e-01, 9.981606e-01, & ! 7 + 9.980562e-01, 9.979567e-01, 9.978613e-01, 9.977691e-01, 9.976798e-01, & ! + 9.975929e-01, 9.975081e-01, 9.974251e-01, 9.973438e-01, 9.972640e-01, & ! + 9.971855e-01, 9.971083e-01, 9.970322e-01, 9.969571e-01, 9.968830e-01, & ! + 9.968099e-01, 9.967375e-01, 9.966660e-01, 9.965951e-01, 9.965250e-01, & ! + 9.964555e-01, 9.963867e-01, 9.963185e-01, 9.962508e-01, 9.961836e-01, & ! + 9.961170e-01, 9.960508e-01, 9.959851e-01, 9.959198e-01, 9.958550e-01, & ! + 9.957906e-01, 9.957266e-01, 9.956629e-01, 9.955997e-01, 9.955367e-01, & ! + 9.954742e-01, 9.954119e-01, 9.953500e-01, & ! + 9.997944e-01, 9.997791e-01, 9.997664e-01, 9.997547e-01, 9.997436e-01, & ! 8 + 9.997327e-01, 9.997219e-01, 9.997110e-01, 9.996999e-01, 9.996886e-01, & ! + 9.996771e-01, 9.996653e-01, 9.996533e-01, 9.996409e-01, 9.996282e-01, & ! + 9.996152e-01, 9.996019e-01, 9.995883e-01, 9.995743e-01, 9.995599e-01, & ! + 9.995453e-01, 9.995302e-01, 9.995149e-01, 9.994992e-01, 9.994831e-01, & ! + 9.994667e-01, 9.994500e-01, 9.994329e-01, 9.994154e-01, 9.993976e-01, & ! + 9.993795e-01, 9.993610e-01, 9.993422e-01, 9.993230e-01, 9.993035e-01, & ! + 9.992837e-01, 9.992635e-01, 9.992429e-01, 9.992221e-01, 9.992008e-01, & ! + 9.991793e-01, 9.991574e-01, 9.991352e-01, & ! + 9.999949e-01, 9.999947e-01, 9.999943e-01, 9.999939e-01, 9.999934e-01, & ! 9 + 9.999927e-01, 9.999920e-01, 9.999913e-01, 9.999904e-01, 9.999895e-01, & ! + 9.999885e-01, 9.999874e-01, 9.999863e-01, 9.999851e-01, 9.999838e-01, & ! + 9.999824e-01, 9.999810e-01, 9.999795e-01, 9.999780e-01, 9.999764e-01, & ! + 9.999747e-01, 9.999729e-01, 9.999711e-01, 9.999692e-01, 9.999673e-01, & ! + 9.999653e-01, 9.999632e-01, 9.999611e-01, 9.999589e-01, 9.999566e-01, & ! + 9.999543e-01, 9.999519e-01, 9.999495e-01, 9.999470e-01, 9.999444e-01, & ! + 9.999418e-01, 9.999392e-01, 9.999364e-01, 9.999336e-01, 9.999308e-01, & ! + 9.999279e-01, 9.999249e-01, 9.999219e-01, & ! + 9.999997e-01, 9.999997e-01, 9.999997e-01, 9.999996e-01, 9.999996e-01, & ! 10 + 9.999995e-01, 9.999994e-01, 9.999993e-01, 9.999993e-01, 9.999992e-01, & ! + 9.999991e-01, 9.999989e-01, 9.999988e-01, 9.999987e-01, 9.999986e-01, & ! + 9.999984e-01, 9.999983e-01, 9.999981e-01, 9.999980e-01, 9.999978e-01, & ! + 9.999976e-01, 9.999974e-01, 9.999972e-01, 9.999971e-01, 9.999969e-01, & ! + 9.999966e-01, 9.999964e-01, 9.999962e-01, 9.999960e-01, 9.999957e-01, & ! + 9.999955e-01, 9.999953e-01, 9.999950e-01, 9.999947e-01, 9.999945e-01, & ! + 9.999942e-01, 9.999939e-01, 9.999936e-01, 9.999934e-01, 9.999931e-01, & ! + 9.999928e-01, 9.999925e-01, 9.999921e-01, & ! + 9.999997e-01, 9.999996e-01, 9.999996e-01, 9.999995e-01, 9.999994e-01, & ! 11 + 9.999993e-01, 9.999992e-01, 9.999991e-01, 9.999990e-01, 9.999989e-01, & ! + 9.999987e-01, 9.999986e-01, 9.999984e-01, 9.999982e-01, 9.999980e-01, & ! + 9.999978e-01, 9.999976e-01, 9.999974e-01, 9.999972e-01, 9.999970e-01, & ! + 9.999967e-01, 9.999965e-01, 9.999962e-01, 9.999959e-01, 9.999956e-01, & ! + 9.999954e-01, 9.999951e-01, 9.999947e-01, 9.999944e-01, 9.999941e-01, & ! + 9.999938e-01, 9.999934e-01, 9.999931e-01, 9.999927e-01, 9.999923e-01, & ! + 9.999920e-01, 9.999916e-01, 9.999912e-01, 9.999908e-01, 9.999904e-01, & ! + 9.999899e-01, 9.999895e-01, 9.999891e-01, & ! + 9.999987e-01, 9.999987e-01, 9.999985e-01, 9.999984e-01, 9.999982e-01, & ! 12 + 9.999980e-01, 9.999978e-01, 9.999976e-01, 9.999973e-01, 9.999970e-01, & ! + 9.999967e-01, 9.999964e-01, 9.999960e-01, 9.999956e-01, 9.999952e-01, & ! + 9.999948e-01, 9.999944e-01, 9.999939e-01, 9.999934e-01, 9.999929e-01, & ! + 9.999924e-01, 9.999918e-01, 9.999913e-01, 9.999907e-01, 9.999901e-01, & ! + 9.999894e-01, 9.999888e-01, 9.999881e-01, 9.999874e-01, 9.999867e-01, & ! + 9.999860e-01, 9.999853e-01, 9.999845e-01, 9.999837e-01, 9.999829e-01, & ! + 9.999821e-01, 9.999813e-01, 9.999804e-01, 9.999796e-01, 9.999787e-01, & ! + 9.999778e-01, 9.999768e-01, 9.999759e-01, & ! + 9.999989e-01, 9.999989e-01, 9.999987e-01, 9.999986e-01, 9.999984e-01, & ! 13 + 9.999982e-01, 9.999980e-01, 9.999978e-01, 9.999975e-01, 9.999972e-01, & ! + 9.999969e-01, 9.999966e-01, 9.999962e-01, 9.999958e-01, 9.999954e-01, & ! + 9.999950e-01, 9.999945e-01, 9.999941e-01, 9.999936e-01, 9.999931e-01, & ! + 9.999925e-01, 9.999920e-01, 9.999914e-01, 9.999908e-01, 9.999902e-01, & ! + 9.999896e-01, 9.999889e-01, 9.999883e-01, 9.999876e-01, 9.999869e-01, & ! + 9.999861e-01, 9.999854e-01, 9.999846e-01, 9.999838e-01, 9.999830e-01, & ! + 9.999822e-01, 9.999814e-01, 9.999805e-01, 9.999796e-01, 9.999787e-01, & ! + 9.999778e-01, 9.999769e-01, 9.999759e-01, & ! + 7.042143e-01, 6.691161e-01, 6.463240e-01, 6.296590e-01, 6.166381e-01, & ! 14 + 6.060183e-01, 5.970908e-01, 5.894144e-01, 5.826968e-01, 5.767343e-01, & ! + 5.713804e-01, 5.665256e-01, 5.620867e-01, 5.579987e-01, 5.542101e-01, & ! + 5.506794e-01, 5.473727e-01, 5.442620e-01, 5.413239e-01, 5.385389e-01, & ! + 5.358901e-01, 5.333633e-01, 5.309460e-01, 5.286277e-01, 5.263988e-01, & ! + 5.242512e-01, 5.221777e-01, 5.201719e-01, 5.182280e-01, 5.163410e-01, & ! + 5.145062e-01, 5.127197e-01, 5.109776e-01, 5.092766e-01, 5.076137e-01, & ! + 5.059860e-01, 5.043911e-01, 5.028266e-01, 5.012904e-01, 4.997805e-01, & ! + 4.982951e-01, 4.968326e-01, 4.953913e-01/), & ! + shape = (/43,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(43,nBandsSW_RRTMG),parameter :: & ! + asyice2 = reshape(source= (/ & ! + 7.946655e-01, 8.547685e-01, 8.806016e-01, 8.949880e-01, 9.041676e-01, & ! 1 + 9.105399e-01, 9.152249e-01, 9.188160e-01, 9.216573e-01, 9.239620e-01, & ! + 9.258695e-01, 9.274745e-01, 9.288441e-01, 9.300267e-01, 9.310584e-01, & ! + 9.319665e-01, 9.327721e-01, 9.334918e-01, 9.341387e-01, 9.347236e-01, & ! + 9.352551e-01, 9.357402e-01, 9.361850e-01, 9.365942e-01, 9.369722e-01, & ! + 9.373225e-01, 9.376481e-01, 9.379516e-01, 9.382352e-01, 9.385010e-01, & ! + 9.387505e-01, 9.389854e-01, 9.392070e-01, 9.394163e-01, 9.396145e-01, & ! + 9.398024e-01, 9.399809e-01, 9.401508e-01, 9.403126e-01, 9.404670e-01, & ! + 9.406144e-01, 9.407555e-01, 9.408906e-01, & ! + 9.078091e-01, 9.195850e-01, 9.267250e-01, 9.317083e-01, 9.354632e-01, & ! 2 + 9.384323e-01, 9.408597e-01, 9.428935e-01, 9.446301e-01, 9.461351e-01, & ! + 9.474555e-01, 9.486259e-01, 9.496722e-01, 9.506146e-01, 9.514688e-01, & ! + 9.522476e-01, 9.529612e-01, 9.536181e-01, 9.542251e-01, 9.547883e-01, & ! + 9.553124e-01, 9.558019e-01, 9.562601e-01, 9.566904e-01, 9.570953e-01, & ! + 9.574773e-01, 9.578385e-01, 9.581806e-01, 9.585054e-01, 9.588142e-01, & ! + 9.591083e-01, 9.593888e-01, 9.596569e-01, 9.599135e-01, 9.601593e-01, & ! + 9.603952e-01, 9.606219e-01, 9.608399e-01, 9.610499e-01, 9.612523e-01, & ! + 9.614477e-01, 9.616365e-01, 9.618192e-01, & ! + 8.322045e-01, 8.528693e-01, 8.648167e-01, 8.729163e-01, 8.789054e-01, & ! 3 + 8.835845e-01, 8.873819e-01, 8.905511e-01, 8.932532e-01, 8.955965e-01, & ! + 8.976567e-01, 8.994887e-01, 9.011334e-01, 9.026221e-01, 9.039791e-01, & ! + 9.052237e-01, 9.063715e-01, 9.074349e-01, 9.084245e-01, 9.093489e-01, & ! + 9.102154e-01, 9.110303e-01, 9.117987e-01, 9.125253e-01, 9.132140e-01, & ! + 9.138682e-01, 9.144910e-01, 9.150850e-01, 9.156524e-01, 9.161955e-01, & ! + 9.167160e-01, 9.172157e-01, 9.176959e-01, 9.181581e-01, 9.186034e-01, & ! + 9.190330e-01, 9.194478e-01, 9.198488e-01, 9.202368e-01, 9.206126e-01, & ! + 9.209768e-01, 9.213301e-01, 9.216731e-01, & ! + 8.116560e-01, 8.488278e-01, 8.674331e-01, 8.788148e-01, 8.865810e-01, & ! 4 + 8.922595e-01, 8.966149e-01, 9.000747e-01, 9.028980e-01, 9.052513e-01, & ! + 9.072468e-01, 9.089632e-01, 9.104574e-01, 9.117713e-01, 9.129371e-01, & ! + 9.139793e-01, 9.149174e-01, 9.157668e-01, 9.165400e-01, 9.172473e-01, & ! + 9.178970e-01, 9.184962e-01, 9.190508e-01, 9.195658e-01, 9.200455e-01, & ! + 9.204935e-01, 9.209130e-01, 9.213067e-01, 9.216771e-01, 9.220262e-01, & ! + 9.223560e-01, 9.226680e-01, 9.229636e-01, 9.232443e-01, 9.235112e-01, & ! + 9.237652e-01, 9.240074e-01, 9.242385e-01, 9.244594e-01, 9.246708e-01, & ! + 9.248733e-01, 9.250674e-01, 9.252536e-01, & ! + 8.047113e-01, 8.402864e-01, 8.570332e-01, 8.668455e-01, 8.733206e-01, & ! 5 + 8.779272e-01, 8.813796e-01, 8.840676e-01, 8.862225e-01, 8.879904e-01, & ! + 8.894682e-01, 8.907228e-01, 8.918019e-01, 8.927404e-01, 8.935645e-01, & ! + 8.942943e-01, 8.949452e-01, 8.955296e-01, 8.960574e-01, 8.965366e-01, & ! + 8.969736e-01, 8.973740e-01, 8.977422e-01, 8.980820e-01, 8.983966e-01, & ! + 8.986889e-01, 8.989611e-01, 8.992153e-01, 8.994533e-01, 8.996766e-01, & ! + 8.998865e-01, 9.000843e-01, 9.002709e-01, 9.004474e-01, 9.006146e-01, & ! + 9.007731e-01, 9.009237e-01, 9.010670e-01, 9.012034e-01, 9.013336e-01, & ! + 9.014579e-01, 9.015767e-01, 9.016904e-01, & ! + 8.179122e-01, 8.480726e-01, 8.621945e-01, 8.704354e-01, 8.758555e-01, & ! 6 + 8.797007e-01, 8.825750e-01, 8.848078e-01, 8.865939e-01, 8.880564e-01, & ! + 8.892765e-01, 8.903105e-01, 8.911982e-01, 8.919689e-01, 8.926446e-01, & ! + 8.932419e-01, 8.937738e-01, 8.942506e-01, 8.946806e-01, 8.950702e-01, & ! + 8.954251e-01, 8.957497e-01, 8.960477e-01, 8.963223e-01, 8.965762e-01, & ! + 8.968116e-01, 8.970306e-01, 8.972347e-01, 8.974255e-01, 8.976042e-01, & ! + 8.977720e-01, 8.979298e-01, 8.980784e-01, 8.982188e-01, 8.983515e-01, & ! + 8.984771e-01, 8.985963e-01, 8.987095e-01, 8.988171e-01, 8.989195e-01, & ! + 8.990172e-01, 8.991104e-01, 8.991994e-01, & ! + 8.169789e-01, 8.455024e-01, 8.586925e-01, 8.663283e-01, 8.713217e-01, & ! 7 + 8.748488e-01, 8.774765e-01, 8.795122e-01, 8.811370e-01, 8.824649e-01, & ! + 8.835711e-01, 8.845073e-01, 8.853103e-01, 8.860068e-01, 8.866170e-01, & ! + 8.871560e-01, 8.876358e-01, 8.880658e-01, 8.884533e-01, 8.888044e-01, & ! + 8.891242e-01, 8.894166e-01, 8.896851e-01, 8.899324e-01, 8.901612e-01, & ! + 8.903733e-01, 8.905706e-01, 8.907545e-01, 8.909265e-01, 8.910876e-01, & ! + 8.912388e-01, 8.913812e-01, 8.915153e-01, 8.916419e-01, 8.917617e-01, & ! + 8.918752e-01, 8.919829e-01, 8.920851e-01, 8.921824e-01, 8.922751e-01, & ! + 8.923635e-01, 8.924478e-01, 8.925284e-01, & ! + 8.387642e-01, 8.569979e-01, 8.658630e-01, 8.711825e-01, 8.747605e-01, & ! 8 + 8.773472e-01, 8.793129e-01, 8.808621e-01, 8.821179e-01, 8.831583e-01, & ! + 8.840361e-01, 8.847875e-01, 8.854388e-01, 8.860094e-01, 8.865138e-01, & ! + 8.869634e-01, 8.873668e-01, 8.877310e-01, 8.880617e-01, 8.883635e-01, & ! + 8.886401e-01, 8.888947e-01, 8.891298e-01, 8.893477e-01, 8.895504e-01, & ! + 8.897393e-01, 8.899159e-01, 8.900815e-01, 8.902370e-01, 8.903833e-01, & ! + 8.905214e-01, 8.906518e-01, 8.907753e-01, 8.908924e-01, 8.910036e-01, & ! + 8.911094e-01, 8.912101e-01, 8.913062e-01, 8.913979e-01, 8.914856e-01, & ! + 8.915695e-01, 8.916498e-01, 8.917269e-01, & ! + 8.522208e-01, 8.648132e-01, 8.711224e-01, 8.749901e-01, 8.776354e-01, & ! 9 + 8.795743e-01, 8.810649e-01, 8.822518e-01, 8.832225e-01, 8.840333e-01, & ! + 8.847224e-01, 8.853162e-01, 8.858342e-01, 8.862906e-01, 8.866962e-01, & ! + 8.870595e-01, 8.873871e-01, 8.876842e-01, 8.879551e-01, 8.882032e-01, & ! + 8.884316e-01, 8.886425e-01, 8.888380e-01, 8.890199e-01, 8.891895e-01, & ! + 8.893481e-01, 8.894968e-01, 8.896366e-01, 8.897683e-01, 8.898926e-01, & ! + 8.900102e-01, 8.901215e-01, 8.902272e-01, 8.903276e-01, 8.904232e-01, & ! + 8.905144e-01, 8.906014e-01, 8.906845e-01, 8.907640e-01, 8.908402e-01, & ! + 8.909132e-01, 8.909834e-01, 8.910507e-01, & ! + 8.578202e-01, 8.683033e-01, 8.735431e-01, 8.767488e-01, 8.789378e-01, & ! 10 + 8.805399e-01, 8.817701e-01, 8.827485e-01, 8.835480e-01, 8.842152e-01, & ! + 8.847817e-01, 8.852696e-01, 8.856949e-01, 8.860694e-01, 8.864020e-01, & ! + 8.866997e-01, 8.869681e-01, 8.872113e-01, 8.874330e-01, 8.876360e-01, & ! + 8.878227e-01, 8.879951e-01, 8.881548e-01, 8.883033e-01, 8.884418e-01, & ! + 8.885712e-01, 8.886926e-01, 8.888066e-01, 8.889139e-01, 8.890152e-01, & ! + 8.891110e-01, 8.892017e-01, 8.892877e-01, 8.893695e-01, 8.894473e-01, & ! + 8.895214e-01, 8.895921e-01, 8.896597e-01, 8.897243e-01, 8.897862e-01, & ! + 8.898456e-01, 8.899025e-01, 8.899572e-01, & ! + 8.625615e-01, 8.713831e-01, 8.755799e-01, 8.780560e-01, 8.796983e-01, & ! 11 + 8.808714e-01, 8.817534e-01, 8.824420e-01, 8.829953e-01, 8.834501e-01, & ! + 8.838310e-01, 8.841549e-01, 8.844338e-01, 8.846767e-01, 8.848902e-01, & ! + 8.850795e-01, 8.852484e-01, 8.854002e-01, 8.855374e-01, 8.856620e-01, & ! + 8.857758e-01, 8.858800e-01, 8.859759e-01, 8.860644e-01, 8.861464e-01, & ! + 8.862225e-01, 8.862935e-01, 8.863598e-01, 8.864218e-01, 8.864800e-01, & ! + 8.865347e-01, 8.865863e-01, 8.866349e-01, 8.866809e-01, 8.867245e-01, & ! + 8.867658e-01, 8.868050e-01, 8.868423e-01, 8.868778e-01, 8.869117e-01, & ! + 8.869440e-01, 8.869749e-01, 8.870044e-01, & ! + 8.587495e-01, 8.684764e-01, 8.728189e-01, 8.752872e-01, 8.768846e-01, & ! 12 + 8.780060e-01, 8.788386e-01, 8.794824e-01, 8.799960e-01, 8.804159e-01, & ! + 8.807660e-01, 8.810626e-01, 8.813175e-01, 8.815390e-01, 8.817335e-01, & ! + 8.819057e-01, 8.820593e-01, 8.821973e-01, 8.823220e-01, 8.824353e-01, & ! + 8.825387e-01, 8.826336e-01, 8.827209e-01, 8.828016e-01, 8.828764e-01, & ! + 8.829459e-01, 8.830108e-01, 8.830715e-01, 8.831283e-01, 8.831817e-01, & ! + 8.832320e-01, 8.832795e-01, 8.833244e-01, 8.833668e-01, 8.834071e-01, & ! + 8.834454e-01, 8.834817e-01, 8.835164e-01, 8.835495e-01, 8.835811e-01, & ! + 8.836113e-01, 8.836402e-01, 8.836679e-01, & ! + 8.561110e-01, 8.678583e-01, 8.727554e-01, 8.753892e-01, 8.770154e-01, & ! 13 + 8.781109e-01, 8.788949e-01, 8.794812e-01, 8.799348e-01, 8.802952e-01, & ! + 8.805880e-01, 8.808300e-01, 8.810331e-01, 8.812058e-01, 8.813543e-01, & ! + 8.814832e-01, 8.815960e-01, 8.816956e-01, 8.817839e-01, 8.818629e-01, & ! + 8.819339e-01, 8.819979e-01, 8.820560e-01, 8.821089e-01, 8.821573e-01, & ! + 8.822016e-01, 8.822425e-01, 8.822801e-01, 8.823150e-01, 8.823474e-01, & ! + 8.823775e-01, 8.824056e-01, 8.824318e-01, 8.824564e-01, 8.824795e-01, & ! + 8.825011e-01, 8.825215e-01, 8.825408e-01, 8.825589e-01, 8.825761e-01, & ! + 8.825924e-01, 8.826078e-01, 8.826224e-01, & ! + 8.311124e-01, 8.688197e-01, 8.900274e-01, 9.040696e-01, 9.142334e-01, & ! 14 + 9.220181e-01, 9.282195e-01, 9.333048e-01, 9.375689e-01, 9.412085e-01, & ! + 9.443604e-01, 9.471230e-01, 9.495694e-01, 9.517549e-01, 9.537224e-01, & ! + 9.555057e-01, 9.571316e-01, 9.586222e-01, 9.599952e-01, 9.612656e-01, & ! + 9.624458e-01, 9.635461e-01, 9.645756e-01, 9.655418e-01, 9.664513e-01, & ! + 9.673098e-01, 9.681222e-01, 9.688928e-01, 9.696256e-01, 9.703237e-01, & ! + 9.709903e-01, 9.716280e-01, 9.722391e-01, 9.728258e-01, 9.733901e-01, & ! + 9.739336e-01, 9.744579e-01, 9.749645e-01, 9.754546e-01, 9.759294e-01, & ! + 9.763901e-01, 9.768376e-01, 9.772727e-01/), & ! + shape = (/43,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(46,nBandsSW_RRTMG),parameter :: & ! + extice3 = reshape(source= (/ & ! + 5.194013e-01, 3.215089e-01, 2.327917e-01, 1.824424e-01, 1.499977e-01, & ! 1 + 1.273492e-01, 1.106421e-01, 9.780982e-02, 8.764435e-02, 7.939266e-02, & ! + 7.256081e-02, 6.681137e-02, 6.190600e-02, 5.767154e-02, 5.397915e-02, & ! + 5.073102e-02, 4.785151e-02, 4.528125e-02, 4.297296e-02, 4.088853e-02, & ! + 3.899690e-02, 3.727251e-02, 3.569411e-02, 3.424393e-02, 3.290694e-02, & ! + 3.167040e-02, 3.052340e-02, 2.945654e-02, 2.846172e-02, 2.753188e-02, & ! + 2.666085e-02, 2.584322e-02, 2.507423e-02, 2.434967e-02, 2.366579e-02, & ! + 2.301926e-02, 2.240711e-02, 2.182666e-02, 2.127551e-02, 2.075150e-02, & ! + 2.025267e-02, 1.977725e-02, 1.932364e-02, 1.889035e-02, 1.847607e-02, & ! + 1.807956e-02, & ! + 4.901155e-01, 3.065286e-01, 2.230800e-01, 1.753951e-01, 1.445402e-01, & ! 2 + 1.229417e-01, 1.069777e-01, 9.469760e-02, 8.495824e-02, 7.704501e-02, & ! + 7.048834e-02, 6.496693e-02, 6.025353e-02, 5.618286e-02, 5.263186e-02, & ! + 4.950698e-02, 4.673585e-02, 4.426164e-02, 4.203904e-02, 4.003153e-02, & ! + 3.820932e-02, 3.654790e-02, 3.502688e-02, 3.362919e-02, 3.234041e-02, & ! + 3.114829e-02, 3.004234e-02, 2.901356e-02, 2.805413e-02, 2.715727e-02, & ! + 2.631705e-02, 2.552828e-02, 2.478637e-02, 2.408725e-02, 2.342734e-02, & ! + 2.280343e-02, 2.221264e-02, 2.165242e-02, 2.112043e-02, 2.061461e-02, & ! + 2.013308e-02, 1.967411e-02, 1.923616e-02, 1.881783e-02, 1.841781e-02, & ! + 1.803494e-02, & ! + 5.056264e-01, 3.160261e-01, 2.298442e-01, 1.805973e-01, 1.487318e-01, & ! 3 + 1.264258e-01, 1.099389e-01, 9.725656e-02, 8.719819e-02, 7.902576e-02, & ! + 7.225433e-02, 6.655206e-02, 6.168427e-02, 5.748028e-02, 5.381296e-02, & ! + 5.058572e-02, 4.772383e-02, 4.516857e-02, 4.287317e-02, 4.079990e-02, & ! + 3.891801e-02, 3.720217e-02, 3.563133e-02, 3.418786e-02, 3.285686e-02, & ! + 3.162569e-02, 3.048352e-02, 2.942104e-02, 2.843018e-02, 2.750395e-02, & ! + 2.663621e-02, 2.582160e-02, 2.505539e-02, 2.433337e-02, 2.365185e-02, & ! + 2.300750e-02, 2.239736e-02, 2.181878e-02, 2.126937e-02, 2.074699e-02, & ! + 2.024968e-02, 1.977567e-02, 1.932338e-02, 1.889134e-02, 1.847823e-02, & ! + 1.808281e-02, & ! + 4.881605e-01, 3.055237e-01, 2.225070e-01, 1.750688e-01, 1.443736e-01, & ! 4 + 1.228869e-01, 1.070054e-01, 9.478893e-02, 8.509997e-02, 7.722769e-02, & ! + 7.070495e-02, 6.521211e-02, 6.052311e-02, 5.647351e-02, 5.294088e-02, & ! + 4.983217e-02, 4.707539e-02, 4.461398e-02, 4.240288e-02, 4.040575e-02, & ! + 3.859298e-02, 3.694016e-02, 3.542701e-02, 3.403655e-02, 3.275444e-02, & ! + 3.156849e-02, 3.046827e-02, 2.944481e-02, 2.849034e-02, 2.759812e-02, & ! + 2.676226e-02, 2.597757e-02, 2.523949e-02, 2.454400e-02, 2.388750e-02, & ! + 2.326682e-02, 2.267909e-02, 2.212176e-02, 2.159253e-02, 2.108933e-02, & ! + 2.061028e-02, 2.015369e-02, 1.971801e-02, 1.930184e-02, 1.890389e-02, & ! + 1.852300e-02, & ! + 5.103703e-01, 3.188144e-01, 2.317435e-01, 1.819887e-01, 1.497944e-01, & ! 5 + 1.272584e-01, 1.106013e-01, 9.778822e-02, 8.762610e-02, 7.936938e-02, & ! + 7.252809e-02, 6.676701e-02, 6.184901e-02, 5.760165e-02, 5.389651e-02, & ! + 5.063598e-02, 4.774457e-02, 4.516295e-02, 4.284387e-02, 4.074922e-02, & ! + 3.884792e-02, 3.711438e-02, 3.552734e-02, 3.406898e-02, 3.272425e-02, & ! + 3.148038e-02, 3.032643e-02, 2.925299e-02, 2.825191e-02, 2.731612e-02, & ! + 2.643943e-02, 2.561642e-02, 2.484230e-02, 2.411284e-02, 2.342429e-02, & ! + 2.277329e-02, 2.215686e-02, 2.157231e-02, 2.101724e-02, 2.048946e-02, & ! + 1.998702e-02, 1.950813e-02, 1.905118e-02, 1.861468e-02, 1.819730e-02, & ! + 1.779781e-02, & ! + 5.031161e-01, 3.144511e-01, 2.286942e-01, 1.796903e-01, 1.479819e-01, & ! 6 + 1.257860e-01, 1.093803e-01, 9.676059e-02, 8.675183e-02, 7.861971e-02, & ! + 7.188168e-02, 6.620754e-02, 6.136376e-02, 5.718050e-02, 5.353127e-02, & ! + 5.031995e-02, 4.747218e-02, 4.492952e-02, 4.264544e-02, 4.058240e-02, & ! + 3.870979e-02, 3.700242e-02, 3.543933e-02, 3.400297e-02, 3.267854e-02, & ! + 3.145345e-02, 3.031691e-02, 2.925967e-02, 2.827370e-02, 2.735203e-02, & ! + 2.648858e-02, 2.567798e-02, 2.491555e-02, 2.419710e-02, 2.351893e-02, & ! + 2.287776e-02, 2.227063e-02, 2.169491e-02, 2.114821e-02, 2.062840e-02, & ! + 2.013354e-02, 1.966188e-02, 1.921182e-02, 1.878191e-02, 1.837083e-02, & ! + 1.797737e-02, & ! + 4.949453e-01, 3.095918e-01, 2.253402e-01, 1.771964e-01, 1.460446e-01, & ! 7 + 1.242383e-01, 1.081206e-01, 9.572235e-02, 8.588928e-02, 7.789990e-02, & ! + 7.128013e-02, 6.570559e-02, 6.094684e-02, 5.683701e-02, 5.325183e-02, & ! + 5.009688e-02, 4.729909e-02, 4.480106e-02, 4.255708e-02, 4.053025e-02, & ! + 3.869051e-02, 3.701310e-02, 3.547745e-02, 3.406631e-02, 3.276512e-02, & ! + 3.156153e-02, 3.044494e-02, 2.940626e-02, 2.843759e-02, 2.753211e-02, & ! + 2.668381e-02, 2.588744e-02, 2.513839e-02, 2.443255e-02, 2.376629e-02, & ! + 2.313637e-02, 2.253990e-02, 2.197428e-02, 2.143718e-02, 2.092649e-02, & ! + 2.044032e-02, 1.997694e-02, 1.953478e-02, 1.911241e-02, 1.870855e-02, & ! + 1.832199e-02, & ! + 5.052816e-01, 3.157665e-01, 2.296233e-01, 1.803986e-01, 1.485473e-01, & ! 8 + 1.262514e-01, 1.097718e-01, 9.709524e-02, 8.704139e-02, 7.887264e-02, & ! + 7.210424e-02, 6.640454e-02, 6.153894e-02, 5.733683e-02, 5.367116e-02, & ! + 5.044537e-02, 4.758477e-02, 4.503066e-02, 4.273629e-02, 4.066395e-02, & ! + 3.878291e-02, 3.706784e-02, 3.549771e-02, 3.405488e-02, 3.272448e-02, & ! + 3.149387e-02, 3.035221e-02, 2.929020e-02, 2.829979e-02, 2.737397e-02, & ! + 2.650663e-02, 2.569238e-02, 2.492651e-02, 2.420482e-02, 2.352361e-02, & ! + 2.287954e-02, 2.226968e-02, 2.169136e-02, 2.114220e-02, 2.062005e-02, & ! + 2.012296e-02, 1.964917e-02, 1.919709e-02, 1.876524e-02, 1.835231e-02, & ! + 1.795707e-02, & ! + 5.042067e-01, 3.151195e-01, 2.291708e-01, 1.800573e-01, 1.482779e-01, & ! 9 + 1.260324e-01, 1.095900e-01, 9.694202e-02, 8.691087e-02, 7.876056e-02, & ! + 7.200745e-02, 6.632062e-02, 6.146600e-02, 5.727338e-02, 5.361599e-02, & ! + 5.039749e-02, 4.754334e-02, 4.499500e-02, 4.270580e-02, 4.063815e-02, & ! + 3.876135e-02, 3.705016e-02, 3.548357e-02, 3.404400e-02, 3.271661e-02, & ! + 3.148877e-02, 3.034969e-02, 2.929008e-02, 2.830191e-02, 2.737818e-02, & ! + 2.651279e-02, 2.570039e-02, 2.493624e-02, 2.421618e-02, 2.353650e-02, & ! + 2.289390e-02, 2.228541e-02, 2.170840e-02, 2.116048e-02, 2.063950e-02, & ! + 2.014354e-02, 1.967082e-02, 1.921975e-02, 1.878888e-02, 1.837688e-02, & ! + 1.798254e-02, & ! + 5.022507e-01, 3.139246e-01, 2.283218e-01, 1.794059e-01, 1.477544e-01, & ! 10 + 1.255984e-01, 1.092222e-01, 9.662516e-02, 8.663439e-02, 7.851688e-02, & ! + 7.179095e-02, 6.612700e-02, 6.129193e-02, 5.711618e-02, 5.347351e-02, & ! + 5.026796e-02, 4.742530e-02, 4.488721e-02, 4.260724e-02, 4.054790e-02, & ! + 3.867866e-02, 3.697435e-02, 3.541407e-02, 3.398029e-02, 3.265824e-02, & ! + 3.143535e-02, 3.030085e-02, 2.924551e-02, 2.826131e-02, 2.734130e-02, & ! + 2.647939e-02, 2.567026e-02, 2.490919e-02, 2.419203e-02, 2.351509e-02, & ! + 2.287507e-02, 2.226903e-02, 2.169434e-02, 2.114862e-02, 2.062975e-02, & ! + 2.013578e-02, 1.966496e-02, 1.921571e-02, 1.878658e-02, 1.837623e-02, & ! + 1.798348e-02, & ! + 5.068316e-01, 3.166869e-01, 2.302576e-01, 1.808693e-01, 1.489122e-01, & ! 11 + 1.265423e-01, 1.100080e-01, 9.728926e-02, 8.720201e-02, 7.900612e-02, & ! + 7.221524e-02, 6.649660e-02, 6.161484e-02, 5.739877e-02, 5.372093e-02, & ! + 5.048442e-02, 4.761431e-02, 4.505172e-02, 4.274972e-02, 4.067050e-02, & ! + 3.878321e-02, 3.706244e-02, 3.548710e-02, 3.403948e-02, 3.270466e-02, & ! + 3.146995e-02, 3.032450e-02, 2.925897e-02, 2.826527e-02, 2.733638e-02, & ! + 2.646615e-02, 2.564920e-02, 2.488078e-02, 2.415670e-02, 2.347322e-02, & ! + 2.282702e-02, 2.221513e-02, 2.163489e-02, 2.108390e-02, 2.056002e-02, & ! + 2.006128e-02, 1.958591e-02, 1.913232e-02, 1.869904e-02, 1.828474e-02, & ! + 1.788819e-02, & ! + 5.077707e-01, 3.172636e-01, 2.306695e-01, 1.811871e-01, 1.491691e-01, & ! 12 + 1.267565e-01, 1.101907e-01, 9.744773e-02, 8.734125e-02, 7.912973e-02, & ! + 7.232591e-02, 6.659637e-02, 6.170530e-02, 5.748120e-02, 5.379634e-02, & ! + 5.055367e-02, 4.767809e-02, 4.511061e-02, 4.280423e-02, 4.072104e-02, & ! + 3.883015e-02, 3.710611e-02, 3.552776e-02, 3.407738e-02, 3.274002e-02, & ! + 3.150296e-02, 3.035532e-02, 2.928776e-02, 2.829216e-02, 2.736150e-02, & ! + 2.648961e-02, 2.567111e-02, 2.490123e-02, 2.417576e-02, 2.349098e-02, & ! + 2.284354e-02, 2.223049e-02, 2.164914e-02, 2.109711e-02, 2.057222e-02, & ! + 2.007253e-02, 1.959626e-02, 1.914181e-02, 1.870770e-02, 1.829261e-02, & ! + 1.789531e-02, & ! + 5.062281e-01, 3.163402e-01, 2.300275e-01, 1.807060e-01, 1.487921e-01, & ! 13 + 1.264523e-01, 1.099403e-01, 9.723879e-02, 8.716516e-02, 7.898034e-02, & ! + 7.219863e-02, 6.648771e-02, 6.161254e-02, 5.740217e-02, 5.372929e-02, & ! + 5.049716e-02, 4.763092e-02, 4.507179e-02, 4.277290e-02, 4.069649e-02, & ! + 3.881175e-02, 3.709331e-02, 3.552008e-02, 3.407442e-02, 3.274141e-02, & ! + 3.150837e-02, 3.036447e-02, 2.930037e-02, 2.830801e-02, 2.738037e-02, & ! + 2.651132e-02, 2.569547e-02, 2.492810e-02, 2.420499e-02, 2.352243e-02, & ! + 2.287710e-02, 2.226604e-02, 2.168658e-02, 2.113634e-02, 2.061316e-02, & ! + 2.011510e-02, 1.964038e-02, 1.918740e-02, 1.875471e-02, 1.834096e-02, & ! + 1.794495e-02, & ! + 1.338834e-01, 1.924912e-01, 1.755523e-01, 1.534793e-01, 1.343937e-01, & ! 14 + 1.187883e-01, 1.060654e-01, 9.559106e-02, 8.685880e-02, 7.948698e-02, & ! + 7.319086e-02, 6.775669e-02, 6.302215e-02, 5.886236e-02, 5.517996e-02, & ! + 5.189810e-02, 4.895539e-02, 4.630225e-02, 4.389823e-02, 4.171002e-02, & ! + 3.970998e-02, 3.787493e-02, 3.618537e-02, 3.462471e-02, 3.317880e-02, & ! + 3.183547e-02, 3.058421e-02, 2.941590e-02, 2.832256e-02, 2.729724e-02, & ! + 2.633377e-02, 2.542675e-02, 2.457136e-02, 2.376332e-02, 2.299882e-02, & ! + 2.227443e-02, 2.158707e-02, 2.093400e-02, 2.031270e-02, 1.972091e-02, & ! + 1.915659e-02, 1.861787e-02, 1.810304e-02, 1.761055e-02, 1.713899e-02, & ! + 1.668704e-02 /), & ! + shape = (/46,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(46,nBandsSW_RRTMG),parameter :: & ! + ssaice3 = reshape(source= (/ & ! + 6.749442e-01, 6.649947e-01, 6.565828e-01, 6.489928e-01, 6.420046e-01, & ! 1 + 6.355231e-01, 6.294964e-01, 6.238901e-01, 6.186783e-01, 6.138395e-01, & ! + 6.093543e-01, 6.052049e-01, 6.013742e-01, 5.978457e-01, 5.946030e-01, & ! + 5.916302e-01, 5.889115e-01, 5.864310e-01, 5.841731e-01, 5.821221e-01, & ! + 5.802624e-01, 5.785785e-01, 5.770549e-01, 5.756759e-01, 5.744262e-01, & ! + 5.732901e-01, 5.722524e-01, 5.712974e-01, 5.704097e-01, 5.695739e-01, & ! + 5.687747e-01, 5.679964e-01, 5.672238e-01, 5.664415e-01, 5.656340e-01, & ! + 5.647860e-01, 5.638821e-01, 5.629070e-01, 5.618452e-01, 5.606815e-01, & ! + 5.594006e-01, 5.579870e-01, 5.564255e-01, 5.547008e-01, 5.527976e-01, & ! + 5.507005e-01, & ! + 7.628550e-01, 7.567297e-01, 7.508463e-01, 7.451972e-01, 7.397745e-01, & ! 2 + 7.345705e-01, 7.295775e-01, 7.247881e-01, 7.201945e-01, 7.157894e-01, & ! + 7.115652e-01, 7.075145e-01, 7.036300e-01, 6.999044e-01, 6.963304e-01, & ! + 6.929007e-01, 6.896083e-01, 6.864460e-01, 6.834067e-01, 6.804833e-01, & ! + 6.776690e-01, 6.749567e-01, 6.723397e-01, 6.698109e-01, 6.673637e-01, & ! + 6.649913e-01, 6.626870e-01, 6.604441e-01, 6.582561e-01, 6.561163e-01, & ! + 6.540182e-01, 6.519554e-01, 6.499215e-01, 6.479099e-01, 6.459145e-01, & ! + 6.439289e-01, 6.419468e-01, 6.399621e-01, 6.379686e-01, 6.359601e-01, & ! + 6.339306e-01, 6.318740e-01, 6.297845e-01, 6.276559e-01, 6.254825e-01, & ! + 6.232583e-01, & ! + 9.924147e-01, 9.882792e-01, 9.842257e-01, 9.802522e-01, 9.763566e-01, & ! 3 + 9.725367e-01, 9.687905e-01, 9.651157e-01, 9.615104e-01, 9.579725e-01, & ! + 9.544997e-01, 9.510901e-01, 9.477416e-01, 9.444520e-01, 9.412194e-01, & ! + 9.380415e-01, 9.349165e-01, 9.318421e-01, 9.288164e-01, 9.258373e-01, & ! + 9.229027e-01, 9.200106e-01, 9.171589e-01, 9.143457e-01, 9.115688e-01, & ! + 9.088263e-01, 9.061161e-01, 9.034362e-01, 9.007846e-01, 8.981592e-01, & ! + 8.955581e-01, 8.929792e-01, 8.904206e-01, 8.878803e-01, 8.853562e-01, & ! + 8.828464e-01, 8.803488e-01, 8.778616e-01, 8.753827e-01, 8.729102e-01, & ! + 8.704421e-01, 8.679764e-01, 8.655112e-01, 8.630445e-01, 8.605744e-01, & ! + 8.580989e-01, & ! + 9.629413e-01, 9.517182e-01, 9.409209e-01, 9.305366e-01, 9.205529e-01, & ! 4 + 9.109569e-01, 9.017362e-01, 8.928780e-01, 8.843699e-01, 8.761992e-01, & ! + 8.683536e-01, 8.608204e-01, 8.535873e-01, 8.466417e-01, 8.399712e-01, & ! + 8.335635e-01, 8.274062e-01, 8.214868e-01, 8.157932e-01, 8.103129e-01, & ! + 8.050336e-01, 7.999432e-01, 7.950294e-01, 7.902798e-01, 7.856825e-01, & ! + 7.812250e-01, 7.768954e-01, 7.726815e-01, 7.685711e-01, 7.645522e-01, & ! + 7.606126e-01, 7.567404e-01, 7.529234e-01, 7.491498e-01, 7.454074e-01, & ! + 7.416844e-01, 7.379688e-01, 7.342485e-01, 7.305118e-01, 7.267468e-01, & ! + 7.229415e-01, 7.190841e-01, 7.151628e-01, 7.111657e-01, 7.070811e-01, & ! + 7.028972e-01, & ! + 9.942270e-01, 9.909206e-01, 9.876775e-01, 9.844960e-01, 9.813746e-01, & ! 5 + 9.783114e-01, 9.753049e-01, 9.723535e-01, 9.694553e-01, 9.666088e-01, & ! + 9.638123e-01, 9.610641e-01, 9.583626e-01, 9.557060e-01, 9.530928e-01, & ! + 9.505211e-01, 9.479895e-01, 9.454961e-01, 9.430393e-01, 9.406174e-01, & ! + 9.382288e-01, 9.358717e-01, 9.335446e-01, 9.312456e-01, 9.289731e-01, & ! + 9.267255e-01, 9.245010e-01, 9.222980e-01, 9.201147e-01, 9.179496e-01, & ! + 9.158008e-01, 9.136667e-01, 9.115457e-01, 9.094359e-01, 9.073358e-01, & ! + 9.052436e-01, 9.031577e-01, 9.010763e-01, 8.989977e-01, 8.969203e-01, & ! + 8.948423e-01, 8.927620e-01, 8.906778e-01, 8.885879e-01, 8.864907e-01, & ! + 8.843843e-01, & ! + 9.934014e-01, 9.899331e-01, 9.865537e-01, 9.832610e-01, 9.800523e-01, & ! 6 + 9.769254e-01, 9.738777e-01, 9.709069e-01, 9.680106e-01, 9.651862e-01, & ! + 9.624315e-01, 9.597439e-01, 9.571212e-01, 9.545608e-01, 9.520605e-01, & ! + 9.496177e-01, 9.472301e-01, 9.448954e-01, 9.426111e-01, 9.403749e-01, & ! + 9.381843e-01, 9.360370e-01, 9.339307e-01, 9.318629e-01, 9.298313e-01, & ! + 9.278336e-01, 9.258673e-01, 9.239302e-01, 9.220198e-01, 9.201338e-01, & ! + 9.182700e-01, 9.164258e-01, 9.145991e-01, 9.127874e-01, 9.109884e-01, & ! + 9.091999e-01, 9.074194e-01, 9.056447e-01, 9.038735e-01, 9.021033e-01, & ! + 9.003320e-01, 8.985572e-01, 8.967766e-01, 8.949879e-01, 8.931888e-01, & ! + 8.913770e-01, & ! + 9.994833e-01, 9.992055e-01, 9.989278e-01, 9.986500e-01, 9.983724e-01, & ! 7 + 9.980947e-01, 9.978172e-01, 9.975397e-01, 9.972623e-01, 9.969849e-01, & ! + 9.967077e-01, 9.964305e-01, 9.961535e-01, 9.958765e-01, 9.955997e-01, & ! + 9.953230e-01, 9.950464e-01, 9.947699e-01, 9.944936e-01, 9.942174e-01, & ! + 9.939414e-01, 9.936656e-01, 9.933899e-01, 9.931144e-01, 9.928390e-01, & ! + 9.925639e-01, 9.922889e-01, 9.920141e-01, 9.917396e-01, 9.914652e-01, & ! + 9.911911e-01, 9.909171e-01, 9.906434e-01, 9.903700e-01, 9.900967e-01, & ! + 9.898237e-01, 9.895510e-01, 9.892784e-01, 9.890062e-01, 9.887342e-01, & ! + 9.884625e-01, 9.881911e-01, 9.879199e-01, 9.876490e-01, 9.873784e-01, & ! + 9.871081e-01, & ! + 9.999343e-01, 9.998917e-01, 9.998492e-01, 9.998067e-01, 9.997642e-01, & ! 8 + 9.997218e-01, 9.996795e-01, 9.996372e-01, 9.995949e-01, 9.995528e-01, & ! + 9.995106e-01, 9.994686e-01, 9.994265e-01, 9.993845e-01, 9.993426e-01, & ! + 9.993007e-01, 9.992589e-01, 9.992171e-01, 9.991754e-01, 9.991337e-01, & ! + 9.990921e-01, 9.990505e-01, 9.990089e-01, 9.989674e-01, 9.989260e-01, & ! + 9.988846e-01, 9.988432e-01, 9.988019e-01, 9.987606e-01, 9.987194e-01, & ! + 9.986782e-01, 9.986370e-01, 9.985959e-01, 9.985549e-01, 9.985139e-01, & ! + 9.984729e-01, 9.984319e-01, 9.983910e-01, 9.983502e-01, 9.983094e-01, & ! + 9.982686e-01, 9.982279e-01, 9.981872e-01, 9.981465e-01, 9.981059e-01, & ! + 9.980653e-01, & ! + 9.999978e-01, 9.999965e-01, 9.999952e-01, 9.999939e-01, 9.999926e-01, & ! 9 + 9.999913e-01, 9.999900e-01, 9.999887e-01, 9.999873e-01, 9.999860e-01, & ! + 9.999847e-01, 9.999834e-01, 9.999821e-01, 9.999808e-01, 9.999795e-01, & ! + 9.999782e-01, 9.999769e-01, 9.999756e-01, 9.999743e-01, 9.999730e-01, & ! + 9.999717e-01, 9.999704e-01, 9.999691e-01, 9.999678e-01, 9.999665e-01, & ! + 9.999652e-01, 9.999639e-01, 9.999626e-01, 9.999613e-01, 9.999600e-01, & ! + 9.999587e-01, 9.999574e-01, 9.999561e-01, 9.999548e-01, 9.999535e-01, & ! + 9.999522e-01, 9.999509e-01, 9.999496e-01, 9.999483e-01, 9.999470e-01, & ! + 9.999457e-01, 9.999444e-01, 9.999431e-01, 9.999418e-01, 9.999405e-01, & ! + 9.999392e-01, & ! + 9.999994e-01, 9.999993e-01, 9.999991e-01, 9.999990e-01, 9.999989e-01, & ! 10 + 9.999987e-01, 9.999986e-01, 9.999984e-01, 9.999983e-01, 9.999982e-01, & ! + 9.999980e-01, 9.999979e-01, 9.999977e-01, 9.999976e-01, 9.999975e-01, & ! + 9.999973e-01, 9.999972e-01, 9.999970e-01, 9.999969e-01, 9.999967e-01, & ! + 9.999966e-01, 9.999965e-01, 9.999963e-01, 9.999962e-01, 9.999960e-01, & ! + 9.999959e-01, 9.999957e-01, 9.999956e-01, 9.999954e-01, 9.999953e-01, & ! + 9.999952e-01, 9.999950e-01, 9.999949e-01, 9.999947e-01, 9.999946e-01, & ! + 9.999944e-01, 9.999943e-01, 9.999941e-01, 9.999940e-01, 9.999939e-01, & ! + 9.999937e-01, 9.999936e-01, 9.999934e-01, 9.999933e-01, 9.999931e-01, & ! + 9.999930e-01, & ! + 9.999997e-01, 9.999995e-01, 9.999992e-01, 9.999990e-01, 9.999987e-01, & ! 11 + 9.999985e-01, 9.999983e-01, 9.999980e-01, 9.999978e-01, 9.999976e-01, & ! + 9.999973e-01, 9.999971e-01, 9.999969e-01, 9.999967e-01, 9.999965e-01, & ! + 9.999963e-01, 9.999960e-01, 9.999958e-01, 9.999956e-01, 9.999954e-01, & ! + 9.999952e-01, 9.999950e-01, 9.999948e-01, 9.999946e-01, 9.999944e-01, & ! + 9.999942e-01, 9.999939e-01, 9.999937e-01, 9.999935e-01, 9.999933e-01, & ! + 9.999931e-01, 9.999929e-01, 9.999927e-01, 9.999925e-01, 9.999923e-01, & ! + 9.999920e-01, 9.999918e-01, 9.999916e-01, 9.999914e-01, 9.999911e-01, & ! + 9.999909e-01, 9.999907e-01, 9.999905e-01, 9.999902e-01, 9.999900e-01, & ! + 9.999897e-01, & ! + 9.999991e-01, 9.999985e-01, 9.999980e-01, 9.999974e-01, 9.999968e-01, & ! 12 + 9.999963e-01, 9.999957e-01, 9.999951e-01, 9.999946e-01, 9.999940e-01, & ! + 9.999934e-01, 9.999929e-01, 9.999923e-01, 9.999918e-01, 9.999912e-01, & ! + 9.999907e-01, 9.999901e-01, 9.999896e-01, 9.999891e-01, 9.999885e-01, & ! + 9.999880e-01, 9.999874e-01, 9.999869e-01, 9.999863e-01, 9.999858e-01, & ! + 9.999853e-01, 9.999847e-01, 9.999842e-01, 9.999836e-01, 9.999831e-01, & ! + 9.999826e-01, 9.999820e-01, 9.999815e-01, 9.999809e-01, 9.999804e-01, & ! + 9.999798e-01, 9.999793e-01, 9.999787e-01, 9.999782e-01, 9.999776e-01, & ! + 9.999770e-01, 9.999765e-01, 9.999759e-01, 9.999754e-01, 9.999748e-01, & ! + 9.999742e-01, & ! + 9.999975e-01, 9.999961e-01, 9.999946e-01, 9.999931e-01, 9.999917e-01, & ! 13 + 9.999903e-01, 9.999888e-01, 9.999874e-01, 9.999859e-01, 9.999845e-01, & ! + 9.999831e-01, 9.999816e-01, 9.999802e-01, 9.999788e-01, 9.999774e-01, & ! + 9.999759e-01, 9.999745e-01, 9.999731e-01, 9.999717e-01, 9.999702e-01, & ! + 9.999688e-01, 9.999674e-01, 9.999660e-01, 9.999646e-01, 9.999631e-01, & ! + 9.999617e-01, 9.999603e-01, 9.999589e-01, 9.999574e-01, 9.999560e-01, & ! + 9.999546e-01, 9.999532e-01, 9.999517e-01, 9.999503e-01, 9.999489e-01, & ! + 9.999474e-01, 9.999460e-01, 9.999446e-01, 9.999431e-01, 9.999417e-01, & ! + 9.999403e-01, 9.999388e-01, 9.999374e-01, 9.999359e-01, 9.999345e-01, & ! + 9.999330e-01, & ! + 4.526500e-01, 5.287890e-01, 5.410487e-01, 5.459865e-01, 5.485149e-01, & ! 14 + 5.498914e-01, 5.505895e-01, 5.508310e-01, 5.507364e-01, 5.503793e-01, & ! + 5.498090e-01, 5.490612e-01, 5.481637e-01, 5.471395e-01, 5.460083e-01, & ! + 5.447878e-01, 5.434946e-01, 5.421442e-01, 5.407514e-01, 5.393309e-01, & ! + 5.378970e-01, 5.364641e-01, 5.350464e-01, 5.336582e-01, 5.323140e-01, & ! + 5.310283e-01, 5.298158e-01, 5.286914e-01, 5.276704e-01, 5.267680e-01, & ! + 5.260000e-01, 5.253823e-01, 5.249311e-01, 5.246629e-01, 5.245946e-01, & ! + 5.247434e-01, 5.251268e-01, 5.257626e-01, 5.266693e-01, 5.278653e-01, & ! + 5.293698e-01, 5.312022e-01, 5.333823e-01, 5.359305e-01, 5.388676e-01, & ! + 5.422146e-01/), & ! + shape = (/46,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(46,nBandsSW_RRTMG),parameter :: & ! + asyice3 = reshape(source= (/ & ! + 8.340752e-01, 8.435170e-01, 8.517487e-01, 8.592064e-01, 8.660387e-01, & ! 1 + 8.723204e-01, 8.780997e-01, 8.834137e-01, 8.882934e-01, 8.927662e-01, & ! + 8.968577e-01, 9.005914e-01, 9.039899e-01, 9.070745e-01, 9.098659e-01, & ! + 9.123836e-01, 9.146466e-01, 9.166734e-01, 9.184817e-01, 9.200886e-01, & ! + 9.215109e-01, 9.227648e-01, 9.238661e-01, 9.248304e-01, 9.256727e-01, & ! + 9.264078e-01, 9.270505e-01, 9.276150e-01, 9.281156e-01, 9.285662e-01, & ! + 9.289806e-01, 9.293726e-01, 9.297557e-01, 9.301435e-01, 9.305491e-01, & ! + 9.309859e-01, 9.314671e-01, 9.320055e-01, 9.326140e-01, 9.333053e-01, & ! + 9.340919e-01, 9.349861e-01, 9.360000e-01, 9.371451e-01, 9.384329e-01, & ! + 9.398744e-01, & ! + 8.728160e-01, 8.777333e-01, 8.823754e-01, 8.867535e-01, 8.908785e-01, & ! 2 + 8.947611e-01, 8.984118e-01, 9.018408e-01, 9.050582e-01, 9.080739e-01, & ! + 9.108976e-01, 9.135388e-01, 9.160068e-01, 9.183106e-01, 9.204595e-01, & ! + 9.224620e-01, 9.243271e-01, 9.260632e-01, 9.276788e-01, 9.291822e-01, & ! + 9.305817e-01, 9.318853e-01, 9.331012e-01, 9.342372e-01, 9.353013e-01, & ! + 9.363013e-01, 9.372450e-01, 9.381400e-01, 9.389939e-01, 9.398145e-01, & ! + 9.406092e-01, 9.413856e-01, 9.421511e-01, 9.429131e-01, 9.436790e-01, & ! + 9.444561e-01, 9.452517e-01, 9.460729e-01, 9.469270e-01, 9.478209e-01, & ! + 9.487617e-01, 9.497562e-01, 9.508112e-01, 9.519335e-01, 9.531294e-01, & ! + 9.544055e-01, & ! + 7.897566e-01, 7.948704e-01, 7.998041e-01, 8.045623e-01, 8.091495e-01, & ! 3 + 8.135702e-01, 8.178290e-01, 8.219305e-01, 8.258790e-01, 8.296792e-01, & ! + 8.333355e-01, 8.368524e-01, 8.402343e-01, 8.434856e-01, 8.466108e-01, & ! + 8.496143e-01, 8.525004e-01, 8.552737e-01, 8.579384e-01, 8.604990e-01, & ! + 8.629597e-01, 8.653250e-01, 8.675992e-01, 8.697867e-01, 8.718916e-01, & ! + 8.739185e-01, 8.758715e-01, 8.777551e-01, 8.795734e-01, 8.813308e-01, & ! + 8.830315e-01, 8.846799e-01, 8.862802e-01, 8.878366e-01, 8.893534e-01, & ! + 8.908350e-01, 8.922854e-01, 8.937090e-01, 8.951099e-01, 8.964925e-01, & ! + 8.978609e-01, 8.992192e-01, 9.005718e-01, 9.019229e-01, 9.032765e-01, & ! + 9.046369e-01, & ! + 7.812615e-01, 7.887764e-01, 7.959664e-01, 8.028413e-01, 8.094109e-01, & ! 4 + 8.156849e-01, 8.216730e-01, 8.273846e-01, 8.328294e-01, 8.380166e-01, & ! + 8.429556e-01, 8.476556e-01, 8.521258e-01, 8.563753e-01, 8.604131e-01, & ! + 8.642481e-01, 8.678893e-01, 8.713455e-01, 8.746254e-01, 8.777378e-01, & ! + 8.806914e-01, 8.834948e-01, 8.861566e-01, 8.886854e-01, 8.910897e-01, & ! + 8.933779e-01, 8.955586e-01, 8.976402e-01, 8.996311e-01, 9.015398e-01, & ! + 9.033745e-01, 9.051436e-01, 9.068555e-01, 9.085185e-01, 9.101410e-01, & ! + 9.117311e-01, 9.132972e-01, 9.148476e-01, 9.163905e-01, 9.179340e-01, & ! + 9.194864e-01, 9.210559e-01, 9.226505e-01, 9.242784e-01, 9.259476e-01, & ! + 9.276661e-01, & ! + 7.640720e-01, 7.691119e-01, 7.739941e-01, 7.787222e-01, 7.832998e-01, & ! 5 + 7.877304e-01, 7.920177e-01, 7.961652e-01, 8.001765e-01, 8.040551e-01, & ! + 8.078044e-01, 8.114280e-01, 8.149294e-01, 8.183119e-01, 8.215791e-01, & ! + 8.247344e-01, 8.277812e-01, 8.307229e-01, 8.335629e-01, 8.363046e-01, & ! + 8.389514e-01, 8.415067e-01, 8.439738e-01, 8.463560e-01, 8.486568e-01, & ! + 8.508795e-01, 8.530274e-01, 8.551039e-01, 8.571122e-01, 8.590558e-01, & ! + 8.609378e-01, 8.627618e-01, 8.645309e-01, 8.662485e-01, 8.679178e-01, & ! + 8.695423e-01, 8.711251e-01, 8.726697e-01, 8.741792e-01, 8.756571e-01, & ! + 8.771065e-01, 8.785307e-01, 8.799331e-01, 8.813169e-01, 8.826854e-01, & ! + 8.840419e-01, & ! + 7.602598e-01, 7.651572e-01, 7.699014e-01, 7.744962e-01, 7.789452e-01, & ! 6 + 7.832522e-01, 7.874205e-01, 7.914538e-01, 7.953555e-01, 7.991290e-01, & ! + 8.027777e-01, 8.063049e-01, 8.097140e-01, 8.130081e-01, 8.161906e-01, & ! + 8.192645e-01, 8.222331e-01, 8.250993e-01, 8.278664e-01, 8.305374e-01, & ! + 8.331153e-01, 8.356030e-01, 8.380037e-01, 8.403201e-01, 8.425553e-01, & ! + 8.447121e-01, 8.467935e-01, 8.488022e-01, 8.507412e-01, 8.526132e-01, & ! + 8.544210e-01, 8.561675e-01, 8.578554e-01, 8.594875e-01, 8.610665e-01, & ! + 8.625951e-01, 8.640760e-01, 8.655119e-01, 8.669055e-01, 8.682594e-01, & ! + 8.695763e-01, 8.708587e-01, 8.721094e-01, 8.733308e-01, 8.745255e-01, & ! + 8.756961e-01, & ! + 7.568957e-01, 7.606995e-01, 7.644072e-01, 7.680204e-01, 7.715402e-01, & ! 7 + 7.749682e-01, 7.783057e-01, 7.815541e-01, 7.847148e-01, 7.877892e-01, & ! + 7.907786e-01, 7.936846e-01, 7.965084e-01, 7.992515e-01, 8.019153e-01, & ! + 8.045011e-01, 8.070103e-01, 8.094444e-01, 8.118048e-01, 8.140927e-01, & ! + 8.163097e-01, 8.184571e-01, 8.205364e-01, 8.225488e-01, 8.244958e-01, & ! + 8.263789e-01, 8.281993e-01, 8.299586e-01, 8.316580e-01, 8.332991e-01, & ! + 8.348831e-01, 8.364115e-01, 8.378857e-01, 8.393071e-01, 8.406770e-01, & ! + 8.419969e-01, 8.432682e-01, 8.444923e-01, 8.456706e-01, 8.468044e-01, & ! + 8.478952e-01, 8.489444e-01, 8.499533e-01, 8.509234e-01, 8.518561e-01, & ! + 8.527528e-01, & ! + 7.575066e-01, 7.606912e-01, 7.638236e-01, 7.669035e-01, 7.699306e-01, & ! 8 + 7.729046e-01, 7.758254e-01, 7.786926e-01, 7.815060e-01, 7.842654e-01, & ! + 7.869705e-01, 7.896211e-01, 7.922168e-01, 7.947574e-01, 7.972428e-01, & ! + 7.996726e-01, 8.020466e-01, 8.043646e-01, 8.066262e-01, 8.088313e-01, & ! + 8.109796e-01, 8.130709e-01, 8.151049e-01, 8.170814e-01, 8.190001e-01, & ! + 8.208608e-01, 8.226632e-01, 8.244071e-01, 8.260924e-01, 8.277186e-01, & ! + 8.292856e-01, 8.307932e-01, 8.322411e-01, 8.336291e-01, 8.349570e-01, & ! + 8.362244e-01, 8.374312e-01, 8.385772e-01, 8.396621e-01, 8.406856e-01, & ! + 8.416476e-01, 8.425479e-01, 8.433861e-01, 8.441620e-01, 8.448755e-01, & ! + 8.455263e-01, & ! + 7.568829e-01, 7.597947e-01, 7.626745e-01, 7.655212e-01, 7.683337e-01, & ! 9 + 7.711111e-01, 7.738523e-01, 7.765565e-01, 7.792225e-01, 7.818494e-01, & ! + 7.844362e-01, 7.869819e-01, 7.894854e-01, 7.919459e-01, 7.943623e-01, & ! + 7.967337e-01, 7.990590e-01, 8.013373e-01, 8.035676e-01, 8.057488e-01, & ! + 8.078802e-01, 8.099605e-01, 8.119890e-01, 8.139645e-01, 8.158862e-01, & ! + 8.177530e-01, 8.195641e-01, 8.213183e-01, 8.230149e-01, 8.246527e-01, & ! + 8.262308e-01, 8.277483e-01, 8.292042e-01, 8.305976e-01, 8.319275e-01, & ! + 8.331929e-01, 8.343929e-01, 8.355265e-01, 8.365928e-01, 8.375909e-01, & ! + 8.385197e-01, 8.393784e-01, 8.401659e-01, 8.408815e-01, 8.415240e-01, & ! + 8.420926e-01, & ! + 7.548616e-01, 7.575454e-01, 7.602153e-01, 7.628696e-01, 7.655067e-01, & ! 10 + 7.681249e-01, 7.707225e-01, 7.732978e-01, 7.758492e-01, 7.783750e-01, & ! + 7.808735e-01, 7.833430e-01, 7.857819e-01, 7.881886e-01, 7.905612e-01, & ! + 7.928983e-01, 7.951980e-01, 7.974588e-01, 7.996789e-01, 8.018567e-01, & ! + 8.039905e-01, 8.060787e-01, 8.081196e-01, 8.101115e-01, 8.120527e-01, & ! + 8.139416e-01, 8.157764e-01, 8.175557e-01, 8.192776e-01, 8.209405e-01, & ! + 8.225427e-01, 8.240826e-01, 8.255585e-01, 8.269688e-01, 8.283117e-01, & ! + 8.295856e-01, 8.307889e-01, 8.319198e-01, 8.329767e-01, 8.339579e-01, & ! + 8.348619e-01, 8.356868e-01, 8.364311e-01, 8.370930e-01, 8.376710e-01, & ! + 8.381633e-01, & ! + 7.491854e-01, 7.518523e-01, 7.545089e-01, 7.571534e-01, 7.597839e-01, & ! 11 + 7.623987e-01, 7.649959e-01, 7.675737e-01, 7.701303e-01, 7.726639e-01, & ! + 7.751727e-01, 7.776548e-01, 7.801084e-01, 7.825318e-01, 7.849230e-01, & ! + 7.872804e-01, 7.896020e-01, 7.918862e-01, 7.941309e-01, 7.963345e-01, & ! + 7.984951e-01, 8.006109e-01, 8.026802e-01, 8.047009e-01, 8.066715e-01, & ! + 8.085900e-01, 8.104546e-01, 8.122636e-01, 8.140150e-01, 8.157072e-01, & ! + 8.173382e-01, 8.189063e-01, 8.204096e-01, 8.218464e-01, 8.232148e-01, & ! + 8.245130e-01, 8.257391e-01, 8.268915e-01, 8.279682e-01, 8.289675e-01, & ! + 8.298875e-01, 8.307264e-01, 8.314824e-01, 8.321537e-01, 8.327385e-01, & ! + 8.332350e-01, & ! + 7.397086e-01, 7.424069e-01, 7.450955e-01, 7.477725e-01, 7.504362e-01, & ! 12 + 7.530846e-01, 7.557159e-01, 7.583283e-01, 7.609199e-01, 7.634888e-01, & ! + 7.660332e-01, 7.685512e-01, 7.710411e-01, 7.735009e-01, 7.759288e-01, & ! + 7.783229e-01, 7.806814e-01, 7.830024e-01, 7.852841e-01, 7.875246e-01, & ! + 7.897221e-01, 7.918748e-01, 7.939807e-01, 7.960380e-01, 7.980449e-01, & ! + 7.999995e-01, 8.019000e-01, 8.037445e-01, 8.055311e-01, 8.072581e-01, & ! + 8.089235e-01, 8.105255e-01, 8.120623e-01, 8.135319e-01, 8.149326e-01, & ! + 8.162626e-01, 8.175198e-01, 8.187025e-01, 8.198089e-01, 8.208371e-01, & ! + 8.217852e-01, 8.226514e-01, 8.234338e-01, 8.241306e-01, 8.247399e-01, & ! + 8.252599e-01, & ! + 7.224533e-01, 7.251681e-01, 7.278728e-01, 7.305654e-01, 7.332444e-01, & ! 13 + 7.359078e-01, 7.385539e-01, 7.411808e-01, 7.437869e-01, 7.463702e-01, & ! + 7.489291e-01, 7.514616e-01, 7.539661e-01, 7.564408e-01, 7.588837e-01, & ! + 7.612933e-01, 7.636676e-01, 7.660049e-01, 7.683034e-01, 7.705612e-01, & ! + 7.727767e-01, 7.749480e-01, 7.770733e-01, 7.791509e-01, 7.811789e-01, & ! + 7.831556e-01, 7.850791e-01, 7.869478e-01, 7.887597e-01, 7.905131e-01, & ! + 7.922062e-01, 7.938372e-01, 7.954044e-01, 7.969059e-01, 7.983399e-01, & ! + 7.997047e-01, 8.009985e-01, 8.022195e-01, 8.033658e-01, 8.044357e-01, & ! + 8.054275e-01, 8.063392e-01, 8.071692e-01, 8.079157e-01, 8.085768e-01, & ! + 8.091507e-01, & ! + 8.850026e-01, 9.005489e-01, 9.069242e-01, 9.121799e-01, 9.168987e-01, & ! 14 + 9.212259e-01, 9.252176e-01, 9.289028e-01, 9.323000e-01, 9.354235e-01, & ! + 9.382858e-01, 9.408985e-01, 9.432734e-01, 9.454218e-01, 9.473557e-01, & ! + 9.490871e-01, 9.506282e-01, 9.519917e-01, 9.531904e-01, 9.542374e-01, & ! + 9.551461e-01, 9.559298e-01, 9.566023e-01, 9.571775e-01, 9.576692e-01, & ! + 9.580916e-01, 9.584589e-01, 9.587853e-01, 9.590851e-01, 9.593729e-01, & ! + 9.596632e-01, 9.599705e-01, 9.603096e-01, 9.606954e-01, 9.611427e-01, & ! + 9.616667e-01, 9.622826e-01, 9.630060e-01, 9.638524e-01, 9.648379e-01, & ! + 9.659788e-01, 9.672916e-01, 9.687933e-01, 9.705014e-01, 9.724337e-01, & ! + 9.746084e-01/), & ! + shape = (/46,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(46,nBandsSW_RRTMG),parameter :: & ! + fdlice3 = reshape(source= (/ & ! + 4.959277e-02, 4.685292e-02, 4.426104e-02, 4.181231e-02, 3.950191e-02, & ! + 3.732500e-02, 3.527675e-02, 3.335235e-02, 3.154697e-02, 2.985578e-02, & ! + 2.827395e-02, 2.679666e-02, 2.541909e-02, 2.413640e-02, 2.294378e-02, & ! + 2.183639e-02, 2.080940e-02, 1.985801e-02, 1.897736e-02, 1.816265e-02, & ! + 1.740905e-02, 1.671172e-02, 1.606585e-02, 1.546661e-02, 1.490917e-02, & ! + 1.438870e-02, 1.390038e-02, 1.343939e-02, 1.300089e-02, 1.258006e-02, & ! + 1.217208e-02, 1.177212e-02, 1.137536e-02, 1.097696e-02, 1.057210e-02, & ! + 1.015596e-02, 9.723704e-03, 9.270516e-03, 8.791565e-03, 8.282026e-03, & ! + 7.737072e-03, 7.151879e-03, 6.521619e-03, 5.841467e-03, 5.106597e-03, & ! + 4.312183e-03, & ! + 5.071224e-02, 5.000217e-02, 4.933872e-02, 4.871992e-02, 4.814380e-02, & ! + 4.760839e-02, 4.711170e-02, 4.665177e-02, 4.622662e-02, 4.583426e-02, & ! + 4.547274e-02, 4.514007e-02, 4.483428e-02, 4.455340e-02, 4.429544e-02, & ! + 4.405844e-02, 4.384041e-02, 4.363939e-02, 4.345340e-02, 4.328047e-02, & ! + 4.311861e-02, 4.296586e-02, 4.282024e-02, 4.267977e-02, 4.254248e-02, & ! + 4.240640e-02, 4.226955e-02, 4.212995e-02, 4.198564e-02, 4.183462e-02, & ! + 4.167494e-02, 4.150462e-02, 4.132167e-02, 4.112413e-02, 4.091003e-02, & ! + 4.067737e-02, 4.042420e-02, 4.014854e-02, 3.984840e-02, 3.952183e-02, & ! + 3.916683e-02, 3.878144e-02, 3.836368e-02, 3.791158e-02, 3.742316e-02, & ! + 3.689645e-02, & ! + 1.062938e-01, 1.065234e-01, 1.067822e-01, 1.070682e-01, 1.073793e-01, & ! + 1.077137e-01, 1.080693e-01, 1.084442e-01, 1.088364e-01, 1.092439e-01, & ! + 1.096647e-01, 1.100970e-01, 1.105387e-01, 1.109878e-01, 1.114423e-01, & ! + 1.119004e-01, 1.123599e-01, 1.128190e-01, 1.132757e-01, 1.137279e-01, & ! + 1.141738e-01, 1.146113e-01, 1.150385e-01, 1.154534e-01, 1.158540e-01, & ! + 1.162383e-01, 1.166045e-01, 1.169504e-01, 1.172741e-01, 1.175738e-01, & ! + 1.178472e-01, 1.180926e-01, 1.183080e-01, 1.184913e-01, 1.186405e-01, & ! + 1.187538e-01, 1.188291e-01, 1.188645e-01, 1.188580e-01, 1.188076e-01, & ! + 1.187113e-01, 1.185672e-01, 1.183733e-01, 1.181277e-01, 1.178282e-01, & ! + 1.174731e-01, & ! + 1.076195e-01, 1.065195e-01, 1.054696e-01, 1.044673e-01, 1.035099e-01, & ! + 1.025951e-01, 1.017203e-01, 1.008831e-01, 1.000808e-01, 9.931116e-02, & ! + 9.857151e-02, 9.785939e-02, 9.717230e-02, 9.650774e-02, 9.586322e-02, & ! + 9.523623e-02, 9.462427e-02, 9.402484e-02, 9.343544e-02, 9.285358e-02, & ! + 9.227675e-02, 9.170245e-02, 9.112818e-02, 9.055144e-02, 8.996974e-02, & ! + 8.938056e-02, 8.878142e-02, 8.816981e-02, 8.754323e-02, 8.689919e-02, & ! + 8.623517e-02, 8.554869e-02, 8.483724e-02, 8.409832e-02, 8.332943e-02, & ! + 8.252807e-02, 8.169175e-02, 8.081795e-02, 7.990419e-02, 7.894796e-02, & ! + 7.794676e-02, 7.689809e-02, 7.579945e-02, 7.464834e-02, 7.344227e-02, & ! + 7.217872e-02, & ! + 1.119014e-01, 1.122706e-01, 1.126690e-01, 1.130947e-01, 1.135456e-01, & ! + 1.140199e-01, 1.145154e-01, 1.150302e-01, 1.155623e-01, 1.161096e-01, & ! + 1.166703e-01, 1.172422e-01, 1.178233e-01, 1.184118e-01, 1.190055e-01, & ! + 1.196025e-01, 1.202008e-01, 1.207983e-01, 1.213931e-01, 1.219832e-01, & ! + 1.225665e-01, 1.231411e-01, 1.237050e-01, 1.242561e-01, 1.247926e-01, & ! + 1.253122e-01, 1.258132e-01, 1.262934e-01, 1.267509e-01, 1.271836e-01, & ! + 1.275896e-01, 1.279669e-01, 1.283134e-01, 1.286272e-01, 1.289063e-01, & ! + 1.291486e-01, 1.293522e-01, 1.295150e-01, 1.296351e-01, 1.297104e-01, & ! + 1.297390e-01, 1.297189e-01, 1.296480e-01, 1.295244e-01, 1.293460e-01, & ! + 1.291109e-01, & ! + 1.133298e-01, 1.136777e-01, 1.140556e-01, 1.144615e-01, 1.148934e-01, & ! + 1.153492e-01, 1.158269e-01, 1.163243e-01, 1.168396e-01, 1.173706e-01, & ! + 1.179152e-01, 1.184715e-01, 1.190374e-01, 1.196108e-01, 1.201897e-01, & ! + 1.207720e-01, 1.213558e-01, 1.219389e-01, 1.225194e-01, 1.230951e-01, & ! + 1.236640e-01, 1.242241e-01, 1.247733e-01, 1.253096e-01, 1.258309e-01, & ! + 1.263352e-01, 1.268205e-01, 1.272847e-01, 1.277257e-01, 1.281415e-01, & ! + 1.285300e-01, 1.288893e-01, 1.292173e-01, 1.295118e-01, 1.297710e-01, & ! + 1.299927e-01, 1.301748e-01, 1.303154e-01, 1.304124e-01, 1.304637e-01, & ! + 1.304673e-01, 1.304212e-01, 1.303233e-01, 1.301715e-01, 1.299638e-01, & ! + 1.296983e-01, & ! + 1.145360e-01, 1.153256e-01, 1.161453e-01, 1.169929e-01, 1.178666e-01, & ! + 1.187641e-01, 1.196835e-01, 1.206227e-01, 1.215796e-01, 1.225522e-01, & ! + 1.235383e-01, 1.245361e-01, 1.255433e-01, 1.265579e-01, 1.275779e-01, & ! + 1.286011e-01, 1.296257e-01, 1.306494e-01, 1.316703e-01, 1.326862e-01, & ! + 1.336951e-01, 1.346950e-01, 1.356838e-01, 1.366594e-01, 1.376198e-01, & ! + 1.385629e-01, 1.394866e-01, 1.403889e-01, 1.412678e-01, 1.421212e-01, & ! + 1.429469e-01, 1.437430e-01, 1.445074e-01, 1.452381e-01, 1.459329e-01, & ! + 1.465899e-01, 1.472069e-01, 1.477819e-01, 1.483128e-01, 1.487976e-01, & ! + 1.492343e-01, 1.496207e-01, 1.499548e-01, 1.502346e-01, 1.504579e-01, & ! + 1.506227e-01, & ! + 1.153263e-01, 1.161445e-01, 1.169932e-01, 1.178703e-01, 1.187738e-01, & ! + 1.197016e-01, 1.206516e-01, 1.216217e-01, 1.226099e-01, 1.236141e-01, & ! + 1.246322e-01, 1.256621e-01, 1.267017e-01, 1.277491e-01, 1.288020e-01, & ! + 1.298584e-01, 1.309163e-01, 1.319736e-01, 1.330281e-01, 1.340778e-01, & ! + 1.351207e-01, 1.361546e-01, 1.371775e-01, 1.381873e-01, 1.391820e-01, & ! + 1.401593e-01, 1.411174e-01, 1.420540e-01, 1.429671e-01, 1.438547e-01, & ! + 1.447146e-01, 1.455449e-01, 1.463433e-01, 1.471078e-01, 1.478364e-01, & ! + 1.485270e-01, 1.491774e-01, 1.497857e-01, 1.503497e-01, 1.508674e-01, & ! + 1.513367e-01, 1.517554e-01, 1.521216e-01, 1.524332e-01, 1.526880e-01, & ! + 1.528840e-01, & ! + 1.160842e-01, 1.169118e-01, 1.177697e-01, 1.186556e-01, 1.195676e-01, & ! + 1.205036e-01, 1.214616e-01, 1.224394e-01, 1.234349e-01, 1.244463e-01, & ! + 1.254712e-01, 1.265078e-01, 1.275539e-01, 1.286075e-01, 1.296664e-01, & ! + 1.307287e-01, 1.317923e-01, 1.328550e-01, 1.339149e-01, 1.349699e-01, & ! + 1.360179e-01, 1.370567e-01, 1.380845e-01, 1.390991e-01, 1.400984e-01, & ! + 1.410803e-01, 1.420429e-01, 1.429840e-01, 1.439016e-01, 1.447936e-01, & ! + 1.456579e-01, 1.464925e-01, 1.472953e-01, 1.480642e-01, 1.487972e-01, & ! + 1.494923e-01, 1.501472e-01, 1.507601e-01, 1.513287e-01, 1.518511e-01, & ! + 1.523252e-01, 1.527489e-01, 1.531201e-01, 1.534368e-01, 1.536969e-01, & ! + 1.538984e-01, & ! + 1.168725e-01, 1.177088e-01, 1.185747e-01, 1.194680e-01, 1.203867e-01, & ! + 1.213288e-01, 1.222923e-01, 1.232750e-01, 1.242750e-01, 1.252903e-01, & ! + 1.263187e-01, 1.273583e-01, 1.284069e-01, 1.294626e-01, 1.305233e-01, & ! + 1.315870e-01, 1.326517e-01, 1.337152e-01, 1.347756e-01, 1.358308e-01, & ! + 1.368788e-01, 1.379175e-01, 1.389449e-01, 1.399590e-01, 1.409577e-01, & ! + 1.419389e-01, 1.429007e-01, 1.438410e-01, 1.447577e-01, 1.456488e-01, & ! + 1.465123e-01, 1.473461e-01, 1.481483e-01, 1.489166e-01, 1.496492e-01, & ! + 1.503439e-01, 1.509988e-01, 1.516118e-01, 1.521808e-01, 1.527038e-01, & ! + 1.531788e-01, 1.536037e-01, 1.539764e-01, 1.542951e-01, 1.545575e-01, & ! + 1.547617e-01, & ! + 1.180509e-01, 1.189025e-01, 1.197820e-01, 1.206875e-01, 1.216171e-01, & ! + 1.225687e-01, 1.235404e-01, 1.245303e-01, 1.255363e-01, 1.265564e-01, & ! + 1.275888e-01, 1.286313e-01, 1.296821e-01, 1.307392e-01, 1.318006e-01, & ! + 1.328643e-01, 1.339284e-01, 1.349908e-01, 1.360497e-01, 1.371029e-01, & ! + 1.381486e-01, 1.391848e-01, 1.402095e-01, 1.412208e-01, 1.422165e-01, & ! + 1.431949e-01, 1.441539e-01, 1.450915e-01, 1.460058e-01, 1.468947e-01, & ! + 1.477564e-01, 1.485888e-01, 1.493900e-01, 1.501580e-01, 1.508907e-01, & ! + 1.515864e-01, 1.522428e-01, 1.528582e-01, 1.534305e-01, 1.539578e-01, & ! + 1.544380e-01, 1.548692e-01, 1.552494e-01, 1.555767e-01, 1.558490e-01, & ! + 1.560645e-01, & ! + 1.200480e-01, 1.209267e-01, 1.218304e-01, 1.227575e-01, 1.237059e-01, & ! + 1.246739e-01, 1.256595e-01, 1.266610e-01, 1.276765e-01, 1.287041e-01, & ! + 1.297420e-01, 1.307883e-01, 1.318412e-01, 1.328988e-01, 1.339593e-01, & ! + 1.350207e-01, 1.360813e-01, 1.371393e-01, 1.381926e-01, 1.392396e-01, & ! + 1.402783e-01, 1.413069e-01, 1.423235e-01, 1.433263e-01, 1.443134e-01, & ! + 1.452830e-01, 1.462332e-01, 1.471622e-01, 1.480681e-01, 1.489490e-01, & ! + 1.498032e-01, 1.506286e-01, 1.514236e-01, 1.521863e-01, 1.529147e-01, & ! + 1.536070e-01, 1.542614e-01, 1.548761e-01, 1.554491e-01, 1.559787e-01, & ! + 1.564629e-01, 1.568999e-01, 1.572879e-01, 1.576249e-01, 1.579093e-01, & ! + 1.581390e-01, & ! + 1.247813e-01, 1.256496e-01, 1.265417e-01, 1.274560e-01, 1.283905e-01, & ! + 1.293436e-01, 1.303135e-01, 1.312983e-01, 1.322964e-01, 1.333060e-01, & ! + 1.343252e-01, 1.353523e-01, 1.363855e-01, 1.374231e-01, 1.384632e-01, & ! + 1.395042e-01, 1.405441e-01, 1.415813e-01, 1.426140e-01, 1.436404e-01, & ! + 1.446587e-01, 1.456672e-01, 1.466640e-01, 1.476475e-01, 1.486157e-01, & ! + 1.495671e-01, 1.504997e-01, 1.514117e-01, 1.523016e-01, 1.531673e-01, & ! + 1.540073e-01, 1.548197e-01, 1.556026e-01, 1.563545e-01, 1.570734e-01, & ! + 1.577576e-01, 1.584054e-01, 1.590149e-01, 1.595843e-01, 1.601120e-01, & ! + 1.605962e-01, 1.610349e-01, 1.614266e-01, 1.617693e-01, 1.620614e-01, & ! + 1.623011e-01, & ! + 1.006055e-01, 9.549582e-02, 9.063960e-02, 8.602900e-02, 8.165612e-02, & ! + 7.751308e-02, 7.359199e-02, 6.988496e-02, 6.638412e-02, 6.308156e-02, & ! + 5.996942e-02, 5.703979e-02, 5.428481e-02, 5.169657e-02, 4.926719e-02, & ! + 4.698880e-02, 4.485349e-02, 4.285339e-02, 4.098061e-02, 3.922727e-02, & ! + 3.758547e-02, 3.604733e-02, 3.460497e-02, 3.325051e-02, 3.197604e-02, & ! + 3.077369e-02, 2.963558e-02, 2.855381e-02, 2.752050e-02, 2.652776e-02, & ! + 2.556772e-02, 2.463247e-02, 2.371415e-02, 2.280485e-02, 2.189670e-02, & ! + 2.098180e-02, 2.005228e-02, 1.910024e-02, 1.811781e-02, 1.709709e-02, & ! + 1.603020e-02, 1.490925e-02, 1.372635e-02, 1.247363e-02, 1.114319e-02, & ! + 9.727157e-03/), & ! + shape = (/46,nBandsSW_RRTMG/)) + + + + real(kind_phys),dimension(5) :: & + abari = (/ 3.448e-03,3.448e-03,3.448e-03,3.448e-03,3.448e-03 /), & + bbari = (/ 2.431e+00,2.431e+00,2.431e+00,2.431e+00,2.431e+00 /), & + cbari = (/ 1.000e-05,1.100e-04,1.240e-02,3.779e-02,4.666e-01 /), & + dbari = (/ 0.000e+00,1.405e-05,6.867e-04,1.284e-03,2.050e-05 /), & + ebari = (/ 7.661e-01,7.730e-01,7.865e-01,8.172e-01,9.595e-01 /), & + fbari = (/ 5.851e-04,5.665e-04,7.204e-04,7.463e-04,1.076e-04 /) + + ! ipat is bands index for ebert & curry ice cloud (for iflagice=1) + integer,dimension(nBandsSW_RRTMG),parameter :: & + ipat = (/ 5, 5, 4, 4, 3, 3, 2, 2, 1, 1, 1, 1, 1, 5 /) + +contains + ! ######################################################################################### + ! rrtmg_sw_cloud_optics + ! ######################################################################################### + subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld_iwp, & + cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, & + tau_cld, ssa_cld, asy_cld) + ! Inputs + integer,intent(in) :: & + nBandsSW, & ! Number of spectral bands + ncol, & ! Number of horizontal gridpoints + nlay ! Number of vertical layers + real(kind_phys), dimension(ncol,nlay), intent(in) :: & + cld_frac, & ! Cloud-fraction (1) + cld_lwp, & ! Cloud liquid water path (g/m2) + cld_ref_liq, & ! Effective radius (liquid) (micron) + cld_iwp, & ! Cloud ice water path (g/m2) + cld_ref_ice, & ! Effective radius (ice) (micron) + cld_rwp, & ! Cloud rain water path (g/m2) + cld_ref_rain, & ! Effective radius (rain-drop) (micron) + cld_swp, & ! Cloud snow-water path (g/m2) + cld_ref_snow ! Effective radius (snow-flake) (micron) + + ! Outputs + real(kind_phys),dimension(ncol,nlay,nBandsSW),intent(out) :: & + tau_cld, & ! In-cloud optical depth (1) + ssa_cld, & ! In-cloud single-scattering albedo (1) + asy_cld ! In-cloud asymmetry parameter (1) + + ! Local variables + integer :: iCol, iLay, iBand, index, ia + real(kind_phys) :: tau_rain, tau_snow, factor, fint, cld_ref_iceTemp,asyw,ssaw,za1,za2 + + real(kind_phys), dimension(nBandsSW) :: ssa_rain, ssa_snow, asy_rain, asy_snow, & + tau_liq, ssa_liq, asy_liq, tau_ice, ssa_ice, asy_ice, asycoliq, & + forwice, extcoice, asycoice, ssacoice, fdelta, extcoliq, ssacoliq + + ! Initialize + tau_cld(:,:,:) = 0._kind_phys + ssa_cld(:,:,:) = 1._kind_phys + asy_cld(:,:,:) = 0._kind_phys + + ! Compute cloud radiative properties for cloud. + if (iswcliq > 0) then + do iCol=1,ncol + do iLay=1,nlay + ! Initialize + tau_liq(:) = 0._kind_phys + tau_ice(:) = 0._kind_phys + tau_rain = 0._kind_phys + tau_snow = 0._kind_phys + ssa_liq(:) = 0._kind_phys + ssa_ice(:) = 0._kind_phys + ssa_rain(:) = 0._kind_phys + ssa_snow(:) = 0._kind_phys + asy_liq(:) = 0._kind_phys + asy_ice(:) = 0._kind_phys + asy_rain(:) = 0._kind_phys + asy_snow(:) = 0._kind_phys + if (cld_frac(iCol,iLay) .gt. 1.e-12_kind_phys) then + ! ########################################################################### + ! Rain clouds + ! ########################################################################### + ! Rain optical depth (No band dependence) + tau_rain = cld_rwp(iCol,iLay)*a0r + + ! Rain single-scattering albedo and asymmetry (Band dependent) + do iBand=1,nBandsSW + ssa_rain(iBand) = tau_rain*(1.-b0r(iBand)) + asy_rain(iBand) = ssa_rain(iBand)*c0r(iBand) + enddo + + ! ########################################################################### + ! Snow clouds + ! ########################################################################### + ! Snow optical depth (No band dependence) + if (cld_swp(iCol,iLay) .gt. 0. .and. cld_ref_snow(iCol,iLay) .gt. 10._kind_phys) then + tau_snow = cld_swp(iCol,iLay) + else + tau_snow = 0._kind_phys + endif + + ! Snow single-scattering albedo and asymmetry (Band dependent) + do iBand=1,nBandsSW + ssa_snow(iBand) = tau_snow*(1.-(b0s(iBand)+b1s(iBand)*1.0315*cld_ref_snow(iCol,iLay))) + asy_snow(iBand) = ssa_snow(iBand)*c0s(iBand) + enddo + + ! ########################################################################### + ! Liquid clouds + ! ########################################################################### + if (cld_lwp(iCol,iLay) .gt. 0) then + ! Find index in coefficient LUT for corresponding partice size. + factor = cld_ref_liq(iCol,iLay) - 1.5 + index = max( 1, min( 57, int( factor ) )) + fint = factor - float(index) + + ! Extract coefficents for all bands and compute radiative properties + do iBand=1,nBandsSW + ! Interpolate coefficients + if ( iswcliq == 1 ) then + extcoliq(iBand) = max(0._kind_phys, extliq1(index,iBand) + & + fint*(extliq1(index+1,iBand)-extliq1(index,iBand))) + ssacoliq(iBand) = max(0._kind_phys, min(1._kind_phys, ssaliq1(index,iBand) + & + fint*(ssaliq1(index+1,iBand)-ssaliq1(index,iBand)))) + asycoliq(iBand) = max(0._kind_phys, min(1._kind_phys, asyliq1(index,iBand) + & + fint*(asyliq1(index+1,iBand)-asyliq1(index,iBand)))) + elseif ( iswcliq == 2 ) then ! use updated coeffs + extcoliq(iBand) = max(0._kind_phys, extliq2(index,iBand) + & + fint*(extliq2(index+1,iBand)-extliq2(index,iBand))) + ssacoliq(iBand) = max(0._kind_phys, min(1._kind_phys, ssaliq2(index,iBand) + & + fint*(ssaliq2(index+1,iBand)-ssaliq2(index,iBand)))) + asycoliq(iBand) = max(0._kind_phys, min(1._kind_phys, asyliq2(index,iBand) + & + fint*(asyliq2(index+1,iBand)-asyliq2(index,iBand)))) + endif + if (fint .lt. 0._kind_phys .and. ssacoliq(iBand) .gt. 1._kind_phys) then + ssacoliq(iBand) = ssaliq1(index,iBand) + endif + tau_liq(iBand) = cld_lwp(iCol,iLay) * extcoliq(iBand) + ssa_liq(iBand) = tau_liq(iBand) * ssacoliq(iBand) + asy_liq(iBand) = ssa_liq(iBand) * asycoliq(iBand) + enddo + endif ! IF cloudy with liquid condensate + + ! ########################################################################### + ! Ice clouds + ! ########################################################################### + if (cld_iwp(iCol,iLay) .gt. 0) then + ! Ebert and curry approach for all particle sizes though somewhat + ! unjustified for large ice particles. + if ( iswcice == 1 ) then + cld_ref_iceTemp = min(130._kind_phys, max(13._kind_phys,cld_ref_ice(iCol,iLay))) + do iBand=1,nBandsSW + ia = ipat(iBand) ! eb_&_c band index for ice cloud coeff + extcoice(iBand) = abari(ia) + bbari(ia) / cld_ref_iceTemp + ssacoice(iBand) = 1._kind_phys - cbari(ia) - dbari(ia)*cld_ref_iceTemp + asycoice(iBand) = ebari(ia)+fbari(ia)*cld_ref_iceTemp + tau_ice(iBand) = cld_iwp(iCol,iLay) * extcoice(iBand) + ssa_ice(iBand) = tau_ice(iBand) * ssacoice(iBand) + asy_ice(iBand) = ssa_ice(iBand) * asycoice(iBand) + enddo + + ! Streamer approach for ice effective radius between 5.0 and 131.0 microns. + elseif ( iswcice == 2 ) then + cld_ref_iceTemp = min(131._kind_phys, max(5.0_kind_phys,cld_ref_ice(iCol,iLay))) + factor = (cld_ref_iceTemp - 2.) / 3. + index = max( 1, min( 42, int( factor ) )) + fint = factor - float(index) + do iBand = 1,nBandsSW + extcoice(iBand) = extice2(index,iBand) + & + fint*(extice2(index+1,iBand)-extice2(index,iBand)) + ssacoice(iBand) = ssaice2(index,iBand) + & + fint*(ssaice2(index+1,iBand)-ssaice2(index,iBand)) + asycoice(iBand) = asyice2(index,iBand) + & + fint*(asyice2(index+1,iBand)-asyice2(index,iBand)) + tau_ice(iBand) = cld_iwp(iCol,iLay) * extcoice(iBand) + ssa_ice(iBand) = tau_ice(iBand) * ssacoice(iBand) + asy_ice(iBand) = ssa_ice(iBand) * asycoice(iBand) + enddo + + ! Fu's approach for ice effective radius between 4.8 and 135 microns + ! (generalized effective size from 5 to 140 microns). + ! https://doi.org/10.1175/1520-0442(1996)009<2058:AAPOTS>2.0.CO;2 + elseif ( iswcice == 3 ) then + cld_ref_iceTemp = max( 5.0, min( 140.0, 1.0315*cld_ref_ice(iCol,iLay) )) + ! Determine indices for table interpolation. + factor = (cld_ref_iceTemp - 2._kind_phys) / 3._kind_phys + index = max( 1, min( 45, int( factor ) )) + fint = factor - float(index) + do iBand = 1,nBandsSW + ! Interpolate coefficient tables to appropriate ice-particle size. + extcoice(iBand) = max(0._kind_phys, extice3(index,iBand) + & + fint*(extice3(index+1,iBand)-extice3(index,iBand))) ! eq (3.9a) + ssacoice(iBand) = max(0._kind_phys, min(1._kind_phys, ssaice3(index,iBand) + & + fint*(ssaice3(index+1,iBand)-ssaice3(index,iBand)))) ! eq (3.9b) + asycoice(iBand) = max(0._kind_phys, min(1._kind_phys, asyice3(index,iBand) + & + fint*(asyice3(index+1,iBand)-asyice3(index,iBand)))) ! eq (3.9c) + fdelta(iBand) = fdlice3(index,iBand) + & + fint*(fdlice3(index+1,iBand)-fdlice3(index,iBand)) ! eq (3.9d) + forwice(iBand) = fdelta(iBand) + 0.5_kind_phys / ssacoice(iBand) + if (forwice(iBand) .gt. asycoice(iBand)) forwice(iBand) = asycoice(iBand) + tau_ice(iBand) = cld_iwp(iCol,iLay) * extcoice(iBand) + ssa_ice(iBand) = tau_ice(iBand) * ssacoice(iBand) + asy_ice(iBand) = ssa_ice(iBand) * asycoice(iBand) + enddo + endif + endif ! IF cloudy column with ice condensate + endif ! IF cloudy column + + ! ########################################################################### + ! Compute total cloud radiative properties (tau, omega, and g) + ! ########################################################################### + if (cld_frac(iCol,iLay) .gt. 1.e-12_kind_phys) then + do iBand = 1,nBandsSW + ! Sum up radiative properties by type. + tau_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, tau_liq(iBand) + tau_ice(iBand) + tau_rain + tau_snow) + ssa_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, ssa_liq(iBand) + ssa_ice(iBand) + ssa_rain(iBand) + ssa_snow(iBand)) + asy_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, asy_liq(iBand) + asy_ice(iBand) + asy_rain(iBand) + asy_snow(iBand)) + ! Delta-scale + asyw = asy_cld(iCol,iLay,iBand)/max(1.e-12_kind_phys, ssa_cld(iCol,iLay,iBand)) + ssaw = min(1._kind_phys-0.000001, ssa_cld(iCol,iLay,iBand)/tau_cld(iCol,iLay,iBand)) + za1 = asyw * asyw + za2 = ssaw * za1 + tau_cld(iCol,iLay,iBand) = (1._kind_phys - za2) * tau_cld(iCol,iLay,iBand) + ssa_cld(iCol,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) + asy_cld(iCol,iLay,iBand) = asyw/(1+asyw) + enddo ! Loop over SW bands + endif ! END sum cloudy properties + ! + enddo ! Loop over layers + enddo ! Loop over columns + endif + end subroutine rrtmg_sw_cloud_optics + + ! ####################################################################################### + ! SUBROUTINE mcica_subcol_sw + ! ###################################################################################### + subroutine mcica_subcol_sw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth, & + cld_frac_mcica) + ! Inputs + integer,intent(in) :: & + ncol, & ! Number of horizontal gridpoints + nlay, & ! Number of vertical layers + ngpts ! Number of spectral g-points + integer,dimension(ncol),intent(in) :: & + icseed ! Permutation seed for each column. + real(kind_phys), dimension(ncol), intent(in) :: & + de_lgth ! Cloud decorrelation length (km) + real(kind_phys), dimension(ncol,nlay), intent(in) :: & + cld_frac, & ! Cloud-fraction + dzlyr ! Layer thinkness (km) + ! Outputs + logical,dimension(ncol,nlay,ngpts),intent(out) :: & + cld_frac_mcica + ! Local variables + type(random_stat) :: stat + integer :: icol,n,k,k1 + real(kind_phys) :: tem1 + real(kind_phys),dimension(ngpts) :: rand1D + real(kind_phys),dimension(nlay*ngpts) :: rand2D + real(kind_phys),dimension(ngpts,nlay) :: cdfunc,cdfun2 + real(kind_phys),dimension(nlay) :: fac_lcf + logical,dimension(ngpts,nlay) :: lcloudy + + ! Loop over all columns + do icol=1,ncol + ! Call random_setseed() to advance random number generator by "icseed" values. + call random_setseed(icseed(icol),stat) + + ! ################################################################################### + ! Sub-column set up according to overlapping assumption: + ! - For random overlap, pick a random value at every level + ! - For max-random overlap, pick a random value at every level + ! - For maximum overlap, pick same random numebr at every level + ! ################################################################################### + select case ( iovrsw ) + ! ################################################################################### + ! 0) Random overlap + ! ################################################################################### + case( 0 ) + call random_number(rand2D,stat) + k1 = 0 + do n = 1, ngpts + do k = 1, nlay + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + ! ################################################################################### + ! 1) Maximum-random overlap + ! ################################################################################### + case(1) + call random_number(rand2D,stat) + k1 = 0 + do n = 1, ngpts + do k = 1, nlay + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + ! First pick a random number for bottom (or top) layer. + ! then walk up the column: (aer's code) + ! if layer below is cloudy, use the same rand num in the layer below + ! if layer below is clear, use a new random number + do k = 2, nlay + k1 = k - 1 + tem1 = 1._kind_phys - cld_frac(icol,k1) + do n = 1, ngpts + if ( cdfunc(n,k1) > tem1 ) then + cdfunc(n,k) = cdfunc(n,k1) + else + cdfunc(n,k) = cdfunc(n,k) * tem1 + endif + enddo + enddo + + ! ################################################################################### + ! 2) Maximum overlap + ! ################################################################################### + case(2) + call random_number(rand1d,stat) + do n = 1, ngpts + tem1 = rand1d(n) + do k = 1, nlay + cdfunc(n,k) = tem1 + enddo + enddo + + ! ################################################################################### + ! 3) Decorrelation length + ! ################################################################################### + case(3) + ! Compute overlapping factors based on layer midpoint distances and decorrelation + ! depths + do k = nlay, 2, -1 + fac_lcf(k) = exp( -0.5 * (dzlyr(iCol,k)+dzlyr(iCol,k-1)) / de_lgth(iCol) ) + enddo + + ! Setup 2 sets of random numbers + call random_number ( rand2d, stat ) + k1 = 0 + do k = 1, nlay + do n = 1, ngpts + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + ! + call random_number ( rand2d, stat ) + k1 = 0 + do k = 1, nlay + do n = 1, ngpts + k1 = k1 + 1 + cdfun2(n,k) = rand2d(k1) + enddo + enddo + + ! Then working from the top down: + ! if a random number (from an independent set -cdfun2) is smaller then the + ! scale factor: use the upper layer's number, otherwise use a new random + ! number (keep the original assigned one). + do k = nlay-1, 1, -1 + k1 = k + 1 + do n = 1, ngpts + if ( cdfun2(n,k) <= fac_lcf(k1) ) then + cdfunc(n,k) = cdfunc(n,k1) + endif + enddo + enddo + + end select + + ! ################################################################################### + ! Generate subcolumn cloud mask (0/1 for clear/cloudy) + ! ################################################################################### + do k = 1, nlay + tem1 = 1._kind_phys - cld_frac(icol,k) + do n = 1, ngpts + lcloudy(n,k) = cdfunc(n,k) >= tem1 + if (lcloudy(n,k)) then + cld_frac_mcica(icol,k,n) = .true. + else + cld_frac_mcica(icol,k,n) = .false. + endif + enddo + enddo + enddo ! END LOOP OVER COLUMNS + end subroutine mcica_subcol_sw +end module mo_rrtmg_sw_cloud_optics diff --git a/physics/rrtmgp_aux.F90 b/physics/rrtmgp_aux.F90 new file mode 100644 index 000000000..0ee837b97 --- /dev/null +++ b/physics/rrtmgp_aux.F90 @@ -0,0 +1,33 @@ +module rrtmgp_aux + use machine, only: & + kind_phys ! Working type + implicit none + + real(kind_phys) :: & + rrtmgp_minP, & ! Minimum pressure allowed in RRTMGP + rrtmgp_minT ! Minimum temperature allowed in RRTMGP +contains + ! + subroutine rrtmgp_aux_init() + end subroutine rrtmgp_aux_init + ! + subroutine rrtmgp_aux_run() + end subroutine rrtmgp_aux_run + ! + subroutine rrtmgp_aux_finalize() + end subroutine rrtmgp_aux_finalize + + ! ######################################################################################### + ! SUBROUTINE check_error_msg + ! ######################################################################################### + subroutine check_error_msg(routine_name, error_msg) + character(len=*), intent(in) :: & + error_msg, routine_name + + if(error_msg /= "") then + print*,"ERROR("//trim(routine_name)//"): " + print*,trim(error_msg) + return + end if + end subroutine check_error_msg +end module rrtmgp_aux diff --git a/physics/rrtmgp_lw_aerosol_optics.F90 b/physics/rrtmgp_lw_aerosol_optics.F90 new file mode 100644 index 000000000..a77b00759 --- /dev/null +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -0,0 +1,97 @@ +module rrtmgp_lw_aerosol_optics + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_optical_props, only: ty_optical_props_1scl + use rrtmgp_aux, only: check_error_msg + use module_radiation_aerosols, only: & + NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) + NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) + setaer, & ! Routine to compute aerosol radiative properties (tau,g,omega) + NSPC1 ! Number of species for vertically integrated aerosol optical-depth + use netcdf + + public rrtmgp_lw_aerosol_optics_init, rrtmgp_lw_aerosol_optics_run, rrtmgp_lw_aerosol_optics_finalize +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_aerosol_optics_init() + ! ######################################################################################### + subroutine rrtmgp_lw_aerosol_optics_init() + end subroutine rrtmgp_lw_aerosol_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_aerosol_optics_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_aerosol_optics_run +!! \htmlinclude rrtmgp_lw_aerosol_optics.html +!! + subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, p_lev, p_lay, p_lk, & + tv_lay, relhum, lsmask, tracer, lon, lat, lw_gas_props, sw_gas_props, & + aerodp, lw_optical_props_aerosol, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Logical flag for longwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + nTracer ! Number of tracers + real(kind_phys), dimension(nCol), intent(in) :: & + lon, & ! Longitude + lat, & ! Latitude + lsmask ! Land/sea/sea-ice mask + real(kind_phys), dimension(nCol,Nlev),intent(in) :: & + p_lay, & ! Pressure @ layer-centers (Pa) + tv_lay, & ! Virtual-temperature @ layer-centers (K) + relhum, & ! Relative-humidity @ layer-centers + p_lk ! Exner function @ layer-centers (1) + real(kind_phys), dimension(nCol, nLev, nTracer),intent(in) :: & + tracer ! trace gas concentrations + real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & + p_lev ! Pressure @ layer-interfaces (Pa) + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: spectral information for SW calculation + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: spectral information for LW calculation + + ! Outputs + real(kind_phys), dimension(nCol,NSPC1), intent(inout) :: & + aerodp ! Vertical integrated optical depth for various aerosol species + type(ty_optical_props_1scl),intent(out) :: & + lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) + integer, intent(out) :: & + errflg ! CCPP error flag + character(len=*), intent(out) :: & + errmsg ! CCPP error message + + ! Local variables + real(kind_phys), dimension(nCol, nLev, lw_gas_props%get_nband(), NF_AELW) :: & + aerosolslw ! + real(kind_phys), dimension(nCol, nLev, sw_gas_props%get_nband(), NF_AESW) :: & + aerosolssw + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile + call setaer(p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, lon, lat, ncol, nLev, & + nLev+1, .true., .true., aerosolssw, aerosolslw, aerodp) + + ! Allocate RRTMGP DDT: Aerosol optics [nCol,nlev,nBands] + call check_error_msg('rrtmgp_lw_aerosol_optics_run',lw_optical_props_aerosol%alloc_1scl( & + ncol, nlev, lw_gas_props%get_band_lims_wavenumber())) + + ! Copy aerosol optical information to RRTMGP DDT + lw_optical_props_aerosol%tau = aerosolslw(:,:,:,1) * (1. - aerosolslw(:,:,:,2)) + + end subroutine rrtmgp_lw_aerosol_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_aerosol_optics_finalize() + ! ######################################################################################### + subroutine rrtmgp_lw_aerosol_optics_finalize() + end subroutine rrtmgp_lw_aerosol_optics_finalize +end module rrtmgp_lw_aerosol_optics diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta new file mode 100644 index 000000000..ea123e236 --- /dev/null +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -0,0 +1,166 @@ +[ccpp-arg-table] + name = rrtmgp_lw_aerosol_optics_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracer] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lk] + 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 +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lsmask] + 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 +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[lon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + intent = in + type = ty_gas_optics_rrtmgp + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = inout + optional = F +[lw_optical_props_aerosol] + standard_name = longwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + 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 \ No newline at end of file diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 new file mode 100644 index 000000000..f9ee9b987 --- /dev/null +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -0,0 +1,374 @@ +module rrtmgp_lw_cloud_optics + use machine, only: kind_phys + use mo_rte_kind, only: wl + use mo_cloud_optics, only: ty_cloud_optics + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_optical_props, only: ty_optical_props_1scl + use mo_rrtmg_lw_cloud_optics, only: rrtmg_lw_cloud_optics + use rrtmgp_aux, only: check_error_msg + use netcdf + + public rrtmgp_lw_cloud_optics_init, rrtmgp_lw_cloud_optics_run, rrtmgp_lw_cloud_optics_finalize +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_init() + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_optics_init +!! \htmlinclude rrtmgp_lw_cloud_optics.html +!! + subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & + rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg) + + ! Inputs + integer, intent(inout) :: & + nrghice ! Number of ice-roughness categories + integer, intent(in) :: & + cld_optics_scheme, & ! Cloud-optics scheme + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_lw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties + + ! Outputs + type(ty_cloud_optics),intent(out) :: & + lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error code + + ! Variables that will be passed to cloud_optics%load() + ! cld_optics_scheme = 1 + real(kind_phys) :: & + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr, & ! Ice particle size lower bound for LUT interpolation + radice_fac ! Factor for calculating LUT interpolation indices for ice + real(kind_phys), dimension(:,:), allocatable :: & + lut_extliq, & ! LUT shortwave liquid extinction coefficient + lut_ssaliq, & ! LUT shortwave liquid single scattering albedo + lut_asyliq, & ! LUT shortwave liquid asymmetry parameter + band_lims ! Beginning and ending wavenumber [cm -1] for each band + real(kind_phys), dimension(:,:,:), allocatable :: & + lut_extice, & ! LUT shortwave ice extinction coefficient + lut_ssaice, & ! LUT shortwave ice single scattering albedo + lut_asyice ! LUT shortwave ice asymmetry parameter + ! cld_optics_scheme = 2 + real(kind_phys), dimension(:), allocatable :: & + pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaliq, & ! Particle size regime boundaries for shortwave liquid single + ! scattering albedo for Pade interpolation + pade_sizereg_asyliq, & ! Particle size regime boundaries for shortwave liquid asymmetry + ! parameter for Pade interpolation + pade_sizereg_extice, & ! Particle size regime boundaries for shortwave ice extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaice, & ! Particle size regime boundaries for shortwave ice single + ! scattering albedo for Pade interpolation + pade_sizereg_asyice ! Particle size regime boundaries for shortwave ice asymmetry + ! parameter for Pade interpolation + real(kind_phys), dimension(:,:,:), allocatable :: & + pade_extliq, & ! PADE coefficients for shortwave liquid extinction + pade_ssaliq, & ! PADE coefficients for shortwave liquid single scattering albedo + pade_asyliq ! PADE coefficients for shortwave liquid asymmetry parameter + real(kind_phys), dimension(:,:,:,:), allocatable :: & + pade_extice, & ! PADE coefficients for shortwave ice extinction + pade_ssaice, & ! PADE coefficients for shortwave ice single scattering albedo + pade_asyice ! PADE coefficients for shortwave ice asymmetry parameter + ! Dimensions + integer :: & + nrghice_fromfile, nBand, nSize_liq, nSize_ice, nSizeReg,& + nCoeff_ext, nCoeff_ssa_g, nBound, npairs + + ! Local variables + integer :: dimID,varID,status,ncid + character(len=264) :: lw_cloud_props_file + integer,parameter :: max_strlen=256, nrghice_default=2 + + ! Initialize + errmsg = '' + errflg = 0 + + if (cld_optics_scheme .eq. 0) return + + ! Filenames are set in the physics_nml + lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds) + + ! On master processor only... +! if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(lw_cloud_props_file), NF90_WRITE, ncid) + + ! Read dimensions + status = nf90_inq_dimid(ncid, 'nband', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBand) + status = nf90_inq_dimid(ncid, 'nrghice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfile) + status = nf90_inq_dimid(ncid, 'nsize_liq', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_liq) + status = nf90_inq_dimid(ncid, 'nsize_ice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_ice) + status = nf90_inq_dimid(ncid, 'nsizereg', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSizeReg) + status = nf90_inq_dimid(ncid, 'ncoeff_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ext) + status = nf90_inq_dimid(ncid, 'ncoeff_ssa_g', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ssa_g) + status = nf90_inq_dimid(ncid, 'nbound', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBound) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=npairs) + status = nf90_close(ncid) + + ! Has the number of ice-roughnesses to use been provided from the namelist? + ! If not provided, use default number of ice-roughness categories + if (nrghice .eq. 0) then + nrghice = nrghice_default + else + nrghice = nrghice_fromfile + ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. + if (nrghice .gt. nrghice_fromfile) then + errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using default number of categories.' + nrghice = nrghice_default + endif + endif + + ! Allocate space for arrays + if (cld_optics_scheme .eq. 1) then + allocate(lut_extliq(nSize_liq, nBand)) + allocate(lut_ssaliq(nSize_liq, nBand)) + allocate(lut_asyliq(nSize_liq, nBand)) + allocate(lut_extice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) + endif + if (cld_optics_scheme .eq. 2) then + allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) + allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice_fromfile)) + allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) + allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) + allocate(pade_sizereg_extliq(nBound)) + allocate(pade_sizereg_ssaliq(nBound)) + allocate(pade_sizereg_asyliq(nBound)) + allocate(pade_sizereg_extice(nBound)) + allocate(pade_sizereg_ssaice(nBound)) + allocate(pade_sizereg_asyice(nBound)) + endif + allocate(band_lims(2,nBand)) + + ! Read in fields from file + if (cld_optics_scheme .eq. 1) then + write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'lut_extliq',varID) + status = nf90_get_var(ncid,varID,lut_extliq) + status = nf90_inq_varid(ncid,'lut_ssaliq',varID) + status = nf90_get_var(ncid,varID,lut_ssaliq) + status = nf90_inq_varid(ncid,'lut_asyliq',varID) + status = nf90_get_var(ncid,varID,lut_asyliq) + status = nf90_inq_varid(ncid,'lut_extice',varID) + status = nf90_get_var(ncid,varID,lut_extice) + status = nf90_inq_varid(ncid,'lut_ssaice',varID) + status = nf90_get_var(ncid,varID,lut_ssaice) + status = nf90_inq_varid(ncid,'lut_asyice',varID) + status = nf90_get_var(ncid,varID,lut_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) + endif + if (cld_optics_scheme .eq. 2) then + write (*,*) 'Reading RRTMGP longwave cloud data (PADE) ... ' + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'pade_extliq',varID) + status = nf90_get_var(ncid,varID,pade_extliq) + status = nf90_inq_varid(ncid,'pade_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_ssaliq) + status = nf90_inq_varid(ncid,'pade_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_asyliq) + status = nf90_inq_varid(ncid,'pade_extice',varID) + status = nf90_get_var(ncid,varID,pade_extice) + status = nf90_inq_varid(ncid,'pade_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_ssaice) + status = nf90_inq_varid(ncid,'pade_asyice',varID) + status = nf90_get_var(ncid,varID,pade_asyice) + status = nf90_inq_varid(ncid,'pade_sizreg_extliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extliq) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaliq) + status = nf90_inq_varid(ncid,'pade_sizreg_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyliq) + status = nf90_inq_varid(ncid,'pade_sizreg_extice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extice) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaice) + status = nf90_inq_varid(ncid,'pade_sizreg_asyice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) + endif + + ! Close file + status = nf90_close(ncid) +! endif + + ! Load tables data for RRTMGP cloud-optics + if (cld_optics_scheme .eq. 1) then + call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims, & + radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & + lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) + endif + if (cld_optics_scheme .eq. 2) then + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_lims, & + pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& + pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & + pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) + endif + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%set_ice_roughness(nrghice)) + + end subroutine rrtmgp_lw_cloud_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_optics_run +!! \htmlinclude rrtmgp_lw_cloud_optics.html +!! + subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nrghice, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, p_lay, lw_cloud_props, lw_gas_props, lon, lat, & + cldtaulw, lw_optical_props_cloudsByBand, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Logical flag for longwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + nrghice, & ! Number of ice-roughness categories + cld_optics_scheme ! Cloud-optics scheme + real(kind_phys), dimension(nCol), intent(in) :: & + lon, & ! Longitude + lat ! Latitude + real(kind_phys), dimension(ncol,nLev),intent(in) :: & + p_lay, & ! Layer pressure (Pa) + cld_frac, & ! Total cloud fraction by layer + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effective radius + cld_swp, & ! Cloud snow water path (used only for RRTMG legacy scheme) + cld_resnow, & ! Cloud snow effective radius (used only for RRTMG legacy scheme) + cld_rwp, & ! Cloud rain water path (used only for RRTMG legacy scheme) + cld_rerain ! Cloud rain effective radius (used only for RRTMG legacy scheme) + type(ty_cloud_optics),intent(in) :: & + lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme + + ! Outputs + real(kind_phys), dimension(ncol,nLev), intent(out) :: & + cldtaulw ! Approx. 10.mu band layer cloud optical depth + type(ty_optical_props_1scl),intent(out) :: & + lw_optical_props_cloudsByBand ! RRTMGP DDT: longwave cloud optical properties in each band + integer, intent(out) :: & + errflg ! CCPP error flag + character(len=*), intent(out) :: & + errmsg ! CCPP error message + + ! Local variables + logical,dimension(ncol,nLev) :: liqmask, icemask + real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()) :: & + tau_cld + integer :: iCol, iLay + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + tau_cld = 0. + + if (.not. doLWrad) return + + ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics + liqmask = (cld_frac .gt. 0 .and. cld_lwp .gt. 0) + icemask = (cld_frac .gt. 0 .and. cld_iwp .gt. 0) + + ! Allocate space for RRTMGP DDTs containing cloud radiative properties + ! Cloud optics [nCol,nLev,nBands] + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_1scl(& + ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + + ! Compute cloud-optics for RTE. + if (rrtmgp_cld_optics .gt. 0) then + ! i) RRTMGP cloud-optics. + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_cloud_props%cloud_optics(& + !ncol, & ! IN - Number of horizontal gridpoints + !nLev, & ! IN - Number of vertical layers + !lw_cloud_props%get_nband(), & ! IN - Number of LW bands + !nrghice, & ! IN - Number of ice-roughness categories + !liqmask, & ! IN - Liquid-cloud mask (1) + !icemask, & ! IN - Ice-cloud mask (1) + cld_lwp, & ! IN - Cloud liquid water path (g/m2) + cld_iwp, & ! IN - Cloud ice water path (g/m2) + cld_reliq, & ! IN - Cloud liquid effective radius (microns) + cld_reice, & ! IN - Cloud ice effective radius (microns) + lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties + ! in each band + else + ! ii) RRTMG cloud-optics. + if (any(cld_frac .gt. 0)) then + call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & + cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & + cld_frac, tau_cld) + endif + lw_optical_props_cloudsByBand%tau = tau_cld + endif + + ! All-sky LW optical depth ~10microns + cldtaulw = lw_optical_props_cloudsByBand%tau(:,:,7) + + end subroutine rrtmgp_lw_cloud_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_finalize() + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_optics_finalize +!! \htmlinclude rrtmgp_lw_cloud_optics.html +!! + subroutine rrtmgp_lw_cloud_optics_finalize(mpicomm, mpirank, mpiroot) + ! Inputs + integer, intent(in) :: & + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank + + end subroutine rrtmgp_lw_cloud_optics_finalize +end module rrtmgp_lw_cloud_optics diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta new file mode 100644 index 000000000..bae5ef74f --- /dev/null +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -0,0 +1,309 @@ +[ccpp-arg-table] + name = rrtmgp_lw_cloud_optics_init + type = scheme +[cld_optics_scheme] + standard_name = rrtmgp_cloud_optics_flag + long_name = Flag to control which RRTMGP cloud-optics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nrghice] + standard_name = number_of_rrtmgp_ice_roughness + long_name = number of ice-roughness categories in RRTMGP calculation + units = count + dimensions = () + type = integer + intent = inout + optional = F +[rrtmgp_root_dir] + standard_name = directory_for_rte_rrtmgp_source_code + long_name = directory for rte+rrtmgp source code + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_lw_file_clouds] + standard_name = rrtmgp_coeff_lw_cloud_optics + long_name = file containing coefficients for RRTMGP LW cloud optics + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[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 +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + 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 +[lw_cloud_props] + standard_name = coefficients_for_lw_cloud_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_cloud_optics + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_lw_cloud_optics_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[cld_optics_scheme] + standard_name = rrtmgp_cloud_optics_flag + long_name = Flag to control which RRTMGP cloud-optics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nrghice] + standard_name = number_of_rrtmgp_ice_roughness + long_name = number of ice-roughness categories in RRTMGP calculation + units = count + dimensions = () + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_swp] + standard_name = cloud_snow_water_path + long_name = cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow flake + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain drop + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + intent = in + type = ty_gas_optics_rrtmgp + optional = F +[lw_cloud_props] + standard_name = coefficients_for_lw_cloud_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + intent = in + type = ty_cloud_optics + optional = F +[lon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cldtaulw] + standard_name = RRTMGP_cloud_optical_depth_layers_at_10mu_band + long_name = approx 10mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[lw_optical_props_cloudsByBand] + standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + 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 = rrtmgp_lw_cloud_optics_finalize + type = scheme +[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 +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in + optional = F \ No newline at end of file diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 new file mode 100644 index 000000000..51f512853 --- /dev/null +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -0,0 +1,126 @@ +module rrtmgp_lw_cloud_sampling + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use physparam, only: isubclw, iovrlw + use mo_optical_props, only: ty_optical_props_1scl + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mersenne_twister, only: random_setseed, random_number, random_stat + use rrtmgp_aux, only: check_error_msg + use netcdf + +contains + + ! ######################################################################################### + ! SUBROUTINE mcica_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_sampling_init +!! \htmlinclude rrtmgp_lw_cloud_sampling.html +!! + subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0) + ! Inputs + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: K-distribution data + ! Outputs + integer, intent(out) :: & + ipsdlw0 ! Initial permutation seed for McICA + + ! Set initial permutation seed for McICA, initially set to number of G-points + ipsdlw0 = lw_gas_props%get_ngpt() + + end subroutine rrtmgp_lw_cloud_sampling_init + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_lw_cloud_sampling_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_sampling_run +!! \htmlinclude rrtmgp_lw_cloud_sampling.html +!! + subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, cld_frac,& + lw_gas_props, lw_optical_props_cloudsByBand, lw_optical_props_clouds, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Logical flag for shortwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical layers + ipsdlw0 ! Initial permutation seed for McICA + integer,intent(in),dimension(ncol) :: & + icseed_lw ! auxiliary special cloud related array when module + ! variable isubclw=2, it provides permutation seed + ! for each column profile that are used for generating + ! random numbers. when isubclw /=2, it will not be used. + real(kind_phys), dimension(ncol,nLev),intent(in) :: & + cld_frac ! Total cloud fraction by layer + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: K-distribution data + type(ty_optical_props_1scl),intent(in) :: & + lw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_optical_props_1scl),intent(out) :: & + lw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + + ! Local variables + integer :: iCol + integer,dimension(ncol) :: ipseed_lw + type(random_stat) :: rng_stat + real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D + real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng1D + logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA + real(kind_phys), dimension(ncol,nLev) :: cld_frac_noSamp + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] + call check_error_msg('rrtmgp_lw_cloud_sampling_run',& + lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) + + ! Change random number seed value for each radiation invocation (isubclw =1 or 2). + if(isubclw == 1) then ! advance prescribed permutation seed + do iCol = 1, ncol + ipseed_lw(iCol) = ipsdlw0 + iCol + enddo + elseif (isubclw == 2) then ! use input array of permutaion seeds + do iCol = 1, ncol + ipseed_lw(iCol) = icseed_lw(iCol) + enddo + endif + + ! Call McICA to generate subcolumns. + ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points + ! and layers. ([nGpts,nLev,nColumn]-> [nGpts*nLev]*nColumn) + do iCol=1,ncol + call random_setseed(ipseed_lw(icol),rng_stat) + call random_number(rng1D,rng_stat) + rng3D(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) + enddo + + ! Call McICA + select case ( iovrlw ) + ! Maximumn-random + case(1) + call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + end select + + ! Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_lw_cloud_sampling_run',draw_samples(& + cldfracMCICA,lw_optical_props_cloudsByBand,lw_optical_props_clouds)) + + end subroutine rrtmgp_lw_cloud_sampling_run + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_lw_cloud_sampling_finalize() + ! ######################################################################################### + subroutine rrtmgp_lw_cloud_sampling_finalize() + end subroutine rrtmgp_lw_cloud_sampling_finalize + +end module rrtmgp_lw_cloud_sampling diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta new file mode 100644 index 000000000..547c6177c --- /dev/null +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -0,0 +1,114 @@ +[ccpp-arg-table] + name = rrtmgp_lw_cloud_sampling_init + type = scheme +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[ipsdlw0] + standard_name = initial_permutation_seed_lw + long_name = initial seed for McICA LW + units = none + dimensions = () + type = integer + intent = out + optional = F + +###################################################### +[ccpp-arg-table] + name = rrtmgp_lw_cloud_sampling_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ipsdlw0] + standard_name = initial_permutation_seed_lw + long_name = initial seed for McICA LW + units = none + dimensions = () + type = integer + intent = in + optional = F +[icseed_lw] + standard_name = seed_random_numbers_lw + long_name = seed for random number generation for longwave radiation + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[lw_optical_props_cloudsByBand] + standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = in + optional = F +[lw_optical_props_clouds] + standard_name = longwave_optical_properties_for_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + 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 \ No newline at end of file diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 new file mode 100644 index 000000000..b6300089f --- /dev/null +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -0,0 +1,402 @@ +module rrtmgp_lw_gas_optics + use machine, only: kind_phys + use mo_rte_kind, only: wl + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use mo_source_functions, only: ty_source_func_lw + use mo_optical_props, only: ty_optical_props_1scl + use mo_compute_bc, only: compute_bc + use rrtmgp_aux, only: check_error_msg + use netcdf +#ifdef MPI + use mpi +#endif + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_gas_optics_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_gas_optics_init +!! \htmlinclude rrtmgp_lw_gas_optics.html +!! + subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_nGases, & + active_gases_array, mpicomm, mpirank, mpiroot, lw_gas_props, errmsg, errflg) + + ! Inputs + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties + integer, intent(in) :: & + rrtmgp_nGases ! Number of trace gases active in RRTMGP + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + integer,intent(in) :: & + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_gas_optics_rrtmgp),intent(out) :: & + lw_gas_props ! RRTMGP DDT: longwave spectral information + + ! Variables that will be passed to gas_optics%load() + type(ty_gas_concs) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + integer, dimension(:), allocatable :: & + kminor_start_lower, & ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_lower\" (lower atmosphere) + kminor_start_upper ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_upper\" (upper atmosphere) + integer, dimension(:,:), allocatable :: & + band2gpt, & ! Beginning and ending gpoint for each band + minor_limits_gpt_lower, & ! Beginning and ending gpoint for each minor interval in lower atmosphere + minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:,:,:), allocatable :: & + key_species ! Key species pair for each band + real(kind_phys) :: & + press_ref_trop, & ! Reference pressure separating the lower and upper atmosphere [Pa] + temp_ref_p, & ! Standard spectroscopic reference pressure [Pa] + temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:), allocatable :: & + press_ref, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] + temp_ref ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] + real(kind_phys), dimension(:,:), allocatable :: & + band_lims, & ! Beginning and ending wavenumber [cm -1] for each band + totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:,:), allocatable :: & + vmr_ref, & ! volume mixing ratios for reference atmosphere + kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + kminor_upper, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + rayl_lower, & ! Not used in LW, rather allocated(rayl_lower) is used + rayl_upper ! Not used in LW, rather allocated(rayl_upper) is used + real(kind_phys), dimension(:,:,:,:), allocatable :: & + kmajor, & ! Stored absorption coefficients due to major absorbing gases + planck_frac ! Planck fractions + character(len=32), dimension(:), allocatable :: & + gas_names, & ! Names of absorbing gases + gas_minor, & ! Name of absorbing minor gas + identifier_minor, & ! Unique string identifying minor gas + minor_gases_lower, & ! Names of minor absorbing gases in lower atmosphere + minor_gases_upper, & ! Names of minor absorbing gases in upper atmosphere + scaling_gas_lower, & ! Absorption also depends on the concentration of this gas + scaling_gas_upper ! Absorption also depends on the concentration of this gas + logical(wl), dimension(:), allocatable :: & + minor_scales_with_density_lower, & ! Density scaling is applied to minor absorption coefficients + minor_scales_with_density_upper, & ! Density scaling is applied to minor absorption coefficients + scale_by_complement_lower, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + + ! Dimensions + integer :: & + ntemps, npress, ngpts, nabsorbers, nextrabsorbers, nminorabsorbers,& + nmixingfracs, nlayers, nbnds, npairs, ninternalSourcetemps, & + nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & + ncontributors_lower, ncontributors_upper + + ! Local variables + integer :: ncid, dimID, varID, status, iGas, ierr + integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4, & + temp_log_array1, temp_log_array2, temp_log_array3, temp_log_array4 + character(len=264) :: lw_gas_props_file +#ifdef MPI + integer :: mpierr +#endif + + ! Initialize + errmsg = '' + errflg = 0 + + write(*,"(a52,3i20)") 'rrtmgp_lw_gas_optics.F90:_init(): RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm + + ! Filenames are set in the physics_nml + lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas) + + ! On master processor only... + if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(lw_gas_props_file), NF90_WRITE, ncid) + + ! Read dimensions for k-distribution fields + status = nf90_inq_dimid(ncid, 'temperature', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ntemps) + status = nf90_inq_dimid(ncid, 'pressure', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = npress) + status = nf90_inq_dimid(ncid, 'absorber', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nabsorbers) + status = nf90_inq_dimid(ncid, 'minor_absorber', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nminorabsorbers) + status = nf90_inq_dimid(ncid, 'absorber_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nextrabsorbers) + status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nmixingfracs) + status = nf90_inq_dimid(ncid, 'atmos_layer', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nlayers) + status = nf90_inq_dimid(ncid, 'bnd', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nbnds) + status = nf90_inq_dimid(ncid, 'gpt', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ngpts) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = npairs) + status = nf90_inq_dimid(ncid, 'contributors_lower', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_lower) + status = nf90_inq_dimid(ncid, 'contributors_upper', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_upper) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_lower) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_upper) + status = nf90_inq_dimid(ncid, 'temperature_Planck', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ninternalSourcetemps) + + ! Allocate space for arrays + allocate(gas_names(nabsorbers)) + allocate(scaling_gas_lower(nminor_absorber_intervals_lower)) + allocate(scaling_gas_upper(nminor_absorber_intervals_upper)) + allocate(gas_minor(nminorabsorbers)) + allocate(identifier_minor(nminorabsorbers)) + allocate(minor_gases_lower(nminor_absorber_intervals_lower)) + allocate(minor_gases_upper(nminor_absorber_intervals_upper)) + allocate(minor_limits_gpt_lower(npairs,nminor_absorber_intervals_lower)) + allocate(minor_limits_gpt_upper(npairs,nminor_absorber_intervals_upper)) + allocate(band2gpt(2,nbnds)) + allocate(key_species(2,nlayers,nbnds)) + allocate(band_lims(2,nbnds)) + allocate(press_ref(npress)) + allocate(temp_ref(ntemps)) + allocate(vmr_ref(nlayers, nextrabsorbers, ntemps)) + allocate(kminor_lower(ncontributors_lower, nmixingfracs, ntemps)) + allocate(kmajor(ngpts, nmixingfracs, npress+1, ntemps)) + allocate(kminor_start_lower(nminor_absorber_intervals_lower)) + allocate(kminor_upper(ncontributors_upper, nmixingfracs, ntemps)) + allocate(kminor_start_upper(nminor_absorber_intervals_upper)) + allocate(minor_scales_with_density_lower(nminor_absorber_intervals_lower)) + allocate(minor_scales_with_density_upper(nminor_absorber_intervals_upper)) + allocate(scale_by_complement_lower(nminor_absorber_intervals_lower)) + allocate(scale_by_complement_upper(nminor_absorber_intervals_upper)) + allocate(temp1(nminor_absorber_intervals_lower)) + allocate(temp2(nminor_absorber_intervals_upper)) + allocate(temp3(nminor_absorber_intervals_lower)) + allocate(temp4(nminor_absorber_intervals_upper)) + allocate(totplnk(ninternalSourcetemps, nbnds)) + allocate(planck_frac(ngpts, nmixingfracs, npress+1, ntemps)) + + ! Read in fields from file + write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' + status = nf90_inq_varid(ncid, 'gas_names', varID) + status = nf90_get_var( ncid, varID, gas_names) + status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) + status = nf90_get_var( ncid, varID, scaling_gas_lower) + status = nf90_inq_varid(ncid, 'scaling_gas_upper', varID) + status = nf90_get_var( ncid, varID, scaling_gas_upper) + status = nf90_inq_varid(ncid, 'gas_minor', varID) + status = nf90_get_var( ncid, varID, gas_minor) + status = nf90_inq_varid(ncid, 'identifier_minor', varID) + status = nf90_get_var( ncid, varID, identifier_minor) + status = nf90_inq_varid(ncid, 'minor_gases_lower', varID) + status = nf90_get_var( ncid, varID, minor_gases_lower) + status = nf90_inq_varid(ncid, 'minor_gases_upper', varID) + status = nf90_get_var( ncid, varID, minor_gases_upper) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varID) + status = nf90_get_var( ncid, varID, minor_limits_gpt_lower) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varID) + status = nf90_get_var( ncid, varID, minor_limits_gpt_upper) + status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varID) + status = nf90_get_var( ncid, varID, band2gpt) + status = nf90_inq_varid(ncid, 'key_species', varID) + status = nf90_get_var( ncid, varID, key_species) + status = nf90_inq_varid(ncid, 'bnd_limits_wavenumber', varID) + status = nf90_get_var( ncid, varID, band_lims) + status = nf90_inq_varid(ncid, 'press_ref', varID) + status = nf90_get_var( ncid, varID, press_ref) + status = nf90_inq_varid(ncid, 'temp_ref', varID) + status = nf90_get_var( ncid, varID, temp_ref) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varID) + status = nf90_get_var( ncid, varID, temp_ref_p) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varID) + status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_inq_varid(ncid, 'press_ref_trop', varID) + status = nf90_get_var( ncid, varID, press_ref_trop) + status = nf90_inq_varid(ncid, 'kminor_lower', varID) + status = nf90_get_var( ncid, varID, kminor_lower) + status = nf90_inq_varid(ncid, 'kminor_upper', varID) + status = nf90_get_var( ncid, varID, kminor_upper) + status = nf90_inq_varid(ncid, 'vmr_ref', varID) + status = nf90_get_var( ncid, varID, vmr_ref) + status = nf90_inq_varid(ncid, 'kmajor', varID) + status = nf90_get_var( ncid, varID, kmajor) + status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) + status = nf90_get_var( ncid, varID, kminor_start_lower) + status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) + status = nf90_get_var( ncid, varID, kminor_start_upper) + status = nf90_inq_varid(ncid, 'totplnk', varID) + status = nf90_get_var( ncid, varID, totplnk) + status = nf90_inq_varid(ncid, 'plank_fraction', varID) + status = nf90_get_var( ncid, varID, planck_frac) + + ! Logical fields are read in as integers and then converted to logicals. + status = nf90_inq_varid(ncid, 'minor_scales_with_density_lower', varID) + status = nf90_get_var( ncid, varID,temp1) + minor_scales_with_density_lower(:) = .false. + where(temp1 .eq. 1) minor_scales_with_density_lower(:) = .true. + status = nf90_inq_varid(ncid, 'minor_scales_with_density_upper', varID) + status = nf90_get_var( ncid, varID,temp2) + minor_scales_with_density_upper(:) = .false. + where(temp2 .eq. 1) minor_scales_with_density_upper(:) = .true. + status = nf90_inq_varid(ncid, 'scale_by_complement_lower', varID) + status = nf90_get_var( ncid, varID,temp3) + scale_by_complement_lower(:) = .false. + where(temp3 .eq. 1) scale_by_complement_lower(:) = .true. + status = nf90_inq_varid(ncid, 'scale_by_complement_upper', varID) + status = nf90_get_var( ncid, varID,temp4) + scale_by_complement_upper(:) = .false. + where(temp4 .eq. 1) scale_by_complement_upper(:) = .true. + + ! Close file + status = nf90_close(ncid) + endif + +#ifdef MPI + ! Wait for processor 0 to catch up... + call MPI_BARRIER(mpicomm, mpierr) + ! Broadcast data + write (*,*) 'Broadcasting RRTMGP longwave k-distribution data ... ' + call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nextrabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ngpts, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ninternalSourcetemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BARRIER(mpicomm, mpierr) + call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BARRIER(mpicomm, mpierr) + call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(press_ref, size(press_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref, size(temp_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BARRIER(mpicomm, mpierr) + call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kmajor, size(kmajor), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref_p, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref_t, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(press_ref_trop, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BARRIER(mpicomm, mpierr) + call MPI_BCAST(totplnk, size(totplnk), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(planck_frac, size(planck_frac), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(gas_names, size(gas_names), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(gas_minor, size(gas_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(identifier_minor, size(identifier_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_gases_lower, size(minor_gases_lower), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BARRIER(mpicomm, mpierr) + call MPI_BCAST(minor_gases_upper, size(minor_gases_upper), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scale_by_complement_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_scales_with_density_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scale_by_complement_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + ! Don't advance until data broadcast complete on all processors + call MPI_BARRIER(mpicomm, mpierr) +#endif + + ! Initialize gas concentrations and gas optics class + call check_error_msg('lw_gas_optics_init',gas_concentrations%init(active_gases_array)) + call check_error_msg('lw_gas_optics_init',lw_gas_props%load(gas_concentrations, gas_names, & + key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & + temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & + scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, totplnk, planck_frac, rayl_lower, rayl_upper)) + + end subroutine rrtmgp_lw_gas_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_gas_optics_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_gas_optics_run +!! \htmlinclude rrtmgp_lw_gas_optics.html +!! + subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_lev, t_lay,& + t_lev, skt, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Flag to calculate LW irradiances + integer,intent(in) :: & + ncol, & ! Number of horizontal points + nLev ! Number of vertical levels + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: + real(kind_phys), dimension(ncol,nLev), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & + p_lev, & ! Pressure @ model layer-interfaces (hPa) + t_lev ! Temperature @ model levels + real(kind_phys), dimension(ncol), intent(in) :: & + skt ! Surface(skin) temperature (K) + type(ty_gas_concs),intent(in) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + + ! Output + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_optical_props_1scl),intent(out) :: & + lw_optical_props_clrsky ! RRTMGP DDT: longwave clear-sky radiative properties + type(ty_source_func_lw),intent(out) :: & + sources ! RRTMGP DDT: longwave source functions + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! Allocate and initialize + call check_error_msg('rrtmgp_lw_gas_optics_run',lw_optical_props_clrsky%alloc_1scl(ncol, nLev, lw_gas_props)) + call check_error_msg('rrtmgp_lw_gas_optics_run',sources%alloc(ncol, nLev, lw_gas_props)) + + ! Gas-optics + call check_error_msg('rrtmgp_lw_gas_optics_run',lw_gas_props%gas_optics(& + p_lay, & ! IN - Pressure @ layer-centers (Pa) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + t_lay, & ! IN - Temperature @ layer-centers (K) + skt, & ! IN - Skin-temperature (K) + gas_concentrations, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + lw_optical_props_clrsky, & ! OUT - RRTMGP DDT: longwave optical properties + sources, & ! OUT - RRTMGP DDT: source functions + tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) + + end subroutine rrtmgp_lw_gas_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_gas_optics_finalize + ! ######################################################################################### + subroutine rrtmgp_lw_gas_optics_finalize() + end subroutine rrtmgp_lw_gas_optics_finalize + +end module rrtmgp_lw_gas_optics diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta new file mode 100644 index 000000000..36b8067dd --- /dev/null +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -0,0 +1,210 @@ +[ccpp-arg-table] + name = rrtmgp_lw_gas_optics_init + type = scheme +[rrtmgp_root_dir] + standard_name = directory_for_rte_rrtmgp_source_code + long_name = directory for rte+rrtmgp source code + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_lw_file_gas] + standard_name = rrtmgp_kdistribution_lw + long_name = file containing RRTMGP LW k-distribution + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP + units = count + dimensions = () + type = integer + intent = in + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + 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 +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + 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 +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_lw_gas_optics_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = flag to calculate LW irradiances + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature layer + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lev] + standard_name = air_temperature_at_interface_for_RRTMGP + long_name = air temperature level + units = K + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[skt] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gas_concentrations] + standard_name = Gas_concentrations_for_RRTMGP_suite + long_name = DDT containing gas concentrations for RRTMGP radiation scheme + units = DDT + dimensions = () + type = ty_gas_concs + intent = in + optional = F +[lw_optical_props_clrsky] + standard_name = longwave_optical_properties_for_clear_sky + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = out + optional = F +[sources] + standard_name = longwave_source_function + long_name = Fortran DDT containing RRTMGP source functions + units = DDT + dimensions = () + type = ty_source_func_lw + 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 diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 new file mode 100644 index 000000000..0be239671 --- /dev/null +++ b/physics/rrtmgp_lw_pre.F90 @@ -0,0 +1,86 @@ +module rrtmgp_lw_pre + use physparam + use machine, only: & + kind_phys ! Working type + use GFS_typedefs, only: & + GFS_control_type, & ! + GFS_sfcprop_type, & ! Surface fields + GFS_grid_type, & ! Grid and interpolation related data + GFS_statein_type, & ! + GFS_radtend_type ! Radiation tendencies needed in physics + use module_radiation_surface, only: & + setemis ! Routine to compute surface-emissivity + use mo_gas_optics_rrtmgp, only: & + ty_gas_optics_rrtmgp + + public rrtmgp_lw_pre_run,rrtmgp_lw_pre_init,rrtmgp_lw_pre_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_pre_init + ! ######################################################################################### + subroutine rrtmgp_lw_pre_init () + end subroutine rrtmgp_lw_pre_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_pre_run + ! ######################################################################################### +!> \section arg_table_rrtmgp_lw_pre_run +!! \htmlinclude rrtmgp_lw_pre.html +!! + subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, tsfc, & + hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Logical flag for longwave radiation call + integer, intent(in) :: & + nCol ! Number of horizontal grid points + real(kind_phys), dimension(nCol), intent(in) :: & + xlon, & ! Longitude + xlat, & ! Latitude + slmsk, & ! Land/sea/sea-ice mask + zorl, & ! Surface roughness length (cm) + snowd, & ! water equivalent snow depth (mm) + sncovr, & ! Surface snow are fraction (1) + tsfc, & ! Surface skin temperature (K) + hprime ! Standard deviation of subgrid orography + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: spectral information for LW calculation + + ! Outputs + real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(out) :: & + sfc_emiss_byband ! Surface emissivity in each band + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + real(kind_phys), dimension(nCol), intent(out) :: & + semis + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! ####################################################################################### + ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. + ! ####################################################################################### + call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfc, tsfc, hprime, nCol, semis) + + ! Assign same emissivity to all bands + do iBand=1,lw_gas_props%get_nband() + sfc_emiss_byband(iBand,:) = semis + enddo + + end subroutine rrtmgp_lw_pre_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_pre_finalize + ! ######################################################################################### + subroutine rrtmgp_lw_pre_finalize () + end subroutine rrtmgp_lw_pre_finalize + +end module rrtmgp_lw_pre diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta new file mode 100644 index 000000000..5d1c518b6 --- /dev/null +++ b/physics/rrtmgp_lw_pre.meta @@ -0,0 +1,134 @@ +[ccpp-arg-table] + name = rrtmgp_lw_pre_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + 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 + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + 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 +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + 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 = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[semis] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_emiss_byband] + standard_name = surface_emissivity_in_each_RRTMGP_LW_band + long_name = surface emissivity in each RRTMGP LW band + units = none + dimensions = (number_of_lw_bands_rrtmgp,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 diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 new file mode 100644 index 000000000..94c9b741e --- /dev/null +++ b/physics/rrtmgp_lw_rte.F90 @@ -0,0 +1,172 @@ +! ########################################################################################### +! ########################################################################################### +module rrtmgp_lw_rte + use machine, only: kind_phys + use mo_rte_kind, only: wl + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_cloud_optics, only: ty_cloud_optics + use mo_optical_props, only: ty_optical_props_1scl + use mo_rte_lw, only: rte_lw + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_source_functions, only: ty_source_func_lw + use rrtmgp_aux, only: check_error_msg + + public rrtmgp_lw_rte_init, rrtmgp_lw_rte_run, rrtmgp_lw_rte_finalize +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_rte_init + ! ######################################################################################### + subroutine rrtmgp_lw_rte_init() + end subroutine rrtmgp_lw_rte_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_rte_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_rte_run +!! \htmlinclude rrtmgp_lw_rte.html +!! + subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, & + sfc_emiss_byband, sources, lw_optical_props_clrsky, lw_optical_props_clouds, & + lw_optical_props_aerosol, secdiff, nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky,& + fluxlwUP_clrsky, fluxlwDOWN_clrsky, hlw0, hlwb, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Logical flag for longwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + nGauss_angles ! Number of angles used in Gaussian quadrature + real(kind_phys), dimension(ncol,nLev), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (hPa) + real(kind_phys), dimension(ncol), intent(in) :: & + skt ! Surface(skin) temperature (K) + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: longwave spectral information + real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(in) :: & + sfc_emiss_byband ! Surface emissivity in each band + type(ty_source_func_lw),intent(in) :: & + sources ! RRTMGP DDT: longwave source functions + type(ty_optical_props_1scl),intent(inout) :: & + lw_optical_props_clrsky ! RRTMGP DDT: longwave clear-sky radiative properties + type(ty_optical_props_1scl),intent(in) :: & + lw_optical_props_clouds, & ! RRTMGP DDT: longwave cloud radiative properties + lw_optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties + real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(in) :: & + secdiff + ! Outputs + real(kind_phys), dimension(ncol,nLev+1), intent(out) :: & + fluxlwUP_allsky, & ! All-sky flux (W/m2) + fluxlwDOWN_allsky, & ! All-sky flux (W/m2) + fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) + fluxlwDOWN_clrsky ! All-sky flux (W/m2) + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + ! Outputs (optional) + real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()), optional, intent(inout) :: & + hlwb ! All-sky heating rate, by band (K/sec) + real(kind_phys), dimension(ncol,nLev), optional, intent(inout) :: & + hlw0 ! Clear-sky heating rate (K/sec) + + ! Local variables + integer :: & + iCol, iBand, iLay + type(ty_fluxes_byband) :: & + flux_allsky, flux_clrsky + real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & + fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky + logical :: & + l_ClrSky_HR, l_AllSky_HR_byband, top_at_1 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! Vertical ordering? + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + + ! Are any optional outputs requested? Need to know now to compute correct fluxes. + l_ClrSky_HR = present(hlw0) + l_AllSky_HR_byband = present(hlwb) + + ! Initialize RRTMGP DDT containing 2D(3D) fluxes + flux_allsky%bnd_flux_up => fluxLW_up_allsky + flux_allsky%bnd_flux_dn => fluxLW_dn_allsky + flux_clrsky%bnd_flux_up => fluxLW_up_clrsky + flux_clrsky%bnd_flux_dn => fluxLW_dn_clrsky + + ! + ! Compute clear-sky fluxes (if requested) + ! + ! Add aerosol optics to gas optics + call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) + + ! Apply diffusivity angle adjustment (RRTMG legacy) + do iCol=1,nCol + do iBand=1,lw_gas_props%get_nband() + lw_optical_props_clrsky%tau(iCol,1:nLev,iBand) = lw_optical_props_clrsky%tau(iCol,1:nLev,iBand)*secdiff(iBand,iCol) + enddo + enddo + + ! Call RTE solver + if (l_ClrSky_HR) then + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles)) + ! Store fluxes + fluxlwUP_clrsky = sum(flux_clrsky%bnd_flux_up,dim=3) + fluxlwDOWN_clrsky = sum(flux_clrsky%bnd_flux_dn,dim=3) + endif + + ! + ! All-sky fluxes + ! + + ! Apply diffusivity angle adjustment (RRTMG legacy) + !do iCol=1,nCol + ! do iBand=1,lw_gas_props%get_nband() + ! lw_optical_props_clouds%tau(iCol,1:nLev,iBand) = lw_optical_props_clouds%tau(iCol,1:nLev,iBand)*secdiff(iBand,iCol) + ! enddo + !enddo + ! Add cloud optics to clear-sky optics + call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) + + ! Call RTE solver + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) + ! Store fluxes + fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) + fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) + + ! Only output fluxes by-band when heating-rate profiles by band are requested. + !if (l_AllSky_HR_byband) then + !endif + + end subroutine rrtmgp_lw_rte_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_rte_finalize + ! ######################################################################################### + subroutine rrtmgp_lw_rte_finalize() + end subroutine rrtmgp_lw_rte_finalize + + +end module rrtmgp_lw_rte diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta new file mode 100644 index 000000000..e85a607fa --- /dev/null +++ b/physics/rrtmgp_lw_rte.meta @@ -0,0 +1,200 @@ +[ccpp-arg-table] + name = rrtmgp_lw_rte_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nGauss_angles] + standard_name = number_of_angles_used_in_gaussian_quadrature + long_name = Number of angles used in Gaussian quadrature + units = count + dimensions = () + type = integer + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature layer + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[skt] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_emiss_byband] + standard_name = surface_emissivity_in_each_RRTMGP_LW_band + long_name = surface emissivity in each RRTMGP LW band + units = none + dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[lw_optical_props_clrsky] + standard_name = longwave_optical_properties_for_clear_sky + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = inout + optional = F +[lw_optical_props_clouds] + standard_name = longwave_optical_properties_for_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = in + optional = F +[lw_optical_props_aerosol] + standard_name = longwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = in + optional = F +[sources] + standard_name = longwave_source_function + long_name = Fortran DDT containing RRTMGP source functions + units = DDT + dimensions = () + type = ty_source_func_lw + intent = in + optional = F +[hlw0] + standard_name = RRTMGP_lw_heating_rate_clear_sky + long_name = RRTMGP longwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[hlwb] + standard_name = RRTMGP_lw_heating_rate_spectral + long_name = RRTMGP longwave total sky heating rate (spectral) + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_lw_spectral_points_rrtmgp) + type = real + kind = kind_phys + intent = in + optional = T +[secdiff] + standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band + long_name = secant of diffusivity angle in each RRTMGP LW band + units = none + dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP_allsky] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[fluxlwDOWN_allsky] + standard_name = RRTMGP_lw_flux_profile_downward_allsky + long_name = RRTMGP downward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[fluxlwUP_clrsky] + standard_name = RRTMGP_lw_flux_profile_upward_clrsky + long_name = RRTMGP upward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[fluxlwDOWN_clrsky] + standard_name = RRTMGP_lw_flux_profile_downward_clrsky + long_name = RRTMGP downward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + 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 diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 new file mode 100644 index 000000000..d6413c368 --- /dev/null +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -0,0 +1,115 @@ +module rrtmgp_sw_aerosol_optics + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_optical_props, only: ty_optical_props_2str + use rrtmgp_aux, only: check_error_msg + use module_radiation_aerosols, only: & + NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) + NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) + setaer, & ! Routine to compute aerosol radiative properties (tau,g,omega) + NSPC1 ! Number of species for vertically integrated aerosol optical-depth + use netcdf + + public rrtmgp_sw_aerosol_optics_init, rrtmgp_sw_aerosol_optics_run, rrtmgp_sw_aerosol_optics_finalize +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_aerosol_optics_init() + ! ######################################################################################### + subroutine rrtmgp_sw_aerosol_optics_init() + end subroutine rrtmgp_sw_aerosol_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_aerosol_optics_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_aerosol_optics_run +!! \htmlinclude rrtmgp_sw_aerosol_optics.html +!! + subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxday, p_lev,& + p_lay, p_lk, tv_lay, relhum, lsmask, tracer, lon, lat, lw_gas_props, sw_gas_props, & + aerodp, sw_optical_props_aerosol, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Logical flag for shortwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nDay, & ! Number of daylit points + nLev, & ! Number of vertical layers + nTracer ! Number of tracers + integer,intent(in),dimension(nCol) :: & + idxday ! Indices for daylit points. + real(kind_phys), dimension(nCol), intent(in) :: & + lon, & ! Longitude + lat, & ! Latitude + lsmask ! Land/sea/sea-ice mask + real(kind_phys), dimension(nCol,Nlev),intent(in) :: & + p_lay, & ! Pressure @ layer-centers (Pa) + tv_lay, & ! Virtual-temperature @ layer-centers (K) + relhum, & ! Relative-humidity @ layer-centers + p_lk ! Exner function @ layer-centers (1) + real(kind_phys), dimension(nCol, nLev, nTracer),intent(in) :: & + tracer ! trace gas concentrations + real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & + p_lev ! Pressure @ layer-interfaces (Pa) + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: spectral information for SW calculation + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: spectral information for LW calculation + + ! Outputs + real(kind_phys), dimension(nCol,NSPC1), intent(inout) :: & + aerodp ! Vertical integrated optical depth for various aerosol species + type(ty_optical_props_2str),intent(out) :: & + sw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) + integer, intent(out) :: & + errflg ! CCPP error flag + character(len=*), intent(out) :: & + errmsg ! CCPP error message + + ! Local variables + real(kind_phys), dimension(nCol, nLev, lw_gas_props%get_nband(), NF_AELW) :: & + aerosolslw ! + real(kind_phys), dimension(nCol, nLev, sw_gas_props%get_nband(), NF_AESW) :: & + aerosolssw, aerosolssw2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + if (nDay .gt. 0) then + + ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile + call setaer(p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, lon, lat, nCol, nLev, & + nLev+1, .true., .true., aerosolssw2, aerosolslw, aerodp) + + ! Store aerosol optical properties + ! SW. + ! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the + ! band ordering was [nIR -> UV -> IR(band)] + aerosolssw(1:nCol,:,1,1) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),1) + aerosolssw(1:nCol,:,1,2) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),2) + aerosolssw(1:nCol,:,1,3) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),3) + aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),1) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,1) + aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),2) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,2) + aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),3) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,3) + + ! Allocate RRTMGP DDT: Aerosol optics [nCol,nlev,nBands] + call check_error_msg('rrtmgp_sw_aerosol_optics_run',sw_optical_props_aerosol%alloc_2str( & + nDay, nlev, sw_gas_props%get_band_lims_wavenumber())) + + ! Copy aerosol optical information to RRTMGP DDT + sw_optical_props_aerosol%tau = aerosolssw(idxday(1:nday),:,:,1) + sw_optical_props_aerosol%ssa = aerosolssw(idxday(1:nday),:,:,2) + sw_optical_props_aerosol%g = aerosolssw(idxday(1:nday),:,:,3) + endif + + end subroutine rrtmgp_sw_aerosol_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_aerosol_optics_finalize() + ! ######################################################################################### + subroutine rrtmgp_sw_aerosol_optics_finalize() + end subroutine rrtmgp_sw_aerosol_optics_finalize +end module rrtmgp_sw_aerosol_optics diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta new file mode 100644 index 000000000..20240327f --- /dev/null +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -0,0 +1,182 @@ +[ccpp-arg-table] + name = rrtmgp_sw_aerosol_optics_run + type = scheme +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracer] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lk] + 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 +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lsmask] + 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 +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[lon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + intent = in + type = ty_gas_optics_rrtmgp + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = inout + optional = F +[sw_optical_props_aerosol] + standard_name = shortwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + 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 \ No newline at end of file diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 new file mode 100644 index 000000000..99dcef2a5 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -0,0 +1,367 @@ +module rrtmgp_sw_cloud_optics + use machine, only: kind_phys + use mo_rte_kind, only: wl + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_cloud_optics, only: ty_cloud_optics + use physparam, only: isubcsw, iovrsw + use mo_optical_props, only: ty_optical_props_2str + use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics + use rrtmgp_aux, only: check_error_msg + use netcdf + + public rrtmgp_sw_cloud_optics_init, rrtmgp_sw_cloud_optics_run, rrtmgp_sw_cloud_optics_finalize +contains + ! ######################################################################################### + ! SUBROUTINE sw_cloud_optics_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_cloud_optics_init +!! \htmlinclude rrtmgp_lw_cloud_optics.html +!! + subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & + rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, sw_cloud_props, errmsg, errflg) + + ! Inputs + integer, intent(inout) :: & + nrghice ! Number of ice-roughness categories + integer, intent(in) :: & + cld_optics_scheme, & ! Cloud-optics scheme + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_sw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties + + ! Outputs + type(ty_cloud_optics),intent(out) :: & + sw_cloud_props ! RRTMGP DDT: shortwave spectral information + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + + ! Variables that will be passed to cloud_optics%load() + ! cld_optics_scheme = 1 + real(kind_phys) :: & + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr, & ! Ice particle size lower bound for LUT interpolation + radice_fac ! Factor for calculating LUT interpolation indices for ice + real(kind_phys), dimension(:,:), allocatable :: & + lut_extliq, & ! LUT shortwave liquid extinction coefficient + lut_ssaliq, & ! LUT shortwave liquid single scattering albedo + lut_asyliq, & ! LUT shortwave liquid asymmetry parameter + band_lims ! Beginning and ending wavenumber [cm -1] for each band + real(kind_phys), dimension(:,:,:), allocatable :: & + lut_extice, & ! LUT shortwave ice extinction coefficient + lut_ssaice, & ! LUT shortwave ice single scattering albedo + lut_asyice ! LUT shortwave ice asymmetry parameter + ! cld_optics_scheme = 2 + real(kind_phys), dimension(:), allocatable :: & + pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaliq, & ! Particle size regime boundaries for shortwave liquid single + ! scattering albedo for Pade interpolation + pade_sizereg_asyliq, & ! Particle size regime boundaries for shortwave liquid asymmetry + ! parameter for Pade interpolation + pade_sizereg_extice, & ! Particle size regime boundaries for shortwave ice extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaice, & ! Particle size regime boundaries for shortwave ice single + ! scattering albedo for Pade interpolation + pade_sizereg_asyice ! Particle size regime boundaries for shortwave ice asymmetry + ! parameter for Pade interpolation + real(kind_phys), dimension(:,:,:), allocatable :: & + pade_extliq, & ! PADE coefficients for shortwave liquid extinction + pade_ssaliq, & ! PADE coefficients for shortwave liquid single scattering albedo + pade_asyliq ! PADE coefficients for shortwave liquid asymmetry parameter + real(kind_phys), dimension(:,:,:,:), allocatable :: & + pade_extice, & ! PADE coefficients for shortwave ice extinction + pade_ssaice, & ! PADE coefficients for shortwave ice single scattering albedo + pade_asyice ! PADE coefficients for shortwave ice asymmetry parameter + ! Dimensions + integer :: & + nrghice_fromfile, nBand, nSize_liq, nSize_ice, nSizereg,& + nCoeff_ext, nCoeff_ssa_g, nBound, nPairs + + ! Local variables + integer :: status,ncid,dimid,varID + character(len=264) :: sw_cloud_props_file + integer,parameter :: nrghice_default=2 + + ! Initialize + errmsg = '' + errflg = 0 + + if (cld_optics_scheme .eq. 0) return + + ! Filenames are set in the physics_nml + sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds) + + ! On master processor only... +! if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(sw_cloud_props_file), NF90_WRITE, ncid) + + ! Read dimensions + status = nf90_inq_dimid(ncid, 'nband', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBand) + status = nf90_inq_dimid(ncid, 'nrghice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfile) + status = nf90_inq_dimid(ncid, 'nsize_liq', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_liq) + status = nf90_inq_dimid(ncid, 'nsize_ice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_ice) + status = nf90_inq_dimid(ncid, 'nsizereg', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSizereg) + status = nf90_inq_dimid(ncid, 'ncoeff_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ext) + status = nf90_inq_dimid(ncid, 'ncoeff_ssa_g', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ssa_g) + status = nf90_inq_dimid(ncid, 'nbound', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBound) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nPairs) + + ! Has the number of ice-roughnesses to use been provided from the namelist? + ! If not provided, use default number of ice-roughness categories + if (nrghice .eq. 0) then + nrghice = nrghice_default + else + nrghice = nrghice_fromfile + ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. + if (nrghice .gt. nrghice_fromfile) then + errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using default number of categories.' + nrghice = nrghice_default + endif + endif + + ! Allocate space for arrays + if (cld_optics_scheme .eq. 1) then + allocate(lut_extliq(nSize_liq, nBand)) + allocate(lut_ssaliq(nSize_liq, nBand)) + allocate(lut_asyliq(nSize_liq, nBand)) + allocate(lut_extice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) + endif + if (cld_optics_scheme .eq. 2) then + allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) + allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice_fromfile)) + allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) + allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) + allocate(pade_sizereg_extliq(nBound)) + allocate(pade_sizereg_ssaliq(nBound)) + allocate(pade_sizereg_asyliq(nBound)) + allocate(pade_sizereg_extice(nBound)) + allocate(pade_sizereg_ssaice(nBound)) + allocate(pade_sizereg_asyice(nBound)) + endif + allocate(band_lims(2,nBand)) + + ! Read in fields from file + if (cld_optics_scheme .eq. 1) then + write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'lut_extliq',varID) + status = nf90_get_var(ncid,varID,lut_extliq) + status = nf90_inq_varid(ncid,'lut_ssaliq',varID) + status = nf90_get_var(ncid,varID,lut_ssaliq) + status = nf90_inq_varid(ncid,'lut_asyliq',varID) + status = nf90_get_var(ncid,varID,lut_asyliq) + status = nf90_inq_varid(ncid,'lut_extice',varID) + status = nf90_get_var(ncid,varID,lut_extice) + status = nf90_inq_varid(ncid,'lut_ssaice',varID) + status = nf90_get_var(ncid,varID,lut_ssaice) + status = nf90_inq_varid(ncid,'lut_asyice',varID) + status = nf90_get_var(ncid,varID,lut_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) + endif + if (cld_optics_scheme .eq. 2) then + write (*,*) 'Reading RRTMGP shortwave cloud data (PADE) ... ' + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'pade_extliq',varID) + status = nf90_get_var(ncid,varID,pade_extliq) + status = nf90_inq_varid(ncid,'pade_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_ssaliq) + status = nf90_inq_varid(ncid,'pade_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_asyliq) + status = nf90_inq_varid(ncid,'pade_extice',varID) + status = nf90_get_var(ncid,varID,pade_extice) + status = nf90_inq_varid(ncid,'pade_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_ssaice) + status = nf90_inq_varid(ncid,'pade_asyice',varID) + status = nf90_get_var(ncid,varID,pade_asyice) + status = nf90_inq_varid(ncid,'pade_sizreg_extliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extliq) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaliq) + status = nf90_inq_varid(ncid,'pade_sizreg_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyliq) + status = nf90_inq_varid(ncid,'pade_sizreg_extice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extice) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaice) + status = nf90_inq_varid(ncid,'pade_sizreg_asyice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) + endif + + ! Close file + status = nf90_close(ncid) +! endif + + ! Load tables data for RRTMGP cloud-optics + if (cld_optics_scheme .eq. 1) then + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_lims, & + radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & + lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) + endif + if (cld_optics_scheme .eq. 2) then + call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_lims, & + pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& + pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & + pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) + endif + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) + end subroutine rrtmgp_sw_cloud_optics_init + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_optics_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_cloud_optics_run +!! \htmlinclude rrtmgp_sw_cloud_optics.html +!! + subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice, & + cld_optics_scheme, cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, & + cld_resnow, cld_rwp, cld_rerain, sw_cloud_props, sw_gas_props, & + sw_optical_props_cloudsByBand, cldtausw, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Logical flag for shortwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + nday, & ! Number of daylit points. + nrghice, & ! Number of ice-roughness categories + cld_optics_scheme ! Cloud-optics scheme + integer,intent(in),dimension(ncol) :: & + idxday ! Indices for daylit points. + real(kind_phys), dimension(ncol,nLev),intent(in) :: & + cld_frac, & ! Total cloud fraction by layer + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effective radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain ! Cloud rain effective radius + type(ty_cloud_optics),intent(in) :: & + sw_cloud_props ! RRTMGP DDT: shortwave cloud properties + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: shortwave K-distribution data + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_optical_props_2str),intent(out) :: & + sw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + real(kind_phys), dimension(ncol,NLev), intent(out) :: & + cldtausw ! approx 10.mu band layer cloud optical depth + + ! Local variables + logical,dimension(nday,nLev) :: liqmask, icemask + real(kind_phys), dimension(nday,nLev,sw_gas_props%get_nband()) :: & + tau_cld, ssa_cld, asy_cld + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + if (nDay .gt. 0) then + + ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics + liqmask = (cld_frac(idxday(1:nday),:) .gt. 0 .and. cld_lwp(idxday(1:nday),:) .gt. 0) + icemask = (cld_frac(idxday(1:nday),:) .gt. 0 .and. cld_iwp(idxday(1:nday),:) .gt. 0) + + ! Allocate space for RRTMGP DDTs containing cloud radiative properties + ! Cloud optics [nday,nLev,nBands] + call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_cloudsByBand%alloc_2str(& + nday, nLev, sw_gas_props%get_band_lims_wavenumber())) + sw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + sw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys + sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys + + ! Compute cloud-optics for RTE. + if (cld_optics_scheme .gt. 0) then + ! RRTMGP cloud-optics. + call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_cloud_props%cloud_optics(& + cld_lwp(idxday(1:nday),:), & ! IN - Cloud liquid water path + cld_iwp(idxday(1:nday),:), & ! IN - Cloud ice water path + cld_reliq(idxday(1:nday),:), & ! IN - Cloud liquid effective radius + cld_reice(idxday(1:nday),:), & ! IN - Cloud ice effective radius + sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, + ! in each band (tau,ssa,g) + else + ! RRTMG cloud-optics + tau_cld(:,:,:) = 0._kind_phys + ssa_cld(:,:,:) = 0._kind_phys + asy_cld(:,:,:) = 0._kind_phys + if (any(cld_frac .gt. 0)) then + call rrtmg_sw_cloud_optics(nday, nLev, sw_gas_props%get_nband(), & + cld_lwp(idxday(1:nday),:), cld_reliq(idxday(1:nday),:), & + cld_iwp(idxday(1:nday),:), cld_reice(idxday(1:nday),:), & + cld_rwp(idxday(1:nday),:), cld_rerain(idxday(1:nday),:), & + cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & + cld_frac(idxday(1:nday),:), tau_cld, ssa_cld, asy_cld) + endif + sw_optical_props_cloudsByBand%tau(:,:,:) = tau_cld + sw_optical_props_cloudsByBand%ssa(:,:,:) = ssa_cld + sw_optical_props_cloudsByBand%g(:,:,:) = asy_cld + endif + + ! All-sky SW optical depth ~0.55microns + cldtausw(idxday(1:nDay),:) = sw_optical_props_cloudsByBand%tau(:,:,11) + endif + + end subroutine rrtmgp_sw_cloud_optics_run + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_optics_finalize() + ! ######################################################################################### + subroutine rrtmgp_sw_cloud_optics_finalize() + end subroutine rrtmgp_sw_cloud_optics_finalize + +end module rrtmgp_sw_cloud_optics diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta new file mode 100644 index 000000000..c60ae90d6 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -0,0 +1,278 @@ +[ccpp-arg-table] + name = rrtmgp_sw_cloud_optics_init + type = scheme +[cld_optics_scheme] + standard_name = rrtmgp_cloud_optics_flag + long_name = Flag to control which RRTMGP cloud-optics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nrghice] + standard_name = number_of_rrtmgp_ice_roughness + long_name = number of ice-roughness categories in RRTMGP calculation + units = count + dimensions = () + type = integer + intent = inout + optional = F +[rrtmgp_root_dir] + standard_name = directory_for_rte_rrtmgp_source_code + long_name = directory for rte+rrtmgp source code + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_sw_file_clouds] + standard_name = rrtmgp_coeff_sw_cloud_optics + long_name = file containing coefficients for RRTMGP SW cloud optics + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[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 +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + 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 +[sw_cloud_props] + standard_name = coefficients_for_sw_cloud_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_cloud_optics + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_sw_cloud_optics_run + type = scheme +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[cld_optics_scheme] + standard_name = rrtmgp_cloud_optics_flag + long_name = Flag to control which RRTMGP cloud-optics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nrghice] + standard_name = number_of_rrtmgp_ice_roughness + long_name = number of ice-roughness categories in RRTMGP calculation + units = count + dimensions = () + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sw_cloud_props] + standard_name = coefficients_for_sw_cloud_optics + long_name = DDT containing spectral information for cloudy RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_cloud_optics + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[sw_optical_props_cloudsByBand] + standard_name = shortwave_optical_properties_for_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = out + optional = F +[cldtausw] + standard_name = RRTMGP_cloud_optical_depth_layers_at_0_55mu_band + long_name = approx .55mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,vertical_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 diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 new file mode 100644 index 000000000..cc998b755 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -0,0 +1,133 @@ +module rrtmgp_sw_cloud_sampling + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use physparam, only: isubcsw, iovrsw + use mo_optical_props, only: ty_optical_props_2str + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mersenne_twister, only: random_setseed, random_number, random_stat + use rrtmgp_aux, only: check_error_msg + use netcdf + +contains + + ! ######################################################################################### + ! SUBROUTINE mcica_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_cloud_sampling_init +!! \htmlinclude rrtmgp_sw_cloud_sampling.html +!! + subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0) + ! Inputs + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: K-distribution data + ! Outputs + integer, intent(out) :: & + ipsdsw0 ! Initial permutation seed for McICA + + ! Set initial permutation seed for McICA, initially set to number of G-points + ipsdsw0 = sw_gas_props%get_ngpt() + + end subroutine rrtmgp_sw_cloud_sampling_init + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_sampling_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_cloud_sampling_run +!! \htmlinclude rrtmgp_sw_cloud_sampling.html +!! + subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, & + icseed_sw, cld_frac, sw_gas_props, sw_optical_props_cloudsByBand, & + sw_optical_props_clouds, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Logical flag for shortwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nDay, & ! Number of daylit points. + nLev, & ! Number of vertical layers + ipsdsw0 ! Initial permutation seed for McICA + integer,intent(in),dimension(ncol) :: & + idxday ! Indices for daylit points. + integer,intent(in),dimension(ncol) :: & + icseed_sw ! auxiliary special cloud related array when module + ! variable isubcsw=2, it provides permutation seed + ! for each column profile that are used for generating + ! random numbers. when isubcsw /=2, it will not be used. + real(kind_phys), dimension(ncol,nLev),intent(in) :: & + cld_frac ! Total cloud fraction by layer + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: K-distribution data + type(ty_optical_props_2str),intent(in) :: & + sw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error code + type(ty_optical_props_2str),intent(out) :: & + sw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + + ! Local variables + integer :: iCol + integer,dimension(ncol) :: ipseed_sw + type(random_stat) :: rng_stat + real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,ncol) :: rng3D + real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng1D + logical, dimension(ncol,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA + real(kind_phys), dimension(ncol,nLev) :: cld_frac_noSamp + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + if (nDay .gt. 0) then + + ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] + call check_error_msg('rrtmgp_sw_cloud_sampling_run',sw_optical_props_clouds%alloc_2str( & + nday, nLev, sw_gas_props)) + + ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). + if(isubcsw == 1) then ! advance prescribed permutation seed + do iCol = 1, ncol + ipseed_sw(iCol) = ipsdsw0 + iCol + enddo + elseif (isubcsw == 2) then ! use input array of permutaion seeds + do iCol = 1, ncol + ipseed_sw(iCol) = icseed_sw(iCol) + enddo + endif + + ! Call McICA to generate subcolumns. + ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points + ! and layers. ([nGpts,nLev,nColumn]-> [nGpts*nLev]*nColumn) + do iCol=1,ncol + call random_setseed(ipseed_sw(icol),rng_stat) + call random_number(rng1D,rng_stat) + rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + enddo + + ! Call McICA + select case ( iovrsw ) + ! Maximumn-random + case(1) + call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + end select + + ! Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_sw_cloud_sampling_run',draw_samples(& + cldfracMCICA(idxday(1:nDay),:,:),sw_optical_props_cloudsByBand,sw_optical_props_clouds)) + + endif + + end subroutine rrtmgp_sw_cloud_sampling_run + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_sampling_finalize() + ! ######################################################################################### + subroutine rrtmgp_sw_cloud_sampling_finalize() + end subroutine rrtmgp_sw_cloud_sampling_finalize + +end module rrtmgp_sw_cloud_sampling diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta new file mode 100644 index 000000000..3ad9073d5 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -0,0 +1,130 @@ +[ccpp-arg-table] + name = rrtmgp_sw_cloud_sampling_init + type = scheme +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[ipsdsw0] + standard_name = initial_permutation_seed_sw + long_name = initial seed for McICA SW + units = none + dimensions = () + type = integer + intent = out + optional = F + +###################################################### +[ccpp-arg-table] + name = rrtmgp_sw_cloud_sampling_run + type = scheme +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ipsdsw0] + standard_name = initial_permutation_seed_sw + long_name = initial seed for McICA SW + units = none + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[icseed_sw] + standard_name = seed_random_numbers_sw + long_name = seed for random number generation for shortwave radiation + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[sw_optical_props_cloudsByBand] + standard_name = shortwave_optical_properties_for_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = in + optional = F +[sw_optical_props_clouds] + standard_name = shortwave_optical_properties_for_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + 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 \ No newline at end of file diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 new file mode 100644 index 000000000..a0691e940 --- /dev/null +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -0,0 +1,371 @@ +module rrtmgp_sw_gas_optics + use machine, only: kind_phys + use module_radiation_gases, only: NF_VGAS + use mo_rte_kind, only: wl + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use rrtmgp_aux, only: check_error_msg + use mo_optical_props, only: ty_optical_props_2str + use mo_compute_bc, only: compute_bc + use netcdf + +contains + + ! ######################################################################################### + ! SUBROUTINE sw_gas_optics_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_gas_optics_init +!! \htmlinclude rrtmgp_sw_gas_optics.html +!! + subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_nGases, & + active_gases_array, mpicomm, mpirank, mpiroot, sw_gas_props, errmsg, errflg) + + ! Inputs + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_sw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties + integer, intent(in) :: & + rrtmgp_nGases ! Number of trace gases active in RRTMGP + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + integer,intent(in) :: & + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_gas_optics_rrtmgp),intent(out) :: & + sw_gas_props ! RRTMGP DDT: shortwave spectral information + + ! Variables that will be passed to gas_optics%load() + type(ty_gas_concs) :: & + gas_concentrations + integer, dimension(:), allocatable :: & + kminor_start_lower, & ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_lower\" (lower atmosphere) + kminor_start_upper ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_upper\" (upper atmosphere) + integer, dimension(:,:), allocatable :: & + band2gpt, & ! Beginning and ending gpoint for each band + minor_limits_gpt_lower, & ! Beginning and ending gpoint for each minor interval in lower atmosphere + minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:,:,:), allocatable :: & + key_species ! Key species pair for each band + real(kind_phys) :: & + press_ref_trop, & ! Reference pressure separating the lower and upper atmosphere [Pa] + temp_ref_p, & ! Standard spectroscopic reference pressure [Pa] + temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:), allocatable :: & + press_ref, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] + temp_ref, & ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] + solar_source ! Stored solar source function from original RRTM + real(kind_phys), dimension(:,:), allocatable :: & + band_lims ! Beginning and ending wavenumber [cm -1] for each band + + real(kind_phys), dimension(:,:,:), allocatable :: & + vmr_ref, & ! Volume mixing ratios for reference atmosphere + kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + kminor_upper, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + rayl_lower, & ! Stored coefficients due to rayleigh scattering contribution + rayl_upper ! Stored coefficients due to rayleigh scattering contribution + real(kind_phys), dimension(:,:,:,:), allocatable :: & + kmajor ! Stored absorption coefficients due to major absorbing gases + character(len=32), dimension(:), allocatable :: & + gas_names, & ! Names of absorbing gases + gas_minor, & ! Name of absorbing minor gas + identifier_minor, & ! Unique string identifying minor gas + minor_gases_lower, & ! Names of minor absorbing gases in lower atmosphere + minor_gases_upper, & ! Names of minor absorbing gases in upper atmosphere + scaling_gas_lower, & ! Absorption also depends on the concentration of this gas + scaling_gas_upper ! Absorption also depends on the concentration of this gas + logical(wl), dimension(:), allocatable :: & + minor_scales_with_density_lower, & ! Density scaling is applied to minor absorption coefficients + minor_scales_with_density_upper, & ! Density scaling is applied to minor absorption coefficients + scale_by_complement_lower, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + ! Dimensions + integer :: & + ntemps, npress, ngpts, nabsorbers, nextrabsorbers, & + nminorabsorbers, nmixingfracs, nlayers, nbnds, npairs, & + nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & + ncontributors_lower, ncontributors_upper + + ! Local variables + integer :: status, ncid, dimid, varID, iGas + integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4 + character(len=264) :: sw_gas_props_file + + ! Initialize + errmsg = '' + errflg = 0 + + write(*,"(a52,3i20)") 'rrtmgp_sw_gas_optics.F90:_init(): RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm + + ! Filenames are set in the gphysics_nml + sw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas) + + ! Read dimensions for k-distribution fields (only on master processor(0)) +! if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(sw_gas_props_file), NF90_WRITE, ncid) + + ! Read dimensions for k-distribution fields + status = nf90_inq_dimid(ncid, 'temperature', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ntemps) + status = nf90_inq_dimid(ncid, 'pressure', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=npress) + status = nf90_inq_dimid(ncid, 'absorber', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nabsorbers) + status = nf90_inq_dimid(ncid, 'minor_absorber',dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nminorabsorbers) + status = nf90_inq_dimid(ncid, 'absorber_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nextrabsorbers) + status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nmixingfracs) + status = nf90_inq_dimid(ncid, 'atmos_layer', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nlayers) + status = nf90_inq_dimid(ncid, 'bnd', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nbnds) + status = nf90_inq_dimid(ncid, 'gpt', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ngpts) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=npairs) + status = nf90_inq_dimid(ncid, 'contributors_lower',dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_lower) + status = nf90_inq_dimid(ncid, 'contributors_upper', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_upper) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_lower) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_upper) + + ! Allocate space for arrays + allocate(gas_names(nabsorbers)) + allocate(scaling_gas_lower(nminor_absorber_intervals_lower)) + allocate(scaling_gas_upper(nminor_absorber_intervals_upper)) + allocate(gas_minor(nminorabsorbers)) + allocate(identifier_minor(nminorabsorbers)) + allocate(minor_gases_lower(nminor_absorber_intervals_lower)) + allocate(minor_gases_upper(nminor_absorber_intervals_upper)) + allocate(minor_limits_gpt_lower(npairs,nminor_absorber_intervals_lower)) + allocate(minor_limits_gpt_upper(npairs,nminor_absorber_intervals_upper)) + allocate(band2gpt(2,nbnds)) + allocate(key_species(2,nlayers,nbnds)) + allocate(band_lims(2,nbnds)) + allocate(press_ref(npress)) + allocate(temp_ref(ntemps)) + allocate(vmr_ref(nlayers, nextrabsorbers, ntemps)) + allocate(kminor_lower(ncontributors_lower, nmixingfracs, ntemps)) + allocate(kmajor(ngpts, nmixingfracs, npress+1, ntemps)) + allocate(kminor_start_lower(nminor_absorber_intervals_lower)) + allocate(kminor_upper(ncontributors_upper, nmixingfracs, ntemps)) + allocate(kminor_start_upper(nminor_absorber_intervals_upper)) + allocate(minor_scales_with_density_lower(nminor_absorber_intervals_lower)) + allocate(minor_scales_with_density_upper(nminor_absorber_intervals_upper)) + allocate(scale_by_complement_lower(nminor_absorber_intervals_lower)) + allocate(scale_by_complement_upper(nminor_absorber_intervals_upper)) + allocate(rayl_upper(ngpts, nmixingfracs, ntemps)) + allocate(rayl_lower(ngpts, nmixingfracs, ntemps)) + allocate(solar_source(ngpts)) + allocate(temp1(nminor_absorber_intervals_lower)) + allocate(temp2(nminor_absorber_intervals_upper)) + allocate(temp3(nminor_absorber_intervals_lower)) + allocate(temp4(nminor_absorber_intervals_upper)) + + ! Read in fields from file + write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' + status = nf90_inq_varid(ncid, 'gas_names', varID) + status = nf90_get_var( ncid, varID, gas_names) + status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) + status = nf90_get_var( ncid, varID, scaling_gas_lower) + status = nf90_inq_varid(ncid, 'scaling_gas_upper', varID) + status = nf90_get_var( ncid, varID, scaling_gas_upper) + status = nf90_inq_varid(ncid, 'gas_minor', varID) + status = nf90_get_var( ncid, varID, gas_minor) + status = nf90_inq_varid(ncid, 'identifier_minor', varID) + status = nf90_get_var( ncid, varID, identifier_minor) + status = nf90_inq_varid(ncid, 'minor_gases_lower', varID) + status = nf90_get_var( ncid, varID, minor_gases_lower) + status = nf90_inq_varid(ncid, 'minor_gases_upper', varID) + status = nf90_get_var( ncid, varID, minor_gases_upper) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varID) + status = nf90_get_var( ncid, varID, minor_limits_gpt_lower) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varID) + status = nf90_get_var( ncid, varID, minor_limits_gpt_upper) + status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varID) + status = nf90_get_var( ncid, varID, band2gpt) + status = nf90_inq_varid(ncid, 'key_species', varID) + status = nf90_get_var( ncid, varID, key_species) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber', varID) + status = nf90_get_var( ncid, varID, band_lims) + status = nf90_inq_varid(ncid, 'press_ref', varID) + status = nf90_get_var( ncid, varID, press_ref) + status = nf90_inq_varid(ncid, 'temp_ref', varID) + status = nf90_get_var( ncid, varID, temp_ref) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varID) + status = nf90_get_var( ncid, varID, temp_ref_p) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varID) + status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_inq_varid(ncid, 'press_ref_trop', varID) + status = nf90_get_var( ncid, varID, press_ref_trop) + status = nf90_inq_varid(ncid, 'kminor_lower', varID) + status = nf90_get_var( ncid, varID, kminor_lower) + status = nf90_inq_varid(ncid, 'kminor_upper', varID) + status = nf90_get_var( ncid, varID, kminor_upper) + status = nf90_inq_varid(ncid, 'vmr_ref', varID) + status = nf90_get_var( ncid, varID, vmr_ref) + status = nf90_inq_varid(ncid, 'kmajor', varID) + status = nf90_get_var( ncid, varID, kmajor) + status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) + status = nf90_get_var( ncid, varID, kminor_start_lower) + status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) + status = nf90_get_var( ncid, varID, kminor_start_upper) + status = nf90_inq_varid(ncid, 'solar_source', varID) + status = nf90_get_var( ncid, varID, solar_source) + status = nf90_inq_varid(ncid, 'rayl_lower', varID) + status = nf90_get_var( ncid, varID, rayl_lower) + status = nf90_inq_varid(ncid, 'rayl_upper', varID) + status = nf90_get_var( ncid, varID, rayl_upper) + + ! Logical fields are read in as integers and then converted to logicals. + status = nf90_inq_varid(ncid,'minor_scales_with_density_lower', varID) + status = nf90_get_var( ncid, varID,temp1) + minor_scales_with_density_lower(:) = .false. + where(temp1 .eq. 1) minor_scales_with_density_lower(:) = .true. + status = nf90_inq_varid(ncid,'minor_scales_with_density_upper', varID) + status = nf90_get_var( ncid, varID,temp2) + minor_scales_with_density_upper(:) = .false. + where(temp2 .eq. 1) minor_scales_with_density_upper(:) = .true. + status = nf90_inq_varid(ncid,'scale_by_complement_lower', varID) + status = nf90_get_var( ncid, varID,temp3) + scale_by_complement_lower(:) = .false. + where(temp3 .eq. 1) scale_by_complement_lower(:) = .true. + status = nf90_inq_varid(ncid,'scale_by_complement_upper', varID) + status = nf90_get_var( ncid, varID,temp4) + scale_by_complement_upper(:) = .false. + where(temp4 .eq. 1) scale_by_complement_upper(:) = .true. + + ! Close + status = nf90_close(ncid) +! endif + + + ! Initialize gas concentrations and gas optics class + call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array)) + call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, gas_names, & + key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & + temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower,minor_limits_gpt_upper, & + minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & + scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, solar_source, rayl_lower, rayl_upper)) + + end subroutine rrtmgp_sw_gas_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_gas_optics_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_gas_optics_run +!! \htmlinclude rrtmgp_sw_gas_optics.html +!! + subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, nday, idxday, sw_gas_props, p_lay,& + p_lev, toa_src_sw, t_lay, t_lev, gas_concentrations, solcon, rrtmgp_nGases, & + active_gases_array, sw_optical_props_clrsky, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Flag to calculate SW irradiances + integer,intent(in) :: & + nDay, & ! Number of daylit points. + nCol, & ! Number of horizontal points + nLev ! Number of vertical levels + integer,intent(in),dimension(ncol) :: & + idxday ! Indices for daylit points. + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: spectral information for RRTMGP SW radiation scheme + real(kind_phys), dimension(ncol,nLev), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & + p_lev, & ! Pressure @ model layer-interfaces (hPa) + t_lev ! Temperature @ model levels + type(ty_gas_concs),intent(in) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + real(kind_phys), intent(in) :: & + solcon ! Solar constant + integer, intent(in) :: & + rrtmgp_nGases ! Number of trace gases active in RRTMGP + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + + ! Output + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_optical_props_2str),intent(out) :: & + sw_optical_props_clrsky ! RRTMGP DDT: clear-sky shortwave optical properties, spectral (tau,ssa,g) + real(kind_phys), dimension(ncol,sw_gas_props%get_ngpt()), intent(out) :: & + toa_src_sw ! TOA incident spectral flux (W/m2) + + ! Local variables + integer :: ij,iGas + real(kind_phys), dimension(ncol,nLev) :: vmrTemp + real(kind_phys), dimension(nday,sw_gas_props%get_ngpt()) :: toa_src_sw_temp + type(ty_gas_concs) :: & + gas_concentrations_daylit ! RRTMGP DDT: trace gas concentrations (vmr) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + + if (nDay .gt. 0) then + ! Allocate space + call check_error_msg('rrtmgp_sw_gas_optics_run',sw_optical_props_clrsky%alloc_2str(nday, nLev, sw_gas_props)) + + ! Initialize gas concentrations and gas optics class + call check_error_msg('rrtmgp_sw_rte_run',gas_concentrations_daylit%init(active_gases_array)) + + ! Subset the gas concentrations, only need daylit points. + do iGas=1,rrtmgp_nGases + call check_error_msg('rrtmgp_sw_rte_run',& + gas_concentrations%get_vmr(trim(active_gases_array(iGas)),vmrTemp)) + call check_error_msg('rrtmgp_sw_rte_run',& + gas_concentrations_daylit%set_vmr(trim(active_gases_array(iGas)),vmrTemp(idxday(1:nday),:))) + enddo + + ! Gas-optics + call check_error_msg('rrtmgp_sw_gas_optics_run',sw_gas_props%gas_optics(& + p_lay(idxday(1:nday),:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(idxday(1:nday),:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(idxday(1:nday),:), & ! IN - Temperature @ layer-centers (K) + gas_concentrations_daylit, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + sw_optical_props_clrsky, & ! OUT - RRTMGP DDT: Shortwave optical properties, by + ! spectral point (tau,ssa,g) + toa_src_sw_temp)) ! OUT - TOA incident shortwave radiation (spectral) + toa_src_sw(idxday(1:nday),:) = toa_src_sw_temp + ! Scale incident flux + do ij=1,nday + toa_src_sw(idxday(ij),:) = toa_src_sw(idxday(ij),:)*solcon/ & + sum(toa_src_sw(idxday(ij),:)) + enddo + endif + + end subroutine rrtmgp_sw_gas_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_gas_optics_finalize + ! ######################################################################################### + subroutine rrtmgp_sw_gas_optics_finalize() + end subroutine rrtmgp_sw_gas_optics_finalize + +end module rrtmgp_sw_gas_optics + diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta new file mode 100644 index 000000000..fc8e72a9a --- /dev/null +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -0,0 +1,244 @@ +[ccpp-arg-table] + name = rrtmgp_sw_gas_optics_init + type = scheme +[rrtmgp_root_dir] + standard_name = directory_for_rte_rrtmgp_source_code + long_name = directory for rte+rrtmgp source code + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_sw_file_gas] + standard_name = rrtmgp_kdistribution_sw + long_name = file containing RRTMGP SW k-distribution + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP + units = count + dimensions = () + type = integer + intent = in + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + 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 +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + 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 +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_sw_gas_optics_run + type = scheme +[doSWrad] + standard_name = flag_to_calc_sw + long_name = flag to calculate SW irradiances + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature layer + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lev] + standard_name = air_temperature_at_interface_for_RRTMGP + long_name = air temperature level + units = K + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[toa_src_sw] + standard_name = toa_incident_sw_flux_by_spectral_point + long_name = TOA shortwave incident flux at each spectral points + units = W m-2 + dimensions = (horizontal_dimension,number_of_sw_spectral_points_rrtmgp) + type = real + kind = kind_phys + intent = out + optional = F +[gas_concentrations] + standard_name = Gas_concentrations_for_RRTMGP_suite + long_name = DDT containing gas concentrations for RRTMGP radiation scheme + units = DDT + dimensions = () + type = ty_gas_concs + intent = in + optional = F +[solcon] + standard_name = solar_constant + long_name = solar constant + units = W m-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rrtmgp_nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP + units = count + dimensions = () + type = integer + intent = in + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + 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 +[sw_optical_props_clrsky] + standard_name = shortwave_optical_properties_for_clear_sky + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = out + optional = F diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 new file mode 100644 index 000000000..96bfa94ea --- /dev/null +++ b/physics/rrtmgp_sw_rte.F90 @@ -0,0 +1,218 @@ +module rrtmgp_sw_rte + use machine, only: kind_phys + use mo_rte_kind, only: wl + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_cloud_optics, only: ty_cloud_optics + use mo_optical_props, only: ty_optical_props_2str + use mo_rte_sw, only: rte_sw + use mo_gas_concentrations, only: ty_gas_concs + use mo_fluxes_byband, only: ty_fluxes_byband + use module_radsw_parameters, only: cmpfsw_type + use rrtmgp_aux, only: check_error_msg + + public rrtmgp_sw_rte_init, rrtmgp_sw_rte_run, rrtmgp_sw_rte_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_rte_init + ! ######################################################################################### + subroutine rrtmgp_sw_rte_init() + end subroutine rrtmgp_sw_rte_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_rte_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_rte_run +!! \htmlinclude rrtmgp_sw_rte.html +!! + subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t_lay, & + p_lev, sw_gas_props, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, sw_optical_props_clouds, & + sw_optical_props_aerosol, rrtmgp_nGases, active_gases_array, scmpsw, fluxswUP_allsky, & + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, hsw0, hswb, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Flag to calculate SW irradiances + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nday, & ! Number of daytime points + nLev ! Number of vertical levels + integer, intent(in), dimension(ncol) :: & + idxday ! Index array for daytime points + real(kind_phys),intent(in), dimension(ncol) :: & + coszen ! Cosize of SZA + real(kind_phys), dimension(ncol,NLev), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (Pa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,NLev+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (Pa) + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: SW spectral information + type(ty_optical_props_2str),intent(inout) :: & + sw_optical_props_clrsky ! RRTMGP DDT: shortwave clear-sky radiative properties + type(ty_optical_props_2str),intent(in) :: & + sw_optical_props_clouds, & ! RRTMGP DDT: shortwave cloud radiative properties + sw_optical_props_aerosol ! RRTMGP DDT: shortwave aerosol radiative properties + real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(in) :: & + sfc_alb_nir_dir, & ! Surface albedo (direct) + sfc_alb_nir_dif, & ! Surface albedo (diffuse) + sfc_alb_uvvis_dir, & ! Surface albedo (direct) + sfc_alb_uvvis_dif ! Surface albedo (diffuse) + real(kind_phys), dimension(ncol,sw_gas_props%get_ngpt()), intent(in) :: & + toa_src_sw ! TOA incident spectral flux (W/m2) + integer, intent(in) :: & + rrtmgp_nGases ! Number of trace gases active in RRTMGP + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + + ! Inputs (optional) (NOTE. We only need the optional arguments to know what fluxes to output, HR's are computed later) + real(kind_phys), dimension(ncol,NLev), optional, intent(inout) :: & + hsw0 ! Clear-sky heating rate (K/sec) + real(kind_phys), dimension(ncol,NLev,sw_gas_props%get_nband()), intent(inout), optional :: & + hswb ! All-sky heating rate, by band (K/sec) + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + real(kind_phys), dimension(ncol,NLev+1), intent(inout) :: & + fluxswUP_allsky, & ! RRTMGP upward all-sky flux profiles (W/m2) + fluxswDOWN_allsky, & ! RRTMGP downward all-sky flux profiles (W/m2) + fluxswUP_clrsky, & ! RRTMGP upward clear-sky flux profiles (W/m2) + fluxswDOWN_clrsky ! RRTMGP downward clear-sky flux profiles (W/m2) + + ! Outputs (optional) + type(cmpfsw_type), dimension(ncol), intent(inout),optional :: & + scmpsw ! 2D surface fluxes, components: + ! uvbfc - total sky downward uv-b flux (W/m2) + ! uvbf0 - clear sky downward uv-b flux (W/m2) + ! nirbm - downward nir direct beam flux (W/m2) + ! nirdf - downward nir diffused flux (W/m2) + ! visbm - downward uv+vis direct beam flux (W/m2) + ! visdf - downward uv+vis diffused flux (W/m2) + + ! Local variables + real(kind_phys), dimension(sw_gas_props%get_nband(),nday) :: & + sfc_alb_dir,sfc_alb_dif + type(ty_fluxes_byband) :: & + flux_allsky, & ! All-sky flux (W/m2) + flux_clrsky ! Clear-sky flux (W/m2) + real(kind_phys), dimension(nday,NLev+1,sw_gas_props%get_nband()),target :: & + fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky, fluxSW_dn_dir_allsky + real(kind_phys), dimension(ncol,NLev) :: vmrTemp + logical :: l_ClrSky_HR=.false., l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 + integer :: iGas,iSFC,iTOA,iBand + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + + ! Initialize output fluxes + fluxswUP_allsky(:,:) = 0._kind_phys + fluxswDOWN_allsky(:,:) = 0._kind_phys + fluxswUP_clrsky(:,:) = 0._kind_phys + fluxswDOWN_clrsky(:,:) = 0._kind_phys + + if (nDay .gt. 0) then + + ! Vertical ordering? + top_at_1 = (p_lev(1,1) .lt. p_lev(1, NLev)) + if (top_at_1) then + iSFC = NLev+1 + iTOA = 1 + else + iSFC = 1 + iTOA = NLev+1 + endif + + ! Are any optional outputs requested? Need to know now to compute correct fluxes. + l_ClrSky_HR = present(hsw0) + l_AllSky_HR_byband = present(hswb) + l_scmpsw = present(scmpsw) + if ( l_scmpsw ) then + scmpsw = cmpfsw_type (0., 0., 0., 0., 0., 0.) + endif + + ! Initialize RRTMGP DDT containing 2D(3D) fluxes + fluxSW_up_allsky(:,:,:) = 0._kind_phys + fluxSW_dn_allsky(:,:,:) = 0._kind_phys + fluxSW_dn_dir_allsky(:,:,:) = 0._kind_phys + fluxSW_up_clrsky(:,:,:) = 0._kind_phys + fluxSW_dn_clrsky(:,:,:) = 0._kind_phys + flux_allsky%bnd_flux_up => fluxSW_up_allsky + flux_allsky%bnd_flux_dn => fluxSW_dn_allsky + flux_allsky%bnd_flux_dn_dir => fluxSW_dn_dir_allsky + flux_clrsky%bnd_flux_up => fluxSW_up_clrsky + flux_clrsky%bnd_flux_dn => fluxSW_dn_clrsky + + ! *Note* Legacy RRTMG code. May need to revisit + do iBand=1,sw_gas_props%get_nband() + if (iBand .lt. 10) then + sfc_alb_dir(iBand,:) = sfc_alb_nir_dir(iBand,idxday(1:nday)) + sfc_alb_dif(iBand,:) = sfc_alb_nir_dif(iBand,idxday(1:nday)) + endif + if (iBand .eq. 10) then + sfc_alb_dir(iBand,:) = 0.5_kind_phys*(sfc_alb_nir_dir(iBand,idxday(1:nday)) + sfc_alb_uvvis_dir(iBand,idxday(1:nday))) + sfc_alb_dif(iBand,:) = 0.5_kind_phys*(sfc_alb_nir_dif(iBand,idxday(1:nday)) + sfc_alb_uvvis_dif(iBand,idxday(1:nday))) + endif + if (iBand .gt. 10) then + sfc_alb_dir(iBand,:) = sfc_alb_uvvis_dir(iBand,idxday(1:nday)) + sfc_alb_dif(iBand,:) = sfc_alb_uvvis_dif(iBand,idxday(1:nday)) + endif + enddo + + ! Compute clear-sky fluxes (if requested) + ! Clear-sky fluxes (gas+aerosol) + call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_aerosol%increment(sw_optical_props_clrsky)) + ! Delta-scale optical properties + call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clrsky%delta_scale()) + if (l_ClrSky_HR) then + call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & + sw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(idxday(1:nday)), & ! IN - Cosine of solar zenith angle + toa_src_sw(idxday(1:nday),:), & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,NLev,nBand) + ! Store fluxes + fluxswUP_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_up,dim=3) + fluxswDOWN_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_dn,dim=3) + endif + + ! Compute all-sky fluxes + ! All-sky fluxes (clear-sky + clouds) + call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clouds%increment(sw_optical_props_clrsky)) + ! Delta-scale optical properties + call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clrsky%delta_scale()) + call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & + sw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(idxday(1:nday)), & ! IN - Cosine of solar zenith angle + toa_src_sw(idxday(1:nday),:), & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,NLev,nBand) + ! Store fluxes + fluxswUP_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_up,dim=3) + fluxswDOWN_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_dn,dim=3) + if ( l_scmpsw ) then + scmpsw(idxday(1:nday))%nirbm = sum(flux_allsky%bnd_flux_dn_dir(idxday(1:nday),iSFC,:),dim=2) + scmpsw(idxday(1:nday))%nirdf = sum(flux_allsky%bnd_flux_dn(idxday(1:nday),iSFC,:),dim=2) - & + sum(flux_allsky%bnd_flux_dn_dir(idxday(1:nday),iSFC,:),dim=2) + endif + endif + end subroutine rrtmgp_sw_rte_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_rte_finalize + ! ######################################################################################### + subroutine rrtmgp_sw_rte_finalize() + end subroutine rrtmgp_sw_rte_finalize + +end module rrtmgp_sw_rte diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta new file mode 100644 index 000000000..8ae7421c3 --- /dev/null +++ b/physics/rrtmgp_sw_rte.meta @@ -0,0 +1,252 @@ +[ccpp-arg-table] + name = rrtmgp_sw_rte_run + type = scheme +[doSWrad] + standard_name = flag_to_calc_sw + long_name = flag to calculate SW irradiances + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature layer + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[sw_optical_props_clrsky] + standard_name = shortwave_optical_properties_for_clear_sky + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = inout + optional = F +[sw_optical_props_clouds] + standard_name = shortwave_optical_properties_for_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = in + optional = F +[sw_optical_props_aerosol] + standard_name = shortwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = in + optional = F +[sfc_alb_nir_dir] + standard_name = surface_albedo_nearIR_direct + long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_nir_dif] + standard_name = surface_albedo_nearIR_diffuse + long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_uvvis_dir] + standard_name = surface_albedo_uvvis_dir + long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_uvvis_dif] + standard_name = surface_albedo_uvvis_dif + long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[toa_src_sw] + standard_name = toa_incident_sw_flux_by_spectral_point + long_name = TOA shortwave incident flux at each spectral points + units = W m-2 + dimensions = (horizontal_dimension,number_of_sw_spectral_points_rrtmgp) + type = real + kind = kind_phys + intent = in + optional = F +[rrtmgp_nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP + units = count + dimensions = () + type = integer + intent = in + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in + optional = F +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_dimension) + type = cmpfsw_type + intent = inout + optional = T +[fluxswUP_allsky] + standard_name = RRTMGP_sw_flux_profile_upward_allsky + long_name = RRTMGP upward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = inout + optional = F +[fluxswDOWN_allsky] + standard_name = RRTMGP_sw_flux_profile_downward_allsky + long_name = RRTMGP downward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = inout + optional = F +[fluxswUP_clrsky] + standard_name = RRTMGP_sw_flux_profile_upward_clrsky + long_name = RRTMGP upward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = inout + optional = F +[fluxswDOWN_clrsky] + standard_name = RRTMGP_sw_flux_profile_downward_clrsky + long_name = RRTMGP downward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = inout + optional = F +[hsw0] + standard_name = RRTMGP_sw_heating_rate_clear_sky + long_name = shortwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[hswb] + standard_name = RRTMGP_sw_heating_rate_spectral + long_name = shortwave total sky heating rate (spectral) + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_sw_spectral_points_rrtmgp) + type = real + kind = kind_phys + intent = inout + optional = T +[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/rte-rrtmgp b/physics/rte-rrtmgp new file mode 160000 index 000000000..7dfff2025 --- /dev/null +++ b/physics/rte-rrtmgp @@ -0,0 +1 @@ +Subproject commit 7dfff2025cae02c84b12df2402a39d77065f0e62 From 580c258e1d20e530012dde4935ab23d8f8d2f40b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 19 Mar 2020 10:26:06 -0600 Subject: [PATCH 050/141] Bugfixes and cmake build system updates required for RRTMGP --- CMakeLists.txt | 32 +++++++++++++++++++++-------- physics/rrtmgp_lw_cloud_optics.F90 | 11 +++------- physics/rrtmgp_lw_cloud_optics.meta | 24 ---------------------- 3 files changed, 26 insertions(+), 41 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index b8d3c3e18..0a1658b22 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -95,23 +95,39 @@ set(CCPP_LIB_DIRS "" CACHE FILEPATH "Path to ccpp library") link_directories(${CCPP_LIB_DIRS}) list(APPEND LIBS "ccpp") +#------------------------------------------------------------------------------ +# Set the sources: physics type definitions +set(TYPEDEFS $ENV{CCPP_TYPEDEFS}) +if(TYPEDEFS) + message(STATUS "Got CCPP TYPEDEFS from environment variable: ${TYPEDEFS}") +else(TYPEDEFS) + include(./CCPP_TYPEDEFS.cmake) + message(STATUS "Got CCPP TYPEDEFS from cmakefile include file: ${TYPEDEFS}") +endif(TYPEDEFS) + +# Generate list of Fortran modules from the CCPP type +# definitions that need need to be installed +foreach(typedef_module ${TYPEDEFS}) + list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${typedef_module}) +endforeach() + #------------------------------------------------------------------------------ # Set the sources: physics schemes set(SCHEMES $ENV{CCPP_SCHEMES}) if(SCHEMES) - message(INFO "Got CCPP_SCHEMES from environment variable: ${SCHEMES}") + message(STATUS "Got CCPP SCHEMES from environment variable: ${SCHEMES}") else(SCHEMES) include(./CCPP_SCHEMES.cmake) - message(INFO "Got SCHEMES from cmakefile include file: ${SCHEMES}") + message(STATUS "Got CCPP SCHEMES from cmakefile include file: ${SCHEMES}") endif(SCHEMES) # Set the sources: physics scheme caps set(CAPS $ENV{CCPP_CAPS}) if(CAPS) - message(INFO "Got CAPS from environment variable: ${CAPS}") + message(STATUS "Got CCPP CAPS from environment variable: ${CAPS}") else(CAPS) include(./CCPP_CAPS.cmake) - message(INFO "Got CAPS from cmakefile include file: ${CAPS}") + message(STATUS "Got CCPP CAPS from cmakefile include file: ${CAPS}") endif(CAPS) # Create empty lists for schemes with special compiler optimization flags @@ -398,9 +414,7 @@ if (PROJECT STREQUAL "CCPP-FV3") FILE ccppphys-config.cmake DESTINATION lib/cmake ) - if(STATIC) - # Define where to install the C headers and Fortran modules - #install(FILES ${HEADERS_C} DESTINATION include) - install(FILES ${MODULES_F90} DESTINATION include) - endif(STATIC) + # Define where to install the C headers and Fortran modules + #install(FILES ${HEADERS_C} DESTINATION include) + install(FILES ${MODULES_F90} DESTINATION include) endif (PROJECT STREQUAL "CCPP-FV3") diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index f9ee9b987..077982e6e 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -17,7 +17,7 @@ module rrtmgp_lw_cloud_optics !! \section arg_table_rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & + subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg) ! Inputs @@ -363,12 +363,7 @@ end subroutine rrtmgp_lw_cloud_optics_run !! \section arg_table_rrtmgp_lw_cloud_optics_finalize !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_finalize(mpicomm, mpirank, mpiroot) - ! Inputs - integer, intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank - + subroutine rrtmgp_lw_cloud_optics_finalize() end subroutine rrtmgp_lw_cloud_optics_finalize + end module rrtmgp_lw_cloud_optics diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index bae5ef74f..cebbfc700 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -283,27 +283,3 @@ [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_finalize type = scheme -[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 -[mpicomm] - standard_name = mpi_comm - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in - optional = F \ No newline at end of file From d72b21205b593546db65e04a8fb6761d56fa70f5 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 19 Mar 2020 13:35:14 -0600 Subject: [PATCH 051/141] physics/rrtmgp_lw_gas_optics.F90: manual merge of code in @dustinswales branch rrtmgp-dev2-no-mpi_bcast (turn off MPI broadcasting) --- physics/rrtmgp_lw_gas_optics.F90 | 68 +------------------------------- 1 file changed, 2 insertions(+), 66 deletions(-) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index b6300089f..8797973f3 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -8,9 +8,6 @@ module rrtmgp_lw_gas_optics use mo_compute_bc, only: compute_bc use rrtmgp_aux, only: check_error_msg use netcdf -#ifdef MPI - use mpi -#endif contains @@ -105,9 +102,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4, & temp_log_array1, temp_log_array2, temp_log_array3, temp_log_array4 character(len=264) :: lw_gas_props_file -#ifdef MPI - integer :: mpierr -#endif ! Initialize errmsg = '' @@ -119,7 +113,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas) ! On master processor only... - if (mpirank .eq. mpiroot) then +! if (mpirank .eq. mpiroot) then ! Open file status = nf90_open(trim(lw_gas_props_file), NF90_WRITE, ncid) @@ -260,65 +254,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ! Close file status = nf90_close(ncid) - endif - -#ifdef MPI - ! Wait for processor 0 to catch up... - call MPI_BARRIER(mpicomm, mpierr) - ! Broadcast data - write (*,*) 'Broadcasting RRTMGP longwave k-distribution data ... ' - call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nextrabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(ngpts, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(ninternalSourcetemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BARRIER(mpicomm, mpierr) - call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BARRIER(mpicomm, mpierr) - call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(press_ref, size(press_ref), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(temp_ref, size(temp_ref), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BARRIER(mpicomm, mpierr) - call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(kmajor, size(kmajor), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(temp_ref_p, 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(temp_ref_t, 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(press_ref_trop, 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BARRIER(mpicomm, mpierr) - call MPI_BCAST(totplnk, size(totplnk), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(planck_frac, size(planck_frac), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(gas_names, size(gas_names), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(gas_minor, size(gas_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(identifier_minor, size(identifier_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(minor_gases_lower, size(minor_gases_lower), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call MPI_BARRIER(mpicomm, mpierr) - call MPI_BCAST(minor_gases_upper, size(minor_gases_upper), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(scale_by_complement_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(minor_scales_with_density_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(scale_by_complement_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - ! Don't advance until data broadcast complete on all processors - call MPI_BARRIER(mpicomm, mpierr) -#endif +! endif ! Initialize gas concentrations and gas optics class call check_error_msg('lw_gas_optics_init',gas_concentrations%init(active_gases_array)) From b745df89386b95b6279fb6de714b0e2bd8e4983b Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Thu, 19 Mar 2020 16:55:22 -0400 Subject: [PATCH 052/141] commited on MG3_v1 on 03/19/2020 --- physics/aerinterp.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index 8c7046d37..e1263e93c 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -179,7 +179,13 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) endif do i = 1, hmx aerin(i+hmx,j,k,ii,imon) = 1.d0*buffx(i,j,klev,1) + if(aerin(i+hmx,j,k,ii,imon)<0.or.aerin(i+hmx,j,k,ii,imon)>1.) then + aerin(i+hmx,j,k,ii,imon) = 0. + end if aerin(i,j,k,ii,imon) = 1.d0*buffx(i+hmx,j,klev,1) + if(aerin(i,j,k,ii,imon)<0.or.aerin(i,j,k,ii,imon)>1.) then + aerin(i,j,k,ii,imon) = 0. + end if enddo !i-loop (lon) enddo !k-loop (lev) enddo !j-loop (lat) From fe43bca36956a5f7974dbe0a5f8a06a28eacb326 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 19 Mar 2020 15:44:04 -0600 Subject: [PATCH 053/141] Bugfix in physics/rrtmgp_lw_cloud_optics.F90, add 'implicit none' to all rrtmgp_*.F90 files --- physics/rrtmgp_lw_aerosol_optics.F90 | 3 +++ physics/rrtmgp_lw_cloud_optics.F90 | 7 +++++-- physics/rrtmgp_lw_cloud_sampling.F90 | 2 ++ physics/rrtmgp_lw_gas_optics.F90 | 2 ++ physics/rrtmgp_lw_pre.F90 | 7 ++++++- physics/rrtmgp_lw_rte.F90 | 3 +++ physics/rrtmgp_sw_aerosol_optics.F90 | 3 +++ physics/rrtmgp_sw_cloud_optics.F90 | 3 +++ physics/rrtmgp_sw_cloud_sampling.F90 | 2 ++ physics/rrtmgp_sw_gas_optics.F90 | 2 ++ physics/rrtmgp_sw_rte.F90 | 2 ++ 11 files changed, 33 insertions(+), 3 deletions(-) diff --git a/physics/rrtmgp_lw_aerosol_optics.F90 b/physics/rrtmgp_lw_aerosol_optics.F90 index a77b00759..eb23ba21a 100644 --- a/physics/rrtmgp_lw_aerosol_optics.F90 +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -10,7 +10,10 @@ module rrtmgp_lw_aerosol_optics NSPC1 ! Number of species for vertically integrated aerosol optical-depth use netcdf + implicit none + public rrtmgp_lw_aerosol_optics_init, rrtmgp_lw_aerosol_optics_run, rrtmgp_lw_aerosol_optics_finalize + contains ! ######################################################################################### diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 077982e6e..1738f895d 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -8,7 +8,10 @@ module rrtmgp_lw_cloud_optics use rrtmgp_aux, only: check_error_msg use netcdf + implicit none + public rrtmgp_lw_cloud_optics_init, rrtmgp_lw_cloud_optics_run, rrtmgp_lw_cloud_optics_finalize + contains ! ######################################################################################### @@ -268,7 +271,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for longwave radiation call + doLWrad ! Logical flag for longwave radiation call integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels @@ -327,7 +330,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys ! Compute cloud-optics for RTE. - if (rrtmgp_cld_optics .gt. 0) then + if (cld_optics_scheme .gt. 0) then ! i) RRTMGP cloud-optics. call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_cloud_props%cloud_optics(& !ncol, & ! IN - Number of horizontal gridpoints diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 51f512853..dca566923 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -8,6 +8,8 @@ module rrtmgp_lw_cloud_sampling use rrtmgp_aux, only: check_error_msg use netcdf + implicit none + contains ! ######################################################################################### diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 8797973f3..ffe68184e 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -9,6 +9,8 @@ module rrtmgp_lw_gas_optics use rrtmgp_aux, only: check_error_msg use netcdf + implicit none + contains ! ######################################################################################### diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 0be239671..d93b6a619 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -13,8 +13,10 @@ module rrtmgp_lw_pre use mo_gas_optics_rrtmgp, only: & ty_gas_optics_rrtmgp + implicit none + public rrtmgp_lw_pre_run,rrtmgp_lw_pre_init,rrtmgp_lw_pre_finalize - + contains ! ######################################################################################### @@ -59,6 +61,9 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc real(kind_phys), dimension(nCol), intent(out) :: & semis + ! Local variables + integer :: iBand + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 94c9b741e..80848a363 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -11,7 +11,10 @@ module rrtmgp_lw_rte use mo_source_functions, only: ty_source_func_lw use rrtmgp_aux, only: check_error_msg + implicit none + public rrtmgp_lw_rte_init, rrtmgp_lw_rte_run, rrtmgp_lw_rte_finalize + contains ! ######################################################################################### diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 index d6413c368..6207a22d8 100644 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -10,7 +10,10 @@ module rrtmgp_sw_aerosol_optics NSPC1 ! Number of species for vertically integrated aerosol optical-depth use netcdf + implicit none + public rrtmgp_sw_aerosol_optics_init, rrtmgp_sw_aerosol_optics_run, rrtmgp_sw_aerosol_optics_finalize + contains ! ######################################################################################### diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 99dcef2a5..79e439030 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -9,7 +9,10 @@ module rrtmgp_sw_cloud_optics use rrtmgp_aux, only: check_error_msg use netcdf + implicit none + public rrtmgp_sw_cloud_optics_init, rrtmgp_sw_cloud_optics_run, rrtmgp_sw_cloud_optics_finalize + contains ! ######################################################################################### ! SUBROUTINE sw_cloud_optics_init diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index cc998b755..0c839afb2 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -8,6 +8,8 @@ module rrtmgp_sw_cloud_sampling use rrtmgp_aux, only: check_error_msg use netcdf + implicit none + contains ! ######################################################################################### diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index a0691e940..a57e2fca8 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -9,6 +9,8 @@ module rrtmgp_sw_gas_optics use mo_compute_bc, only: compute_bc use netcdf + implicit none + contains ! ######################################################################################### diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 96bfa94ea..0654331b7 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -10,6 +10,8 @@ module rrtmgp_sw_rte use module_radsw_parameters, only: cmpfsw_type use rrtmgp_aux, only: check_error_msg + implicit none + public rrtmgp_sw_rte_init, rrtmgp_sw_rte_run, rrtmgp_sw_rte_finalize contains From 24ce08dca3894ccc233a7d0955790fb62983b6f8 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 19 Mar 2020 20:39:24 -0600 Subject: [PATCH 054/141] Remove debug print statements --- physics/rrtmgp_lw_gas_optics.F90 | 4 +--- physics/rrtmgp_sw_gas_optics.F90 | 4 +--- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index ffe68184e..c94df2a2f 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -109,8 +109,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp errmsg = '' errflg = 0 - write(*,"(a52,3i20)") 'rrtmgp_lw_gas_optics.F90:_init(): RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm - ! Filenames are set in the physics_nml lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas) @@ -184,7 +182,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp allocate(planck_frac(ngpts, nmixingfracs, npress+1, ntemps)) ! Read in fields from file - write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' + if (mpirank==mpiroot) write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) status = nf90_get_var( ncid, varID, gas_names) status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index a57e2fca8..7945f43fe 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -107,8 +107,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp errmsg = '' errflg = 0 - write(*,"(a52,3i20)") 'rrtmgp_sw_gas_optics.F90:_init(): RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm - ! Filenames are set in the gphysics_nml sw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas) @@ -181,7 +179,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp allocate(temp4(nminor_absorber_intervals_upper)) ! Read in fields from file - write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' + if (mpirank==mpiroot) write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) status = nf90_get_var( ncid, varID, gas_names) status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) From 322f5b17c13015b23e075463459b9077eb8943e3 Mon Sep 17 00:00:00 2001 From: Philip Pegion Date: Fri, 20 Mar 2020 14:03:42 +0000 Subject: [PATCH 055/141] make rain/snow tendency consistent with accumulated rain/snow --- physics/GFS_MP_generic.F90 | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index f72f9405a..bbf88e24b 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -341,8 +341,10 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (cplflx .or. cplchm) then do i = 1, im - rain_cpl(i) = rain_cpl(i) + rain(i) * (one-srflag(i)) - snow_cpl(i) = snow_cpl(i) + rain(i) * srflag(i) + drain_cpl(i) = rain(i) * (one-srflag(i)) + dsnow_cpl(i) = rain(i) * srflag(i) + rain_cpl(i) = rain_cpl(i) + drain_cpl(i) + snow_cpl(i) = snow_cpl(i) + dsnow_cpl(i) enddo endif @@ -376,15 +378,6 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (do_sppt) then !--- radiation heating rate dtdtr(1:im,:) = dtdtr(1:im,:) + dtdtc(1:im,:)*dtf - do i = 1, im - if (t850(i) > 273.16) then -!--- change in change in rain precip - drain_cpl(i) = rain(i) - drain_cpl(i) - else -!--- change in change in snow precip - dsnow_cpl(i) = rain(i) - dsnow_cpl(i) - endif - enddo endif end subroutine GFS_MP_generic_post_run From a0bb378ef6d2f57a2b04b65b579fc1b608286f53 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 20 Mar 2020 14:09:14 -0600 Subject: [PATCH 056/141] physics/rrtmgp_sw_rte.F90: bugfix from @dustinswales --- physics/rrtmgp_sw_rte.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 0654331b7..71b7e20ee 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -204,9 +204,9 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t fluxswUP_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_up,dim=3) fluxswDOWN_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_dn,dim=3) if ( l_scmpsw ) then - scmpsw(idxday(1:nday))%nirbm = sum(flux_allsky%bnd_flux_dn_dir(idxday(1:nday),iSFC,:),dim=2) - scmpsw(idxday(1:nday))%nirdf = sum(flux_allsky%bnd_flux_dn(idxday(1:nday),iSFC,:),dim=2) - & - sum(flux_allsky%bnd_flux_dn_dir(idxday(1:nday),iSFC,:),dim=2) + scmpsw(idxday(1:nday))%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1:nday,iSFC,:),dim=2) + scmpsw(idxday(1:nday))%nirdf = sum(flux_allsky%bnd_flux_dn(1:nday,iSFC,:),dim=2) - & + sum(flux_allsky%bnd_flux_dn_dir(1:nday,iSFC,:),dim=2) endif endif end subroutine rrtmgp_sw_rte_run From e8bca85238aae901e3c7ed97e6f0684b252e0385 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 23 Mar 2020 18:41:15 +0000 Subject: [PATCH 057/141] Cleanup RRTMGP optional argument logic. --- physics/GFS_rrtmgp_lw_post.F90 | 12 +++++------- physics/GFS_rrtmgp_lw_post.meta | 9 --------- physics/GFS_rrtmgp_sw_post.F90 | 12 +++++------- physics/GFS_rrtmgp_sw_post.meta | 9 --------- physics/rrtmgp_lw_rte.F90 | 29 ++++++++++++----------------- physics/rrtmgp_lw_rte.meta | 9 --------- physics/rrtmgp_sw_rte.F90 | 31 +++++++++++++------------------ physics/rrtmgp_sw_rte.meta | 9 --------- 8 files changed, 35 insertions(+), 85 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 38b9530b0..103d88274 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -33,7 +33,7 @@ end subroutine GFS_rrtmgp_lw_post_init subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statein, im, & p_lev, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky,& raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, & - flxprf_lw, hlw0, errmsg, errflg) + flxprf_lw, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -66,7 +66,8 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei cld_frac, & ! Total cloud fraction in each layer cldtaulw ! approx 10.mu band layer cloud optical depth real(kind_phys),dimension(size(Grid%xlon,1), Model%levs) :: & - hlwc ! Longwave all-sky heating-rate (K/sec) + hlwc, & ! Longwave all-sky heating-rate (K/sec) + hlw0 ! Longwave clear-sky heating-rate (K/sec) ! Outputs (mandatory) character(len=*), intent(out) :: & @@ -81,8 +82,6 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei Diag ! Fortran DDT: FV3-GFS diagnotics data ! Outputs (optional) - real(kind_phys), dimension(size(Grid%xlon,1), Model%levs), optional, intent(inout) :: & - hlw0 ! Longwave clear-sky heating rate (K/sec) type(proflw_type), dimension(size(Grid%xlon,1), Model%levs+1), optional, intent(inout) :: & flxprf_lw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) @@ -92,7 +91,7 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! Local variables integer :: i, j, k, iSFC, iTOA, itop, ibtc - logical :: l_clrskylw_hr, l_fluxeslw2d, top_at_1 + logical :: l_fluxeslw2d, top_at_1 real(kind_phys) :: tem0d, tem1, tem2 ! Initialize CCPP error handling variables @@ -102,7 +101,6 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei if (.not. Model%lslwr) return ! Are any optional outputs requested? - l_clrskylw_hr = present(hlw0) l_fluxeslw2d = present(flxprf_lw) ! ####################################################################################### @@ -122,7 +120,7 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! ####################################################################################### if (Model%lslwr) then ! Clear-sky heating-rate (optional) - if (l_clrskylw_hr) then + if (Model%lwhtr) then call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & fluxlwUP_clrsky, & ! IN - RRTMGP upward longwave clear-sky flux profiles (W/m2) fluxlwDOWN_clrsky, & ! IN - RRTMGP downward longwave clear-sky flux profiles (W/m2) diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 3eb1e0953..dbe96120d 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -180,15 +180,6 @@ type = proflw_type intent = inout optional = T -[hlw0] - standard_name = RRTMGP_lw_heating_rate_clear_sky - long_name = RRTMGP longwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 7d4e6ba6b..a5e9de512 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -30,7 +30,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein nCol, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, & sw_gas_props, nday, idxday, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, & fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, mtopa, cld_frac, cldtausw, flxprf_sw,& - hsw0, errmsg, errflg) + errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -77,7 +77,8 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein cld_frac, & ! Total cloud fraction in each layer cldtausw ! approx .55mu band layer cloud optical depth real(kind_phys),dimension(nCol, Model%levs) :: & - hswc ! All-sky heating rates (K/s) + hswc, & ! All-sky heating rate (K/s) + hsw0 ! Clear-sky heating rate (K/s) ! Outputs (mandatory) character(len=*), intent(out) :: & @@ -86,8 +87,6 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein errflg ! Outputs (optional) - real(kind_phys), dimension(nCol, Model%levs), optional, intent(inout) :: & - hsw0 ! Shortwave clear-sky heating-rate (K/sec) type(profsw_type), dimension(nCol, Model%levs+1), intent(inout), optional :: & flxprf_sw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) @@ -106,7 +105,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein integer :: i, j, k, iSFC, iTOA, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 real(kind_phys), dimension(nDay, Model%levs) :: thetaTendClrSky, thetaTendAllSky - logical :: l_clrskysw_hr, l_fluxessw2d, top_at_1, l_sfcFluxessw1D + logical :: l_fluxessw2d, top_at_1, l_sfcFluxessw1D ! Initialize CCPP error handling variables errmsg = '' @@ -116,7 +115,6 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein if (nDay .gt. 0) then ! Are any optional outputs requested? - l_clrskysw_hr = present(hsw0) l_fluxessw2d = present(flxprf_sw) l_sfcfluxessw1D = present(scmpsw) @@ -136,7 +134,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! Compute SW heating-rates ! ####################################################################################### ! Clear-sky heating-rate (optional) - if (l_clrskysw_HR) then + if (Model%swhtr) then call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & fluxswUP_clrsky(idxday(1:nDay),:), & ! IN - Shortwave upward clear-sky flux profiles (W/m2) fluxswDOWN_clrsky(idxday(1:nDay),:), & ! IN - Shortwave downward clear-sky flux profiles (W/m2) diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index a933cba89..a817d9332 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -239,15 +239,6 @@ type = profsw_type intent = inout optional = T -[hsw0] - standard_name = RRTMGP_sw_heating_rate_clear_sky - long_name = RRTMGP shortwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 80848a363..0fbe68d5a 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -32,7 +32,7 @@ end subroutine rrtmgp_lw_rte_init subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, & sfc_emiss_byband, sources, lw_optical_props_clrsky, lw_optical_props_clouds, & lw_optical_props_aerosol, secdiff, nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky,& - fluxlwUP_clrsky, fluxlwDOWN_clrsky, hlw0, hlwb, errmsg, errflg) + fluxlwUP_clrsky, fluxlwDOWN_clrsky, hlwb, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -75,8 +75,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g ! Outputs (optional) real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()), optional, intent(inout) :: & hlwb ! All-sky heating rate, by band (K/sec) - real(kind_phys), dimension(ncol,nLev), optional, intent(inout) :: & - hlw0 ! Clear-sky heating rate (K/sec) ! Local variables integer :: & @@ -86,7 +84,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky logical :: & - l_ClrSky_HR, l_AllSky_HR_byband, top_at_1 + l_AllSky_HR_byband, top_at_1 ! Initialize CCPP error handling variables errmsg = '' @@ -98,7 +96,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) ! Are any optional outputs requested? Need to know now to compute correct fluxes. - l_ClrSky_HR = present(hlw0) l_AllSky_HR_byband = present(hlwb) ! Initialize RRTMGP DDT containing 2D(3D) fluxes @@ -121,18 +118,16 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g enddo ! Call RTE solver - if (l_ClrSky_HR) then - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles)) - ! Store fluxes - fluxlwUP_clrsky = sum(flux_clrsky%bnd_flux_up,dim=3) - fluxlwDOWN_clrsky = sum(flux_clrsky%bnd_flux_dn,dim=3) - endif + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles)) + ! Store fluxes + fluxlwUP_clrsky = sum(flux_clrsky%bnd_flux_up,dim=3) + fluxlwDOWN_clrsky = sum(flux_clrsky%bnd_flux_dn,dim=3) ! ! All-sky fluxes diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index e85a607fa..a8426bc15 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -118,15 +118,6 @@ type = ty_source_func_lw intent = in optional = F -[hlw0] - standard_name = RRTMGP_lw_heating_rate_clear_sky - long_name = RRTMGP longwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = T [hlwb] standard_name = RRTMGP_lw_heating_rate_spectral long_name = RRTMGP longwave total sky heating rate (spectral) diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 71b7e20ee..98f95a1bd 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -32,7 +32,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t p_lev, sw_gas_props, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif, & sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, sw_optical_props_clouds, & sw_optical_props_aerosol, rrtmgp_nGases, active_gases_array, scmpsw, fluxswUP_allsky, & - fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, hsw0, hswb, errmsg, errflg) + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, hswb, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -70,8 +70,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t active_gases_array ! Character array containing trace gases to include in RRTMGP ! Inputs (optional) (NOTE. We only need the optional arguments to know what fluxes to output, HR's are computed later) - real(kind_phys), dimension(ncol,NLev), optional, intent(inout) :: & - hsw0 ! Clear-sky heating rate (K/sec) real(kind_phys), dimension(ncol,NLev,sw_gas_props%get_nband()), intent(inout), optional :: & hswb ! All-sky heating rate, by band (K/sec) @@ -105,7 +103,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t real(kind_phys), dimension(nday,NLev+1,sw_gas_props%get_nband()),target :: & fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky, fluxSW_dn_dir_allsky real(kind_phys), dimension(ncol,NLev) :: vmrTemp - logical :: l_ClrSky_HR=.false., l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 + logical :: l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 integer :: iGas,iSFC,iTOA,iBand ! Initialize CCPP error handling variables @@ -133,7 +131,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t endif ! Are any optional outputs requested? Need to know now to compute correct fluxes. - l_ClrSky_HR = present(hsw0) l_AllSky_HR_byband = present(hswb) l_scmpsw = present(scmpsw) if ( l_scmpsw ) then @@ -173,19 +170,17 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_aerosol%increment(sw_optical_props_clrsky)) ! Delta-scale optical properties call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clrsky%delta_scale()) - if (l_ClrSky_HR) then - call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & - sw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - coszen(idxday(1:nday)), & ! IN - Cosine of solar zenith angle - toa_src_sw(idxday(1:nday),:), & ! IN - incident solar flux at TOA - sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) - sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,NLev,nBand) - ! Store fluxes - fluxswUP_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_up,dim=3) - fluxswDOWN_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_dn,dim=3) - endif + call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & + sw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(idxday(1:nday)), & ! IN - Cosine of solar zenith angle + toa_src_sw(idxday(1:nday),:), & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,NLev,nBand) + ! Store fluxes + fluxswUP_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_up,dim=3) + fluxswDOWN_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_dn,dim=3) ! Compute all-sky fluxes ! All-sky fluxes (clear-sky + clouds) diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 8ae7421c3..629ede530 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -215,15 +215,6 @@ kind = kind_phys intent = inout optional = F -[hsw0] - standard_name = RRTMGP_sw_heating_rate_clear_sky - long_name = shortwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T [hswb] standard_name = RRTMGP_sw_heating_rate_spectral long_name = shortwave total sky heating rate (spectral) From f143b81eefed08706757a11b1e11cd085ab8aa75 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 24 Mar 2020 09:26:25 -0600 Subject: [PATCH 058/141] Updates of CCPP code to regain bit-for-bit identical results for coupled model runs --- physics/GFS_MP_generic.F90 | 10 +++--- physics/GFS_PBL_generic.F90 | 21 ++++++----- physics/GFS_debug.F90 | 24 +++++++++++-- physics/GFS_suite_interstitial.F90 | 14 ++++---- physics/GFS_surface_composites.F90 | 56 ++++++++++++++++++------------ physics/GFS_surface_generic.F90 | 13 ++++--- physics/GFS_surface_generic.meta | 18 ++++++++++ physics/gcycle.F90 | 2 +- physics/sfc_nst.f | 12 +++---- physics/sfc_nst.meta | 18 ++++++++++ 10 files changed, 131 insertions(+), 57 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index f72f9405a..e28f535de 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -191,11 +191,11 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt end if if (lsm==lsm_ruc .or. lsm==lsm_noahmp) then - raincprv(:) = rainc(:) - rainncprv(:) = frain * rain1(:) - iceprv(:) = ice(:) - snowprv(:) = snow(:) - graupelprv(:) = graupel(:) + 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). diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index a440836e1..ff59aa465 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -331,7 +331,10 @@ 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 + real(kind=kind_phys), parameter :: zero = 0.0d0 + real(kind=kind_phys), parameter :: one = 1.0d0 + real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90 + real(kind=kind_phys), parameter :: epsln = 1.0d-10 ! same as in GFS_physics_driver.F90 integer :: i, k, kk, k1, n real(kind=kind_phys) :: tem, tem1, rho @@ -486,7 +489,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if (cplchm) then do i = 1, im tem1 = max(q1(i), 1.e-8) - tem = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) + tem = prsl(i,1) / (rd*t1(i)*(one+fvirt*tem1)) ushfsfci(i) = -cp * tem * hflx(i) ! upward sensible heat flux enddo ! dkt_cpl has dimensions (1:im,1:levs), but dkt has (1:im,1:levs-1) @@ -498,22 +501,22 @@ 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) > 1.-epsln) then ! no open water, use results from CICE + if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES + if (fice(i) > one - 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 + elseif (icy(i) .or. dry(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 + rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*tem1)) + if (wind(i) > zero) 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 + dusfci_cpl(i) = zero + dvsfci_cpl(i) = zero 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 diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index df56cc069..6bf39d491 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -402,7 +402,12 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%rain_cpl', Coupling%rain_cpl) call print_var(mpirank,omprank, blkno, 'Coupling%snow_cpl', Coupling%snow_cpl) end if + if (Model%cplwav2atm) then + call print_var(mpirank,omprank, blkno, 'Coupling%zorlwav_cpl' , Coupling%zorlwav_cpl ) + end if if (Model%cplflx) then + call print_var(mpirank,omprank, blkno, 'Coupling%oro_cpl' , Coupling%oro_cpl ) + call print_var(mpirank,omprank, blkno, 'Coupling%slmsk_cpl' , Coupling%slmsk_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%slimskin_cpl', Coupling%slimskin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dusfcin_cpl ', Coupling%dusfcin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dvsfcin_cpl ', Coupling%dvsfcin_cpl ) @@ -466,11 +471,24 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%shum_wts', Coupling%shum_wts) end if if (Model%do_skeb) then - call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts) - call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts) + call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts ) + call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts ) end if if (Model%do_sfcperts) then - call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts', Coupling%sfc_wts) + call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts' , Coupling%sfc_wts ) + end if + if (Model%do_ca) then + call print_var(mpirank,omprank, blkno, 'Coupling%tconvtend', Coupling%tconvtend ) + call print_var(mpirank,omprank, blkno, 'Coupling%qconvtend', Coupling%qconvtend ) + call print_var(mpirank,omprank, blkno, 'Coupling%uconvtend', Coupling%uconvtend ) + call print_var(mpirank,omprank, blkno, 'Coupling%vconvtend', Coupling%vconvtend ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_out ', Coupling%ca_out ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_deep ', Coupling%ca_deep ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_turb ', Coupling%ca_turb ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_shal ', Coupling%ca_shal ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_rad ', Coupling%ca_rad ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_micro ', Coupling%ca_micro ) + call print_var(mpirank,omprank, blkno, 'Coupling%cape ', Coupling%cape ) end if if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then call print_var(mpirank,omprank, blkno, 'Coupling%nwfa2d', Coupling%nwfa2d) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 8abaf24b7..935dd9430 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -228,15 +228,15 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl if (frac_grid) then do i=1,im - tem = one - cice(i) - frland(i) + tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell if (flag_cice(i)) then - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + ulwsfc_cice(i) * cice(i) & - + adjsfculw_ocn(i) * tem + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + ulwsfc_cice(i) * tem & + + adjsfculw_ocn(i) * (one - frland(i) - tem) else - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + adjsfculw_ice(i) * cice(i) & - + adjsfculw_ocn(i) * tem + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + adjsfculw_ice(i) * tem & + + adjsfculw_ocn(i) * (one - frland(i) - tem) endif enddo else diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 6cca60ccf..b6d833796 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -89,7 +89,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl endif endif if (cice(i) < one ) then - wet(i)=.true. !there is some open ocean/lake water! + wet(i)=.true. ! some open ocean/lake water exists if (.not. cplflx) tsfco(i) = max(tsfco(i), tisfc(i), tgice) end if else @@ -414,7 +414,7 @@ subroutine GFS_surface_composites_post_run ( fm10(i) = fm10_lnd(i) fh2(i) = fh2_lnd(i) !tsurf(i) = tsurf_lnd(i) - tsfcl(i) = tsfc_lnd(i) + tsfcl(i) = tsfc_lnd(i) ! over land cmm(i) = cmm_lnd(i) chh(i) = chh_lnd(i) gflx(i) = gflx_lnd(i) @@ -426,9 +426,9 @@ subroutine GFS_surface_composites_post_run ( hflx(i) = hflx_lnd(i) qss(i) = qss_lnd(i) tsfc(i) = tsfc_lnd(i) - hice(i) = zero - cice(i) = zero - tisfc(i) = tsfc(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) @@ -441,7 +441,7 @@ subroutine GFS_surface_composites_post_run ( fm10(i) = fm10_ocn(i) fh2(i) = fh2_ocn(i) !tsurf(i) = tsurf_ocn(i) - tsfco(i) = tsfc_ocn(i) + tsfco(i) = tsfc_ocn(i) ! over lake (and ocean when uncoupled) cmm(i) = cmm_ocn(i) chh(i) = chh_ocn(i) gflx(i) = gflx_ocn(i) @@ -453,10 +453,10 @@ subroutine GFS_surface_composites_post_run ( hflx(i) = hflx_ocn(i) qss(i) = qss_ocn(i) tsfc(i) = tsfc_ocn(i) - hice(i) = zero - cice(i) = zero - tisfc(i) = tsfc(i) - else + !hice(i) = zero + !cice(i) = zero + !tisfc(i) = tsfc(i) + else ! islmsk(i) == 2 zorl(i) = zorl_ice(i) cd(i) = cd_ice(i) cdq(i) = cdq_ice(i) @@ -468,30 +468,42 @@ subroutine GFS_surface_composites_post_run ( 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) ! over lake ice (and sea ice when uncoupled) + endif 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) qss(i) = qss_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 + evap(i) = evap_ice(i) + hflx(i) = hflx_ice(i) + qss(i) = qss_ice(i) + tsfc(i) = tsfc_ice(i) endif zorll(i) = zorl_lnd(i) zorlo(i) = zorl_ocn(i) + if (flag_cice(i) .and. wet(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 + if (islmsk(i) == 2) then + tisfc(i) = tice(i) + else ! over open ocean or land (no ice fraction) + hice(i) = zero + cice(i) = zero + tisfc(i) = tsfc(i) + endif + endif + enddo endif ! if (frac_grid) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 108d3bee7..98653a052 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -33,7 +33,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, 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, & - wind, u1, v1, cnvwind, errmsg, errflg) + wind, u1, v1, cnvwind, smcwlt2, smcref2, errmsg, errflg) use surface_perturbation, only: cdfnor @@ -87,6 +87,8 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(in ) :: u1, v1 ! surface wind enhancement due to convection real(kind=kind_phys), dimension(im), intent(inout ) :: cnvwind + ! + real(kind=kind_phys), dimension(im), intent(out) :: smcwlt2, smcref2 ! CCPP error handling character(len=*), intent(out) :: errmsg @@ -173,7 +175,10 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, work3(i) = prsik_1(i) / prslk_1(i) !tsurf(i) = tsfc(i) - zlvl(i) = phil(i,1) * onebg + zlvl(i) = phil(i,1) * onebg + smcwlt2(i) = zero + smcref2(i) = zero + wind(i) = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & + max(zero, min(cnvwind(i), 30.0)), one) !wind(i) = max(sqrt(Statein%ugrs(i,1)*Statein%ugrs(i,1) + & @@ -303,8 +308,8 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt nlwsfc_cpl (i) = nlwsfc_cpl(i) + nlwsfci_cpl(i)*dtf t2mi_cpl (i) = t2m(i) q2mi_cpl (i) = q2m(i) -! tsfci_cpl (i) = tsfc(i) - tsfci_cpl (i) = tsfc_ocn(i) + tsfci_cpl (i) = tsfc(i) +! tsfci_cpl (i) = tsfc_ocn(i) psurfi_cpl (i) = pgr(i) enddo diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 6bd18a3b8..d82928d9c 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -545,6 +545,24 @@ kind = kind_phys intent = inout optional = F +[smcwlt2] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = wilting point (volumetric) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[smcref2] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold (volumetric) + units = frac + 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 diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index bb1730fc2..8c5dd041a 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -200,7 +200,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) 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)%xz(ix) ! Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & ! + dt_warm - Sfcprop(nb)%dt_cool(ix) ! endif diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index ed6387afb..3d0507ad9 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -676,7 +676,7 @@ end subroutine sfc_nst_pre_finalize !! @{ subroutine sfc_nst_pre_run & (im, wet, tsfc_ocn, tsurf_ocn, tseal, xt, xz, dt_cool, - & z_c, tref, cplflx, errmsg, errflg) + & z_c, tref, cplflx, oceanfrac, errmsg, errflg) use machine , only : kind_phys @@ -686,7 +686,7 @@ subroutine sfc_nst_pre_run integer, intent(in) :: im logical, dimension(im), intent(in) :: wet real (kind=kind_phys), dimension(im), intent(in) :: - & tsfc_ocn, xt, xz, dt_cool, z_c + & tsfc_ocn, xt, xz, dt_cool, z_c, oceanfrac logical, intent(in) :: cplflx ! --- input/outputs: @@ -724,7 +724,7 @@ subroutine sfc_nst_pre_run if (cplflx) then tem1 = half / omz1 do i=1,im - if (wet(i)) then + if (wet(i) .and. oceanfrac(i) > zero) then tem2 = one / xz(i) dt_warm = (xt(i)+xt(i)) * tem2 if ( xz(i) > omz1) then @@ -777,7 +777,7 @@ end subroutine sfc_nst_post_finalize ! \section NSST_detailed_post_algorithm Detailed Algorithm ! @{ subroutine sfc_nst_post_run & - & ( im, rlapse, wet, icy, oro, oro_uf, nstf_name1, & + & ( im, rlapse, tgice, wet, icy, oro, oro_uf, nstf_name1, & & nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & & tsurf_ocn, tsfc_ocn, dtzm, errmsg, errflg & & ) @@ -790,7 +790,7 @@ subroutine sfc_nst_post_run & ! --- inputs: integer, intent(in) :: im logical, dimension(im), intent(in) :: wet, icy - real (kind=kind_phys), intent(in) :: rlapse + real (kind=kind_phys), intent(in) :: rlapse, tgice real (kind=kind_phys), dimension(im), intent(in) :: oro, oro_uf integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 real (kind=kind_phys), dimension(im), intent(in) :: xt, xz, & @@ -838,7 +838,7 @@ subroutine sfc_nst_post_run & ! if (wet(i) .and. .not.icy(i)) then ! if (wet(i) .and. (Model%frac_grid .or. .not. icy(i))) then if (wet(i)) then - tsfc_ocn(i) = max(271.2, tref(i) + dtzm(i)) + tsfc_ocn(i) = max(tgice, tref(i) + dtzm(i)) ! tsfc_ocn(i) = max(271.2, tref(i) + dtzm(i)) - & ! (oro(i)-oro_uf(i))*rlapse endif diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index d74f68c0e..ac75aa05d 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -759,6 +759,15 @@ type = logical intent = in optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -808,6 +817,15 @@ kind = kind_phys intent = in optional = F +[tgice] + standard_name = freezing_point_temperature_of_seawater + long_name = freezing point temperature of seawater + units = K + dimensions = () + type = real + kind = kind_phys + 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 From 091d47524aedd7e62d5e26afc4da85e7cdd45a1c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 24 Mar 2020 16:50:33 -0600 Subject: [PATCH 059/141] physics/GFS_stochastics.F90: update comment --- physics/GFS_stochastics.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index 2a6552f18..99f84e3b1 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -79,10 +79,10 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, real(kind_phys), dimension(1:im), intent(inout) :: totprcpb real(kind_phys), dimension(1:im), intent(inout) :: cnvprcpb logical, intent(in) :: cplflx - ! rain_cpl, snow_cpl only allocated if cplflx == .true. or do_sppt == .true. + ! rain_cpl, snow_cpl only allocated if cplflx == .true. or cplchm == .true. real(kind_phys), dimension(:), intent(inout) :: rain_cpl real(kind_phys), dimension(:), intent(inout) :: snow_cpl - ! drain_cpl, dsnow_cpl only allocated if do_sppt == .true. + ! drain_cpl, dsnow_cpl only allocated if cplflx == .true. or cplchm == .true. real(kind_phys), dimension(:), intent(in) :: drain_cpl real(kind_phys), dimension(:), intent(in) :: dsnow_cpl ! tconvtend ... vconvtend only allocated if isppt_deep == .true. From 1e43ed68c372cfbe30702ad038f3b74f1db132b0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 25 Mar 2020 11:14:18 -0600 Subject: [PATCH 060/141] physics/GFS_rrtmgp_sw_post.F90: bugfix, reset heating rate arrays --- physics/GFS_rrtmgp_sw_post.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index a5e9de512..cf477467a 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -135,6 +135,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! ####################################################################################### ! Clear-sky heating-rate (optional) if (Model%swhtr) then + hsw0(:,:) = 0._kind_phys call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & fluxswUP_clrsky(idxday(1:nDay),:), & ! IN - Shortwave upward clear-sky flux profiles (W/m2) fluxswDOWN_clrsky(idxday(1:nDay),:), & ! IN - Shortwave downward clear-sky flux profiles (W/m2) @@ -144,6 +145,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein endif ! All-sky heating-rate (mandatory) + hswc(:,:) = 0._kind_phys call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & fluxswUP_allsky(idxday(1:nDay),:), & ! IN - Shortwave upward all-sky flux profiles (W/m2) fluxswDOWN_allsky(idxday(1:nDay),:), & ! IN - Shortwave downward all-sky flux profiles (W/m2) From bde224d6e0c3b092a91e3518ea3a1b238d22a4c7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 25 Mar 2020 13:17:08 -0600 Subject: [PATCH 061/141] Remove interstitial variables for seaice coupling --- physics/GFS_PBL_generic.meta | 16 +++--- physics/GFS_surface_generic.F90 | 20 ++----- physics/GFS_surface_generic.meta | 90 -------------------------------- physics/sfc_cice.meta | 16 +++--- 4 files changed, 20 insertions(+), 122 deletions(-) diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 51764e04d..2319f0044 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -1089,8 +1089,8 @@ intent = in optional = F [dusfc_cice] - standard_name = surface_x_momentum_flux_for_coupling_interstitial - long_name = sfc x momentum flux for coupling interstitial + standard_name = surface_x_momentum_flux_for_coupling + long_name = sfc x momentum flux for coupling units = Pa dimensions = (horizontal_dimension) type = real @@ -1098,8 +1098,8 @@ intent = in optional = F [dvsfc_cice] - standard_name = surface_y_momentum_flux_for_coupling_interstitial - long_name = sfc y momentum flux for coupling interstitial + standard_name = surface_y_momentum_flux_for_coupling + long_name = sfc y momentum flux for coupling units = Pa dimensions = (horizontal_dimension) type = real @@ -1107,8 +1107,8 @@ intent = in optional = F [dtsfc_cice] - standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial - long_name = sfc sensible heat flux for coupling interstitial + standard_name = surface_upward_sensible_heat_flux_for_coupling + long_name = sfc sensible heat flux for coupling units = W m-2 dimensions = (horizontal_dimension) type = real @@ -1116,8 +1116,8 @@ intent = in optional = F [dqsfc_cice] - standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial - long_name = sfc latent heat flux for coupling interstitial + standard_name = surface_upward_latent_heat_flux_for_coupling + long_name = sfc latent heat flux for coupling units = W m-2 dimensions = (horizontal_dimension) type = real diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 98653a052..3b52677a9 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -30,9 +30,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, dtdtr, & drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, do_sfcperts, nsfcpert, sfc_wts, & 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, & + cplflx, flag_cice, islmsk_cice, slimskin_cpl, tisfc, tsfco, fice, hice, & wind, u1, v1, cnvwind, smcwlt2, smcref2, errmsg, errflg) use surface_perturbation, only: cdfnor @@ -76,12 +74,9 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, logical, intent(in) :: cplflx real(kind=kind_phys), dimension(im), intent(in) :: slimskin_cpl logical, dimension(im), intent(inout) :: flag_cice - integer, dimension(im), intent(out) :: islmsk_cice - real(kind=kind_phys), dimension(im), intent(in) ::ulwsfcin_cpl, & - dusfcin_cpl, dvsfcin_cpl, dtsfcin_cpl, dqsfcin_cpl, & + integer, dimension(im), intent(out) :: islmsk_cice + real(kind=kind_phys), dimension(im), intent(in) :: & tisfc, tsfco, fice, hice - real(kind=kind_phys), dimension(im), intent(out) ::ulwsfc_cice, & - dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice real(kind=kind_phys), dimension(im), intent(out) :: wind real(kind=kind_phys), dimension(im), intent(in ) :: u1, v1 @@ -191,14 +186,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, if (cplflx) then do i=1,im islmsk_cice(i) = nint(slimskin_cpl(i)) - if(islmsk_cice(i) == 4)then - flag_cice(i) = .true. - ulwsfc_cice(i) = ulwsfcin_cpl(i) - dusfc_cice(i) = dusfcin_cpl(i) - dvsfc_cice(i) = dvsfcin_cpl(i) - dtsfc_cice(i) = dtsfcin_cpl(i) - dqsfc_cice(i) = dqsfcin_cpl(i) - endif + flag_cice(i) = (islmsk_cice(i) == 4) enddo endif diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index d82928d9c..250f7a2bd 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -383,96 +383,6 @@ kind = kind_phys intent = in optional = F -[dusfcin_cpl] - standard_name = surface_x_momentum_flux_for_coupling - long_name = sfc x momentum flux for coupling - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dvsfcin_cpl] - standard_name = surface_y_momentum_flux_for_coupling - long_name = sfc y momentum flux for coupling - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dtsfcin_cpl] - standard_name = surface_upward_sensible_heat_flux_for_coupling - long_name = sfc sensible heat flux input - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dqsfcin_cpl] - standard_name = surface_upward_latent_heat_flux_for_coupling - long_name = sfc latent heat flux input for coupling - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ulwsfcin_cpl] - standard_name = surface_upwelling_longwave_flux_for_coupling - long_name = surface upwelling LW flux for coupling - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ulwsfc_cice] - standard_name = surface_upwelling_longwave_flux_for_coupling_interstitial - long_name = surface upwelling longwave flux for coupling interstitial - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dusfc_cice] - standard_name = surface_x_momentum_flux_for_coupling_interstitial - long_name = sfc x momentum flux for coupling interstitial - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dvsfc_cice] - standard_name = surface_y_momentum_flux_for_coupling_interstitial - long_name = sfc y momentum flux for coupling interstitial - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dtsfc_cice] - standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial - long_name = sfc sensible heat flux for coupling interstitial - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dqsfc_cice] - standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial - long_name = sfc latent heat flux for coupling interstitial - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F [tisfc] standard_name = sea_ice_temperature long_name = sea-ice surface temperature diff --git a/physics/sfc_cice.meta b/physics/sfc_cice.meta index 543e4d78b..a1c57d4d9 100644 --- a/physics/sfc_cice.meta +++ b/physics/sfc_cice.meta @@ -124,8 +124,8 @@ intent = in optional = F [dqsfc] - standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial - long_name = sfc latent heat flux for coupling interstitial + standard_name = surface_upward_latent_heat_flux_for_coupling + long_name = sfc latent heat flux for coupling units = W m-2 dimensions = (horizontal_dimension) type = real @@ -133,8 +133,8 @@ intent = in optional = F [dtsfc] - standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial - long_name = sfc sensible heat flux for coupling interstitial + standard_name = surface_upward_sensible_heat_flux_for_coupling + long_name = sfc sensible heat flux for coupling units = W m-2 dimensions = (horizontal_dimension) type = real @@ -142,8 +142,8 @@ intent = in optional = F [dusfc] - standard_name = surface_x_momentum_flux_for_coupling_interstitial - long_name = sfc x momentum flux for coupling interstitial + standard_name = surface_x_momentum_flux_for_coupling + long_name = sfc x momentum flux for coupling units = Pa dimensions = (horizontal_dimension) type = real @@ -151,8 +151,8 @@ intent = in optional = F [dvsfc] - standard_name = surface_y_momentum_flux_for_coupling_interstitial - long_name = sfc y momentum flux for coupling interstitial + standard_name = surface_y_momentum_flux_for_coupling + long_name = sfc y momentum flux for coupling units = Pa dimensions = (horizontal_dimension) type = real From 47713ac7cd1cd75cc9f74ca6dc109f8af29a0d5e Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Wed, 25 Mar 2020 16:01:37 -0400 Subject: [PATCH 062/141] bugs fixed in MG3_v1 m_micro.F90 --- physics/m_micro.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index a2eb5296f..83ff8d554 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -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 - logical,intent(in) :: flipv, skip_macro, lprnt + integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag + logical,intent(in) :: flipv, skip_macro integer,intent(in) :: iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) From 5c134c17d88f9ed008e0e4c0bbab392b2c1f4d13 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 25 Mar 2020 14:10:44 -0600 Subject: [PATCH 063/141] physics/GFS_surface_generic.F90: remove old code that no longer exists in IPD --- physics/GFS_surface_generic.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 3b52677a9..ac366ae54 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -104,10 +104,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, ! Set initial quantities for stochastic physics deltas if (do_sppt) then dtdtr = 0.0 - do i=1,im - drain_cpl(i) = rain_cpl (i) - dsnow_cpl(i) = snow_cpl (i) - enddo endif ! Scale random patterns for surface perturbations with perturbation size From ba6150331327c1344b347c3fd71f4429f9ad7ffc Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 26 Mar 2020 10:08:49 -0600 Subject: [PATCH 064/141] Bugfixes and updates based on code review --- physics/GFS_rrtmgp_pre.F90 | 2 +- physics/GFS_rrtmgp_setup.F90 | 17 +++++++++-------- physics/GFS_rrtmgp_sw_post.F90 | 2 +- physics/rrtmgp_aux.F90 | 10 ---------- physics/rrtmgp_lw_cloud_sampling.F90 | 4 ++-- physics/rrtmgp_lw_gas_optics.F90 | 4 ++-- physics/rrtmgp_lw_pre.F90 | 2 +- physics/rrtmgp_lw_rte.F90 | 2 +- physics/rrtmgp_sw_aerosol_optics.F90 | 2 +- 9 files changed, 18 insertions(+), 27 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index cb2b79410..1344f269c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -182,7 +182,7 @@ end subroutine GFS_rrtmgp_pre_init ! SUBROUTINE GFS_rrtmgp_pre_run ! ######################################################################################### !> \section arg_table_GFS_rrtmgp_pre_run -!! \htmlinclude GFS_rrtmgp_pre.html +!! \htmlinclude GFS_rrtmgp_pre_run.html !! subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN ncol, lw_gas_props, active_gases_array, & ! IN diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 42ce8662c..45bc4397b 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -37,7 +37,7 @@ module GFS_rrtmgp_setup !> \defgroup GFS_rrtmgp_setup GFS RRTMGP Scheme Setup !! @{ !! \section arg_table_GFS_rrtmgp_setup_init -!! \htmlinclude GFS_rrtmgp_setup.html +!! \htmlinclude GFS_rrtmgp_setup_init.html !! subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & iaer, ialb, iems, ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, & @@ -91,8 +91,9 @@ subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & endif iaermdl = iaer/1000 ! control flag for aerosol scheme selection if ( iaermdl < 0 .or. (iaermdl>2 .and. iaermdl/=5) ) then - print *, ' Error -- IAER flag is incorrect, Abort' - stop 7777 + errmsg = trim(errmsg) // ' Error -- IAER flag is incorrect, Abort' + errflg = 1 + return endif !if ( ntcw > 0 ) then @@ -135,7 +136,7 @@ subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & end subroutine GFS_rrtmgp_setup_init !> \section arg_table_GFS_rrtmgp_setup_run -!! \htmlinclude GFS_rrtmgp_setup.html +!! \htmlinclude GFS_rrtmgp_setup_run.html !! subroutine GFS_rrtmgp_setup_run (idate, jdate, deltsw, deltim, lsswr, me, & slag, sdec, cdec, solcon, errmsg, errflg) @@ -171,10 +172,10 @@ subroutine GFS_rrtmgp_setup_run (idate, jdate, deltsw, deltim, lsswr, me, & slag,sdec,cdec,solcon) end subroutine GFS_rrtmgp_setup_run - - !> \section arg_table_GFS_rrtmgp_setup_finalize - !! \htmlinclude GFS_rrtmgp_setup.html - !! + +!> \section arg_table_GFS_rrtmgp_setup_finalize +!! \htmlinclude GFS_rrtmgp_setup_finalize.html +!! subroutine GFS_rrtmgp_setup_finalize (errmsg, errflg) implicit none diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index cf477467a..4e9f8a33f 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -24,7 +24,7 @@ end subroutine GFS_rrtmgp_sw_post_init ! SUBROUTINE GFS_rrtmgp_sw_post_run ! ######################################################################################### !> \section arg_table_GFS_rrtmgp_sw_post_run -!! \htmlinclude GFS_rrtmgp_sw_post.html +!! \htmlinclude GFS_rrtmgp_sw_post_run.html !! subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein, scmpsw, & nCol, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, & diff --git a/physics/rrtmgp_aux.F90 b/physics/rrtmgp_aux.F90 index 0ee837b97..d39705e7a 100644 --- a/physics/rrtmgp_aux.F90 +++ b/physics/rrtmgp_aux.F90 @@ -7,16 +7,6 @@ module rrtmgp_aux rrtmgp_minP, & ! Minimum pressure allowed in RRTMGP rrtmgp_minT ! Minimum temperature allowed in RRTMGP contains - ! - subroutine rrtmgp_aux_init() - end subroutine rrtmgp_aux_init - ! - subroutine rrtmgp_aux_run() - end subroutine rrtmgp_aux_run - ! - subroutine rrtmgp_aux_finalize() - end subroutine rrtmgp_aux_finalize - ! ######################################################################################### ! SUBROUTINE check_error_msg ! ######################################################################################### diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index dca566923..e42336923 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -16,7 +16,7 @@ module rrtmgp_lw_cloud_sampling ! SUBROUTINE mcica_init ! ######################################################################################### !! \section arg_table_rrtmgp_lw_cloud_sampling_init -!! \htmlinclude rrtmgp_lw_cloud_sampling.html +!! \htmlinclude rrtmgp_lw_cloud_sampling_init.html !! subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0) ! Inputs @@ -35,7 +35,7 @@ end subroutine rrtmgp_lw_cloud_sampling_init ! SUBROTUINE rrtmgp_lw_cloud_sampling_run() ! ######################################################################################### !! \section arg_table_rrtmgp_lw_cloud_sampling_run -!! \htmlinclude rrtmgp_lw_cloud_sampling.html +!! \htmlinclude rrtmgp_lw_cloud_sampling_run.html !! subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, cld_frac,& lw_gas_props, lw_optical_props_cloudsByBand, lw_optical_props_clouds, errmsg, errflg) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index c94df2a2f..408cc48f5 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -17,7 +17,7 @@ module rrtmgp_lw_gas_optics ! SUBROUTINE rrtmgp_sw_gas_optics_init ! ######################################################################################### !! \section arg_table_rrtmgp_lw_gas_optics_init -!! \htmlinclude rrtmgp_lw_gas_optics.html +!! \htmlinclude rrtmgp_lw_gas_optics_init.html !! subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_nGases, & active_gases_array, mpicomm, mpirank, mpiroot, lw_gas_props, errmsg, errflg) @@ -272,7 +272,7 @@ end subroutine rrtmgp_lw_gas_optics_init ! SUBROUTINE rrtmgp_lw_gas_optics_run ! ######################################################################################### !! \section arg_table_rrtmgp_lw_gas_optics_run -!! \htmlinclude rrtmgp_lw_gas_optics.html +!! \htmlinclude rrtmgp_lw_gas_optics_run.html !! subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_lev, t_lay,& t_lev, skt, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index d93b6a619..1148c6705 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -29,7 +29,7 @@ end subroutine rrtmgp_lw_pre_init ! SUBROUTINE rrtmgp_lw_pre_run ! ######################################################################################### !> \section arg_table_rrtmgp_lw_pre_run -!! \htmlinclude rrtmgp_lw_pre.html +!! \htmlinclude rrtmgp_lw_pre_run.html !! subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, tsfc, & hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 0fbe68d5a..583fa9ee2 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -27,7 +27,7 @@ end subroutine rrtmgp_lw_rte_init ! SUBROUTINE rrtmgp_lw_rte_run ! ######################################################################################### !! \section arg_table_rrtmgp_lw_rte_run -!! \htmlinclude rrtmgp_lw_rte.html +!! \htmlinclude rrtmgp_lw_rte_run.html !! subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, & sfc_emiss_byband, sources, lw_optical_props_clrsky, lw_optical_props_clouds, & diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 index 6207a22d8..effbfae72 100644 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -26,7 +26,7 @@ end subroutine rrtmgp_sw_aerosol_optics_init ! SUBROUTINE rrtmgp_sw_aerosol_optics_run() ! ######################################################################################### !! \section arg_table_rrtmgp_sw_aerosol_optics_run -!! \htmlinclude rrtmgp_sw_aerosol_optics.html +!! \htmlinclude rrtmgp_sw_aerosol_optics_run.html !! subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxday, p_lev,& p_lay, p_lk, tv_lay, relhum, lsmask, tracer, lon, lat, lw_gas_props, sw_gas_props, & From 5a1160b6ef01659464168dee035f87459c0a334f Mon Sep 17 00:00:00 2001 From: "ligia.bernardet" Date: Tue, 31 Mar 2020 11:25:58 -0600 Subject: [PATCH 065/141] Update README file --- README.md | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 534b01a90..7047ccf3a 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,18 @@ -# GMTB GFS Physics +# CCPP Physics -This repository contains the GFS Physics scheme. +The Common Community Physics Package (CCPP) is designed to facilitate the implementation of physics innovations in state-of-the-art atmospheric models, the use of various models to develop physics, and the acceleration of transition of physics innovations to operational NOAA models. +Please see more information about the CCPP at the locations below. +- [CCPP website hosted by the Developmental Testbed Center (DTC)](https://dtcenter.org/ccpp) +- [CCPP public release information](https://dtcenter.org/community-code/common-community-physics-package-ccpp/ccpp-scm-version-4-0) +- [CCPP Technical Documentation](https://ccpp-techdoc.readthedocs.io/en/latest/) +- [CCPP Scientific Documentation](https://dtcenter.org/GMTB/v4.0/sci_doc/) +- [CCPP Physics GutHub wiki](https://github.com/NCAR/ccpp-physics/wiki) +- [CCPP Framework GitHub wiki](https://github.com/NCAR/ccpp-framework/wiki) + +For the use of CCPP with its Single Column Model, see the [Single Column Model User's Guide]. + +For the use of CCPP with NOAA's Unified Forecast System (UFS), see the [UFS Medium-Range Application User's Guide](https://ufs-mrweather-app.readthedocs.io/en/latest/) and the [UFS Weather Model User's Guide](https://ufs-weather-model.readthedocs.io/en/latest/). + +Questions can be directed to the [CCPP Help Desk](mailto:gmtb-help@ucar.edu). When using the CCPP with NOAA's UFS, questions can be posted in the [UFS Weather Model](https://forums.ufscommunity.org/forum/ufs-weather-model) section of the [UFS Forum](https://forums.ufscommunity.org/) From b95bcb3f3bbf5a610002f9c1f1eabb75dda80c12 Mon Sep 17 00:00:00 2001 From: "ligia.bernardet" Date: Tue, 31 Mar 2020 12:55:10 -0600 Subject: [PATCH 066/141] Update README file again --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 7047ccf3a..c1964c445 100644 --- a/README.md +++ b/README.md @@ -11,8 +11,8 @@ Please see more information about the CCPP at the locations below. - [CCPP Physics GutHub wiki](https://github.com/NCAR/ccpp-physics/wiki) - [CCPP Framework GitHub wiki](https://github.com/NCAR/ccpp-framework/wiki) -For the use of CCPP with its Single Column Model, see the [Single Column Model User's Guide]. +For the use of CCPP with its Single Column Model, see the [Single Column Model User's Guide](https://dtcenter.org/GMTB/v4.0/scm-ccpp-guide-v4.0.pdf). For the use of CCPP with NOAA's Unified Forecast System (UFS), see the [UFS Medium-Range Application User's Guide](https://ufs-mrweather-app.readthedocs.io/en/latest/) and the [UFS Weather Model User's Guide](https://ufs-weather-model.readthedocs.io/en/latest/). -Questions can be directed to the [CCPP Help Desk](mailto:gmtb-help@ucar.edu). When using the CCPP with NOAA's UFS, questions can be posted in the [UFS Weather Model](https://forums.ufscommunity.org/forum/ufs-weather-model) section of the [UFS Forum](https://forums.ufscommunity.org/) +Questions can be directed to the [CCPP Help Desk](mailto:gmtb-help@ucar.edu). When using the CCPP with NOAA's UFS, questions can be posted in the [UFS Weather Model](https://forums.ufscommunity.org/forum/ufs-weather-model) section of the [UFS Forum](https://forums.ufscommunity.org/) From 7fef26f375c407a3b176861dfb865b8ae7f546cb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 1 Apr 2020 10:03:27 -0600 Subject: [PATCH 067/141] Clean up of radiation tendencies standard names as described in issue https://github.com/NCAR/ccpp-physics/issues/179 --- physics/GFS_PBL_generic.meta | 4 ++-- physics/GFS_suite_interstitial.meta | 4 ++-- physics/dcyc2.meta | 8 ++++---- physics/m_micro.meta | 4 ++-- physics/module_MYNNPBL_wrapper.meta | 4 ++-- physics/moninedmf.meta | 4 ++-- physics/moninedmf_hafs.meta | 4 ++-- physics/radlw_main.meta | 4 ++-- physics/radsw_main.meta | 4 ++-- physics/rrtmg_lw_post.meta | 4 ++-- physics/rrtmg_sw_post.meta | 4 ++-- physics/satmedmfvdif.meta | 4 ++-- physics/satmedmfvdifq.meta | 4 ++-- physics/ysuvdif.meta | 4 ++-- 14 files changed, 30 insertions(+), 30 deletions(-) diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 51764e04d..e130ed1a7 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -747,7 +747,7 @@ intent = in optional = F [htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -756,7 +756,7 @@ intent = in optional = F [htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 9cda625ab..5c206ef30 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -443,7 +443,7 @@ intent = in optional = F [htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -452,7 +452,7 @@ intent = in optional = F [htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 2fa998781..244ebc6bd 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -183,7 +183,7 @@ intent = in optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate on radiation time step units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -192,7 +192,7 @@ intent = in optional = F [swhc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky shortwave heating rate on radiation time step units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -201,7 +201,7 @@ intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate on radiation time step units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -210,7 +210,7 @@ intent = in optional = F [hlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky longwave heating rate on radiation time step units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 749b627f7..9daa8e969 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -424,7 +424,7 @@ intent = in optional = F [lwheat_i] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -433,7 +433,7 @@ intent = in optional = F [swheat_i] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index da09c0089..27b186bd3 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -729,7 +729,7 @@ intent = inout optional = F [htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -738,7 +738,7 @@ intent = in optional = F [htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 6a6ccd183..25fddea02 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -145,7 +145,7 @@ intent = in optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + 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,vertical_dimension) @@ -154,7 +154,7 @@ intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + 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,vertical_dimension) diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta index 0e0ed15ad..13bf39396 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -145,7 +145,7 @@ intent = in optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + 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,vertical_dimension) @@ -154,7 +154,7 @@ intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + 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,vertical_dimension) diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index 73977e5cb..e91fc10df 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -257,7 +257,7 @@ intent = in optional = F [hlwc] - 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_time_step_and_radiation_levels long_name = longwave total sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) @@ -291,7 +291,7 @@ intent = inout optional = F [hlw0] - 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_time_step_and_radiation_levels long_name = longwave clear sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index c5cbe768a..c8074cf47 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -318,7 +318,7 @@ intent = in optional = F [hswc] - 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_time_step_and_radiation_levels long_name = shortwave total sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) @@ -352,7 +352,7 @@ intent = inout optional = F [hsw0] - 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_time_step_and_radiation_levels long_name = shortwave clear sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 92b4003d7..8bca0597e 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -80,7 +80,7 @@ intent = in optional = F [htlwc] - 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_time_step_and_radiation_levels long_name = total sky heating rate due to longwave radiation units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) @@ -89,7 +89,7 @@ intent = in optional = F [htlw0] - 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_time_step_and_radiation_levels long_name = clear sky heating rate due to longwave radiation units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index 28b54b5bf..6ed13e830 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -87,7 +87,7 @@ intent = in optional = F [htswc] - 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_time_step_and_radiation_levels long_name = total sky heating rate due to shortwave radiation units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) @@ -96,7 +96,7 @@ intent = in optional = F [htsw0] - 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_time_step_and_radiation_levels long_name = clear sky heating rates due to shortwave radiation units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index dcf307e55..e127f14e5 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -249,7 +249,7 @@ intent = in optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + 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,vertical_dimension) @@ -258,7 +258,7 @@ intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + 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,vertical_dimension) diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index d6b1d66ea..4e9b05239 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -249,7 +249,7 @@ intent = in optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + 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,vertical_dimension) @@ -258,7 +258,7 @@ intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + 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,vertical_dimension) diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index da01b0a41..12819dee5 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -125,7 +125,7 @@ intent = inout optional = F [swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + 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,vertical_dimension) @@ -134,7 +134,7 @@ intent = in optional = F [hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + 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,vertical_dimension) From dc8a5cc5e02a55778570926bb5bfaba97611afe6 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 1 Apr 2020 16:31:38 -0600 Subject: [PATCH 068/141] Bugfix in physics/mp_thompson.F90: aerosol arrays may not be allocated, use assumed size arrays --- physics/mp_thompson.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 2978b8df2..22b8124c1 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -39,10 +39,10 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & 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) - 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(:) + real(kind_phys), optional, intent(inout) :: nifa2d(:) + real(kind_phys), optional, intent(inout) :: nwfa(:,:) + real(kind_phys), optional, intent(inout) :: nifa(:,:) integer, intent(in) :: mpicomm integer, intent(in) :: mpirank integer, intent(in) :: mpiroot From 3d64654aff54e50bdac27f25af9712050b5531d9 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Thu, 2 Apr 2020 14:19:00 +0000 Subject: [PATCH 069/141] put gctrt in .no.flxform to avoid debug error for csawmgshoc --- physics/cs_conv.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index 956d5a1d0..29044e4ec 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -1401,9 +1401,11 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions gcht(i,ctp) = tem * gcht(i,ctp) gcqt(i,ctp) = tem * gcqt(i,ctp) gcit(i,ctp) = tem * gcit(i,ctp) - do n = ntrq,ntr - gctrt(i,n,ctp) = tem * gctrt(i,n,ctp) - enddo + if (.not. flx_form) then + do n = ntrq,ntr + gctrt(i,n,ctp) = tem * gctrt(i,n,ctp) + enddo + end if gcut(i,ctp) = tem * gcut(i,ctp) gcvt(i,ctp) = tem * gcvt(i,ctp) do k=1,kmax From 4680d9dc36312dd69b0e082e32986a4dcd8f7377 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 2 Apr 2020 17:02:34 -0600 Subject: [PATCH 070/141] CMakeLists.txt: remove unnecessary include directories that are not required and cause a second compile step to recompile everything in ccpp-physics --- CMakeLists.txt | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 0a1658b22..725a1f947 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -84,17 +84,6 @@ else(STATIC) option(BUILD_SHARED_LIBS "Build a shared library" ON) endif(STATIC) -#------------------------------------------------------------------------------ -# Add the CCPP include/module directory -set(CCPP_INCLUDE_DIRS "" CACHE FILEPATH "Path to ccpp includes") -set_property(DIRECTORY PROPERTY INCLUDE_DIRECTORIES ${CCPP_INCLUDE_DIRS}) - -#------------------------------------------------------------------------------ -# Add the CCPP library -set(CCPP_LIB_DIRS "" CACHE FILEPATH "Path to ccpp library") -link_directories(${CCPP_LIB_DIRS}) -list(APPEND LIBS "ccpp") - #------------------------------------------------------------------------------ # Set the sources: physics type definitions set(TYPEDEFS $ENV{CCPP_TYPEDEFS}) @@ -357,6 +346,7 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") endif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") if (PROJECT STREQUAL "CCPP-SCM") + message(FATAL_ERROR "SHOULDN'T BE HERE!!!") INCLUDE_DIRECTORIES(${CMAKE_BINARY_DIR}/ccpp/framework/src) endif (PROJECT STREQUAL "CCPP-SCM") From 4dc748c0d2761398c4255514a8083ea9e1f6fb92 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 3 Apr 2020 14:54:42 -0600 Subject: [PATCH 071/141] Remove unneeded code for SCM, including an unintentionally left FATAL_ERROR exception --- CMakeLists.txt | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 725a1f947..0bd3ffeda 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -33,13 +33,6 @@ set(AUTHORS "Grant J. Firl" "Dom Heinzeller") # Enable Fortran enable_language(Fortran) -if (PROJECT STREQUAL "CCPP-SCM") - #------------------------------------------------------------------------------ - # CMake Modules - # Set the CMake module path - list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/../framework/cmake") -endif (PROJECT STREQUAL "CCPP-SCM") - #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran if (OPENMP) @@ -345,13 +338,7 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") set_property(SOURCE ${CAPS} APPEND_STRING PROPERTY COMPILE_FLAGS " -Mnobounds ") endif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") -if (PROJECT STREQUAL "CCPP-SCM") - message(FATAL_ERROR "SHOULDN'T BE HERE!!!") - INCLUDE_DIRECTORIES(${CMAKE_BINARY_DIR}/ccpp/framework/src) -endif (PROJECT STREQUAL "CCPP-SCM") - #------------------------------------------------------------------------------ - if(STATIC) add_library(ccppphys STATIC ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) # Generate list of Fortran modules from defined sources From c1fb9ccb98cab43e9006aa3457e1e4a9a393f59d Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 6 Apr 2020 20:56:48 +0000 Subject: [PATCH 072/141] changes make changing INPUT/cam5_* to cam5_* in iccninterp --- physics/iccninterp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/iccninterp.F90 b/physics/iccninterp.F90 index cd4586d89..a3a08dee8 100644 --- a/physics/iccninterp.F90 +++ b/physics/iccninterp.F90 @@ -50,7 +50,7 @@ SUBROUTINE read_cidata (me, master) end do end do call nf_close(ncid) - call nf_open("INPUT/cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) + call nf_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) call nf_inq_varid(ncid, "NPCCN", varid) call nf_get_var(ncid, varid, ccnin) call nf_close(ncid) From d9fae0e98b7b87420e5448d39a1bc4648856b448 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 9 Apr 2020 20:18:55 -0600 Subject: [PATCH 073/141] Update CMakeLists.txt: require cmake 3.0, remove legacy syntax for policy CMP0048 --- CMakeLists.txt | 22 +++++----------------- 1 file changed, 5 insertions(+), 17 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 0bd3ffeda..9765fa25e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -5,22 +5,14 @@ if(NOT PROJECT) endif (NOT PROJECT) #------------------------------------------------------------------------------ -cmake_minimum_required(VERSION 2.8.11) +cmake_minimum_required(VERSION 3.0) + +project(ccppphys + VERSION 3.0.0 + LANGUAGES C CXX Fortran) # Use rpaths on MacOSX set(CMAKE_MACOSX_RPATH 1) - -if(POLICY CMP0048) - cmake_policy(SET CMP0048 NEW) - project(ccppphys VERSION 3.0.0) -else(POLICY CMP0048) - project(ccppphys) - set(PROJECT_VERSION 3.0.0) - set(PROJECT_VERSION_MAJOR 3) - set(PROJECT_VERSION_MINOR 0) - set(PROJECT_VERSION_PATCH 0) -endif(POLICY CMP0048) - if(POLICY CMP0042) cmake_policy(SET CMP0042 NEW) endif(POLICY CMP0042) @@ -29,10 +21,6 @@ endif(POLICY CMP0042) set(PACKAGE "ccpp-physics") set(AUTHORS "Grant J. Firl" "Dom Heinzeller") -#------------------------------------------------------------------------------ -# Enable Fortran -enable_language(Fortran) - #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran if (OPENMP) From 80c6fdb88236c3f1ef81be7fc69a6dbc3844e6c2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 9 Apr 2020 20:19:20 -0600 Subject: [PATCH 074/141] physics/ugwp_driver_v0.F: comment out unnecessary prints to stdout that pollute the model output --- physics/ugwp_driver_v0.F | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 4edd84a7a..ff6e30b83 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -1839,16 +1839,16 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! !--------------------------------------------------------------------------- ! - if (kdt == 1 .and. mpi_id == master) then - print *, 'vgw done ' -! - print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' - print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay' - print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' - print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps' -! -! print *, ' ugwp -heating rates ' - endif +! if (kdt == 1 .and. mpi_id == master) then +! print *, 'vgw done ' +!! +! print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' +! print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay' +! print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' +! print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps' +!! +!! print *, ' ugwp -heating rates ' +! endif return end subroutine fv3_ugwp_solv2_v0 From 7726128fbea84800f7b324a9d136a6c1e1876b85 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 10 Apr 2020 14:19:00 -0600 Subject: [PATCH 075/141] Apply missing updates for MG-IN-CCN changes --- physics/GFS_phys_time_vary.fv3.F90 | 3 +- physics/GFS_phys_time_vary.scm.F90 | 3 +- physics/GFS_rrtmg_post.F90 | 18 ++-- physics/aerinterp.F90 | 73 ++++++++------- physics/radiation_aerosols.f | 142 ++++++++++++++--------------- 5 files changed, 123 insertions(+), 116 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 56b4c86a4..915b4fd48 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -167,7 +167,8 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm ntrcaer = size(Data(1)%Tbd%aer_nm, dim=3) ! Read aerosol climatology - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate) + call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) + if (errflg/=0) return endif else ! Update the value of ntrcaer in aerclm_def with the value defined diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 095dac2c7..01b48f5d7 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -110,7 +110,8 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm ntrcaer = size(Tbd%aer_nm, dim=3) ! Read aerosol climatology - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate) + call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) + if (errflg/=0) return endif else ! Update the value of ntrcaer in aerclm_def with the value defined diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index db3de4f44..c910d2fb1 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -75,12 +75,18 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & if (Model%lssav) then if (Model%lsswr) then do i=1,im - Diag%fluxr(i,34) = Diag%fluxr(i,34) + Model%fhswr*aerodp(i,1) ! total aod at 550nm - Diag%fluxr(i,35) = Diag%fluxr(i,35) + Model%fhswr*aerodp(i,2) ! DU aod at 550nm - Diag%fluxr(i,36) = Diag%fluxr(i,36) + Model%fhswr*aerodp(i,3) ! BC aod at 550nm - Diag%fluxr(i,37) = Diag%fluxr(i,37) + Model%fhswr*aerodp(i,4) ! OC aod at 550nm - Diag%fluxr(i,38) = Diag%fluxr(i,38) + Model%fhswr*aerodp(i,5) ! SU aod at 550nm - Diag%fluxr(i,39) = Diag%fluxr(i,39) + Model%fhswr*aerodp(i,6) ! SS aod at 550nm +! Diag%fluxr(i,34) = Diag%fluxr(i,34) + Model%fhswr*aerodp(i,1) ! total aod at 550nm +! Diag%fluxr(i,35) = Diag%fluxr(i,35) + Model%fhswr*aerodp(i,2) ! DU aod at 550nm +! Diag%fluxr(i,36) = Diag%fluxr(i,36) + Model%fhswr*aerodp(i,3) ! BC aod at 550nm +! Diag%fluxr(i,37) = Diag%fluxr(i,37) + Model%fhswr*aerodp(i,4) ! OC aod at 550nm +! Diag%fluxr(i,38) = Diag%fluxr(i,38) + Model%fhswr*aerodp(i,5) ! SU aod at 550nm +! Diag%fluxr(i,39) = Diag%fluxr(i,39) + Model%fhswr*aerodp(i,6) ! SS aod at 550nm + Diag%fluxr(i,34) = aerodp(i,1) ! total aod at 550nm + Diag%fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm + Diag%fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm + Diag%fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm + Diag%fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm + Diag%fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm enddo endif diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index e1263e93c..d6bf822f7 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -3,7 +3,7 @@ !! aerosol data for MG microphysics. !>\ingroup mod_GFS_phys_time_vary -!! This module contain subroutines of reading and interpolating +!! This module contain subroutines of reading and interpolating !! aerosol data for MG microphysics. module aerinterp @@ -15,13 +15,16 @@ module aerinterp contains - SUBROUTINE read_aerdata (me, master, iflip, idate ) + SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) use machine, only: kind_phys, kind_io4, kind_io8 use aerclm_def use netcdf !--- in/out integer, intent(in) :: me, master, iflip, idate(4) + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg + !--- locals integer :: ncid, varid, ndims, dim1, dim2, dim3, hmx integer :: i, j, k, n, ii, imon, klev @@ -49,9 +52,10 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) !! =================================================================== fname=trim("aeroclim.m"//'01'//".nc") inquire (file = fname, exist = file_exist) - if (.not. file_exist ) then - print *, 'fname not found, abort' - stop 8888 + if (.not. file_exist) then + errmsg = errmsg // ' error in read_aerdata: file ' // trim(fname) // ' not found' + errflg = 1 + return endif call nf_open(fname , nf90_NOWRITE, ncid) @@ -95,12 +99,12 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) do i = 1, hmx ! flip from (-180,180) to (0,360) if(aer_loni(i)<0.) aer_loni(i)=aer_loni(i)+360. - aer_lon(i+hmx) = aer_loni(i) - aer_lon(i) = aer_loni(i+hmx) + aer_lon(i+hmx) = aer_loni(i) + aer_lon(i) = aer_loni(i+hmx) enddo do i = 1, latsaer - aer_lat(i) = aer_lati(i) + aer_lat(i) = aer_lati(i) enddo call nf_close(ncid) @@ -120,23 +124,18 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) do imon = 1, timeaer write(mn,'(i2.2)') imon fname=trim("aeroclim.m"//mn//".nc") - if (me == master) print *, "aerosol climo:", fname, & - "for imon:",imon,idate - inquire (file = fname, exist = file_exist) - if ( file_exist ) then - if (me == master) print *, & - "aerosol climo found; proceed the run" - else - print *,"Error! aerosol climo not found; abort the run" - stop 555 + if (.not. file_exist) then + errmsg = errmsg // ' error in read_aerdata: file ' // trim(fname) // ' not found' + errflg = 1 + return endif call nf_open(fname , nf90_NOWRITE, ncid) ! ====> construct 3-d pressure array (Pa) call nf_inq_varid(ncid, "DELP", varid) - call nf_get_var(ncid, varid, buff) + call nf_get_var(ncid, varid, buff) do j = 1, latsaer do i = 1, lonsaer @@ -144,7 +143,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) pres_tmp(i,1) = 0. do k=2, dim3 pres_tmp(i,k) = pres_tmp(i,k-1)+buff(i,j,k) - enddo !k-loop + enddo !k-loop enddo !i-loop (lon) ! extract pres_tmp to fill aer_pres (in Pa) @@ -153,7 +152,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) klev = k else ! data from sfc to top klev = ( dim3 - k ) + 1 - endif + endif do i = 1, hmx aer_pres(i+hmx,j,k,imon)= 1.d0*pres_tmp(i,klev) aer_pres(i,j,k,imon) = 1.d0*pres_tmp(i+hmx,klev) @@ -170,13 +169,13 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) call nf_get_var(ncid, varid, buffx) do j = 1, latsaer - do k = 1, levsaer + do k = 1, levsaer ! input is from toa to sfc if ( iflip == 0 ) then ! data from toa to sfc klev = k else ! data from sfc to top klev = ( dim3 - k ) + 1 - endif + endif do i = 1, hmx aerin(i+hmx,j,k,ii,imon) = 1.d0*buffx(i,j,klev,1) if(aerin(i+hmx,j,k,ii,imon)<0.or.aerin(i+hmx,j,k,ii,imon)>1.) then @@ -200,7 +199,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) deallocate (buff, pres_tmp) deallocate (buffx) - END SUBROUTINE read_aerdata + END SUBROUTINE read_aerdata ! !********************************************************************** ! @@ -235,7 +234,7 @@ SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & else ddy(j) = 1.0 endif - + ENDDO DO J=1,npts @@ -255,7 +254,7 @@ SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & ddx(j) = 1.0 endif ENDDO - + RETURN END SUBROUTINE setindxaer ! @@ -271,7 +270,7 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & integer i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i,ii real(kind=kind_phys) fhour,temj, tx1, tx2,temi ! - + integer JINDX1(npts), JINDX2(npts),iINDX1(npts),iINDX2(npts) integer me,idate(4), master integer IDAT(8),JDAT(8) @@ -318,7 +317,7 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & ! tx1 = (aer_time(n2) - rjday) / (aer_time(n2) - aer_time(n1)) tx2 = 1.0 - tx1 - if (n2 > 12) n2 = n2 -12 + if (n2 > 12) n2 = n2 -12 ! DO L=1,levsaer @@ -330,18 +329,18 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & I2 = IINDX2(J) TEMI = 1.0 - DDX(J) DO ii=1,ntrcaer - aerpm(j,L,ii) = & + aerpm(j,L,ii) = & tx1*(TEMI*TEMJ*aerin(I1,J1,L,ii,n1)+DDX(j)*DDY(J)*aerin(I2,J2,L,ii,n1)& - +TEMI*DDY(j)*aerin(I1,J2,L,ii,n1)+DDX(j)*TEMJ*aerin(I2,J1,L,ii,n1))& + +TEMI*DDY(j)*aerin(I1,J2,L,ii,n1)+DDX(j)*TEMJ*aerin(I2,J1,L,ii,n1))& +tx2*(TEMI*TEMJ*aerin(I1,J1,L,ii,n2)+DDX(j)*DDY(J)*aerin(I2,J2,L,ii,n2) & - +TEMI*DDY(j)*aerin(I1,J2,L,ii,n2)+DDX(j)*TEMJ*aerin(I2,J1,L,ii,n2)) + +TEMI*DDY(j)*aerin(I1,J2,L,ii,n2)+DDX(j)*TEMJ*aerin(I2,J1,L,ii,n2)) ENDDO - aerpres(j,L) = & + aerpres(j,L) = & tx1*(TEMI*TEMJ*aer_pres(I1,J1,L,n1)+DDX(j)*DDY(J)*aer_pres(I2,J2,L,n1)& - +TEMI*DDY(j)*aer_pres(I1,J2,L,n1)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n1))& + +TEMI*DDY(j)*aer_pres(I1,J2,L,n1)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n1))& +tx2*(TEMI*TEMJ*aer_pres(I1,J1,L,n2)+DDX(j)*DDY(J)*aer_pres(I2,J2,L,n2) & - +TEMI*DDY(j)*aer_pres(I1,J2,L,n2)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n2)) + +TEMI*DDY(j)*aer_pres(I1,J2,L,n2)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n2)) ENDDO ENDDO @@ -349,11 +348,11 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & ! don't flip, input is the same direction as GFS (bottom-up) DO J=1,npts DO L=1,lev - if(prsl(j,L).ge.aerpres(j,1)) then + if(prsl(j,L).ge.aerpres(j,1)) then DO ii=1, ntrcaer aerout(j,L,ii)=aerpm(j,1,ii) !! sfc level ENDDO - else if(prsl(j,L).le.aerpres(j,levsaer)) then + else if(prsl(j,L).le.aerpres(j,levsaer)) then DO ii=1, ntrcaer aerout(j,L,ii)=aerpm(j,levsaer,ii) !! toa top ENDDO @@ -372,11 +371,11 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & DO ii = 1, ntrcaer aerout(j,L,ii)= aerpm(j,i1,ii)*tx1 + aerpm(j,i2,ii)*tx2 ENDDO - endif + endif ENDDO !L-loop ENDDO !J-loop ! - RETURN + RETURN END SUBROUTINE aerinterpol end module aerinterp diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index 45a909ca8..f732c37ef 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -101,7 +101,7 @@ ! internal variable lmap_new through namelist variable iaer. ! ! may 2019 --- sarah lu, restore the gocart option, allowing ! ! aerosol ext, ssa, asy determined from MERRA2 monthly climo ! -! with new spectral band mapping method ! +! with new spectral band mapping method ! ! ! ! references for opac climatological aerosols: ! ! hou et al. 2002 (ncep office note 441) ! @@ -142,15 +142,15 @@ !! !!\n References: !! - OPAC climatological aerosols: -!! Hou et al. 2002 \cite hou_et_al_2002; Hess et al. 1998 +!! Hou et al. 2002 \cite hou_et_al_2002; Hess et al. 1998 !! \cite hess_et_al_1998 !! - GOCART interactive aerosols: !! Chin et al., 2000 \cite chin_et_al_2000 -!! Colarco et al., 2010 - jgr, v115, D14207\cite colarco_et_al_2010 -!! -!! - MERRA2 aerosol reanalysis: -!! Randles et al., 2017 - jclim, v30, 6823-6850\cite randles_et_al_2017 -!! Buchard et al., 2017 - jclim, v30, 6851-6871\cite buchard_et_al_2017 +!! Colarco et al., 2010 - jgr, v115, D14207\cite colarco_et_al_2010 +!! +!! - MERRA2 aerosol reanalysis: +!! Randles et al., 2017 - jclim, v30, 6823-6850\cite randles_et_al_2017 +!! Buchard et al., 2017 - jclim, v30, 6851-6871\cite buchard_et_al_2017 !! !! - Stratospheric volcanical aerosols: !! Sato et al. 1993 \cite sato_et_al_1993 @@ -200,12 +200,12 @@ module module_radiation_aerosols ! ! --- module control parameters set in subroutine "aer_init" !> number of actual bands for sw aerosols; calculated according to !! laswflg setting - integer, save :: NSWBND = NBDSW + integer, save :: NSWBND = NBDSW !> number of actual bands for lw aerosols; calculated according to !! lalwflg and lalw1bd settings - integer, save :: NLWBND = NBDLW + integer, save :: NLWBND = NBDLW !> total number of bands for sw+lw aerosols - integer, save :: NSWLWBD = NBDSW+NBDLW + integer, save :: NSWLWBD = NBDSW+NBDLW ! LW aerosols effect control flag ! =.true.:aerosol effect is included in LW radiation ! =.false.:aerosol effect is not included in LW radiation @@ -415,11 +415,11 @@ module module_radiation_aerosols ! integer, parameter :: KAERBNDI=56 !> num of rh levels for rh-dep components integer, parameter :: KRHLEV =36 -!> num of gocart rh indep aerosols +!> num of gocart rh indep aerosols integer, parameter :: KCM1 = 5 -!> num of gocart rh dep aerosols +!> num of gocart rh dep aerosols integer, parameter :: KCM2 = 10 -!> num of gocart aerosols +!> num of gocart aerosols integer, parameter :: KCM = KCM1 + KCM2 real (kind=kind_phys), dimension(KRHLEV) :: rhlev_grt & @@ -462,7 +462,7 @@ module module_radiation_aerosols ! ! ======================================================================= ! --------------------------------------------------------------------- ! -! section-5 : module variables for aod diagnostic ! +! section-5 : module variables for aod diagnostic ! ! --------------------------------------------------------------------- ! !! --- the following are for diagnostic purpose to output aerosol optical depth ! aod from 10 components are grouped into 5 major different species: @@ -783,11 +783,11 @@ subroutine set_spectrum ! ! ! ==================== defination of variables =================== ! ! ! -!> - inputs: (module constants) -!! - NWVTOT: total num of wave numbers used in sw spectrum -!! - NWVTIR: total num of wave numbers used in the ir region -!! -!> - outputs: (in-scope variables) +!> - inputs: (module constants) +!! - NWVTOT: total num of wave numbers used in sw spectrum +!! - NWVTIR: total num of wave numbers used in the ir region +!! +!> - outputs: (in-scope variables) !! - solfwv(NWVTOT): solar flux for each individual wavenumber !! (\f$W/m^2\f$) !! - eirfwv(NWVTIR): ir flux(273k) for each individual wavenumber @@ -905,7 +905,7 @@ end subroutine aer_init !!@} -!> This subroutine is the opac-climatology aerosol initialization +!> This subroutine is the opac-climatology aerosol initialization !! program to set up necessary parameters and working arrays. !>\param solfwv (NWVTOT), solar flux for each individual wavenumber !! \f$(w/m^2)\f$ @@ -1098,7 +1098,7 @@ subroutine set_aercoef ! !===> ... begin here ! -!> -# Reading climatological aerosols optical data from aeros_file, +!> -# Reading climatological aerosols optical data from aeros_file, !! including: inquire (file=aeros_file, exist=file_exist) @@ -1143,56 +1143,56 @@ subroutine set_aercoef endif !> - ending wave num for 61 aerosol spectral bands - read(NIAERCM,21) cline + read(NIAERCM,21) cline 21 format(a80) read(NIAERCM,22) iendwv(:) 22 format(13i6) !> - atmos scale height for 5 domains, 7 profs - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,24) haer(:,:) 24 format(20f4.1) !> - reference pressure for 5 domains, 7 profs - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,26) prsref(:,:) 26 format(10f7.2) !> - rh independent ext coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidext0(:,:) 28 format(8e10.3) !> - rh independent sca coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidsca0(:,:) !> - rh independent ssa coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidssa0(:,:) !> - rh independent asy coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidasy0(:,:) !> - rh dependent ext coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpext0(:,:,:) !> - rh dependent sca coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpsca0(:,:,:) !> - rh dependent ssa coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpssa0(:,:,:) !> - rh dependent asy coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpasy0(:,:,:) !> - stratospheric background aeros for 61 bands - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) straext0(:) close (NIAERCM) @@ -1759,16 +1759,16 @@ subroutine aer_update & endif !> -# Call trop_update() to update monthly tropospheric aerosol data. - if ( lalwflg .or. laswflg ) then + if ( lalwflg .or. laswflg ) then - if ( iaermdl == 0 .or. iaermdl==5 ) then ! opac-climatology scheme + if ( iaermdl == 0 .or. iaermdl==5 ) then ! opac-climatology scheme call trop_update endif endif !> -# Call volc_update() to update yearly stratospheric volcanic aerosol data. - if ( lavoflg ) then + if ( lavoflg ) then call volc_update endif @@ -2364,7 +2364,7 @@ subroutine setaer & !> -# Compute stratosphere volcanic forcing: !! - select data in 4 lat bands, interpolation at the boundaries -!! - Find lower boundary of stratosphere: polar, fixed at 25000pa +!! - Find lower boundary of stratosphere: polar, fixed at 25000pa !! (250mb); tropic, fixed at 15000pa (150mb); mid-lat, interpolation !! - SW: add volcanic aerosol optical depth to the background value !! - Smoothing profile at boundary if needed @@ -2678,13 +2678,13 @@ end subroutine setaer !!\n (:,:,:,2): single scattering albedo !!\n (:,:,:,3): asymmetry parameter !!\param aerodp (IMAX,NSPC+1), vertically integrated aer-opt-depth -!!\section gel_aer_pro General Algorithm +!!\section gel_aer_pro General Algorithm !> @{ !----------------------------------- - subroutine aer_property & + subroutine aer_property & & ( prsi,prsl,prslk,tvly,rhlay,dz,hz,tracer, & ! --- inputs: - & alon,alat,slmsk, laersw,laerlw, & - & IMAX,NLAY,NLP1, & + & alon,alat,slmsk, laersw,laerlw, & + & IMAX,NLAY,NLP1, & & aerosw,aerolw,aerodp & ! --- outputs: & ) @@ -3103,9 +3103,9 @@ subroutine aer_property & contains ! ================= -!> This subroutine computes aerosols optical properties in NSWLWBD +!> This subroutine computes aerosols optical properties in NSWLWBD !! bands. there are seven different vertical profile structures. in the -!! troposphere, aerosol distribution at each grid point is composed +!! troposphere, aerosol distribution at each grid point is composed !! from up to six components out of ten different substances. !-------------------------------- subroutine radclimaer @@ -3415,7 +3415,7 @@ end subroutine aer_property !! program to set up necessary parameters and working arrays. !>\param solfwv (NWVTOT), solar flux for each individual wavenumber !! \f$(w/m^2)\f$ -!!\param eirfwv (NWVTIR), IR flux(273k) for each individual wavenumber +!!\param eirfwv (NWVTIR), IR flux(273k) for each individual wavenumber !! \f$(w/m^2)\f$ !!\param me print message control flag !! @@ -3423,7 +3423,7 @@ end subroutine aer_property !! @{ !----------------------------------- subroutine gocart_aerinit & - & ( solfwv, eirfwv, me & + & ( solfwv, eirfwv, me & & ) ! ================================================================== ! @@ -3459,8 +3459,8 @@ subroutine gocart_aerinit & implicit none ! --- inputs: - real (kind=kind_phys), dimension(:) :: solfwv ! one wvn sol flux - real (kind=kind_phys), dimension(:) :: eirfwv ! one wvn ir flux + real (kind=kind_phys), dimension(:) :: solfwv ! one wvn sol flux + real (kind=kind_phys), dimension(:) :: eirfwv ! one wvn ir flux integer, intent(in) :: me @@ -3489,7 +3489,7 @@ subroutine gocart_aerinit & integer, dimension(kaerbndi) :: iendwv_du real (kind=kind_phys), dimension(kaerbndd) :: wavelength real (kind=kind_phys), dimension(kaerbndi) :: wavelength_du - real (kind=kind_phys) :: sumsol, sumir, sumsol_du, sumir_du + real (kind=kind_phys) :: sumsol, sumir, sumsol_du, sumir_du integer :: i, j, k, mb, ib, ii, iix, iw, iw1, iw2 @@ -3564,7 +3564,7 @@ subroutine gocart_aerinit & do while ( iw1 > iendwv(ii) ) if ( ii == kaerbndd ) exit ii = ii + 1 - enddo + enddo sumsol = f_zero nv1(ib) = ii @@ -3572,7 +3572,7 @@ subroutine gocart_aerinit & do while ( iw1 > iendwv_du(iix) ) if ( iix == kaerbndi ) exit iix = iix + 1 - enddo + enddo sumsol_du = f_zero nv1_du(ib) = iix @@ -3643,7 +3643,7 @@ subroutine gocart_aerinit & ! -- for rd-dependent do while ( iw1 > iendwv(ii) ) - if ( ii == kaerbndd ) exit + if ( ii == kaerbndd ) exit ii = ii + 1 enddo sumir = f_zero @@ -3651,7 +3651,7 @@ subroutine gocart_aerinit & ! -- for rd-independent do while ( iw1 > iendwv_du(iix) ) - if ( iix == kaerbndi ) exit + if ( iix == kaerbndi ) exit iix = iix + 1 enddo sumir_du = f_zero @@ -3723,8 +3723,8 @@ subroutine gocart_aerinit & ! print *, ssarhd_grt(i,:,ib) ! print *, ' asyrhd for rhlev:',i ! print *, asyrhd_grt(i,:,ib) -! enddo -! enddo +! enddo +! enddo ! print *, ' wvnlw1 :',wvnlw1 ! print *, ' wvnlw2 :',wvnlw2 ! do ib = 1, NLWBND @@ -3768,7 +3768,7 @@ subroutine rd_gocart_luts ! iendwv - ending wvnum (cm**-1) for each band kaerbndd ! ! iendwv_du - ending wvnum (cm**-1) for each band kaerbndi ! ! for handling optical properties of rh independent species (kcm1) ! -! 1=du001, 2=du002, 3=du003, 4=du004, 5=du005 ! +! 1=du001, 2=du002, 3=du003, 4=du004, 5=du005 ! ! rhidext0_grt - extinction coefficient kaerbndi*kcm1 ! ! rhidsca0_grt - scattering coefficient kaerbndi*kcm1 ! ! rhidssa0_grt - single scattering albedo kaerbndi*kcm1 ! @@ -3792,7 +3792,7 @@ subroutine rd_gocart_luts ! --- locals: integer :: iradius, ik, ibeg - integer, parameter :: numspc = 5 ! # of aerosol species + integer, parameter :: numspc = 5 ! # of aerosol species ! - input tabulated aerosol optical spectral data from GSFC real, dimension(kaerbndd) :: lambda ! wavelength (m) for non-dust @@ -3920,7 +3920,7 @@ subroutine rd_gocart_luts wavelength(j) = 1.e6 * lambda(i) enddo do k = 1, iradius - ik = ibeg + k - 1 + ik = ibeg + k - 1 do i = 1, kaerbndd ii = kaerbndd -i + 1 do j = 1, krhlev @@ -4008,7 +4008,7 @@ subroutine optavg_gocart !===> ... begin here ! ! --- ... loop for each sw radiation spectral band - + if ( laswflg ) then do nb = 1, nswbnd rsolbd = f_one / solbnd_du(nb) @@ -4175,8 +4175,8 @@ end subroutine gocart_aerinit !!\param rhlay (IMAX,NLAY), layer mean relative humidity !!\param dz (IMAX,NLAY), layer thickness in m !!\param hz (IMAX,NLP1), level high in m -!!\param tracer (IMAX,NLAY,NTRAC), aer tracer concentrations -!!\param aerfld (IMAX,NLAY,NTRCAER), aer tracer concentrations +!!\param tracer (IMAX,NLAY,NTRAC), aer tracer concentrations +!!\param aerfld (IMAX,NLAY,NTRCAER), aer tracer concentrations !!\param alon, alat (IMAX), longitude and latitude of given points in degree !!\param slmsk (IMAX), sea/land mask (sea:0,land:1,sea-ice:2) !!\param laersw,laerlw logical flag for sw/lw aerosol calculations @@ -4192,7 +4192,7 @@ end subroutine gocart_aerinit !!\n (:,:,:,2): single scattering albedo !!\n (:,:,:,3): asymmetry parameter !!\param aerodp (IMAX,NSPC+1), vertically integrated aer-opt-depth -!!\section gel_go_aer_pro General Algorithm +!!\section gel_go_aer_pro General Algorithm !! @{ !----------------------------------- subroutine aer_property_gocart & @@ -4288,7 +4288,7 @@ subroutine aer_property_gocart & lab_do_IMAXg : do i = 1, IMAX ! --- initialize tauae, ssaae, asyae - do m = 1, NSWLWBD + do m = 1, NSWLWBD do k = 1, NLAY tauae(k,m) = f_zero ssaae(k,m) = f_one @@ -4307,17 +4307,17 @@ subroutine aer_property_gocart & spcodp(m) = f_zero enddo - do k = 1, NLAY - rh1(k) = rhlay(i,k) ! + do k = 1, NLAY + rh1(k) = rhlay(i,k) ! dz1(k) = 1000.*dz (i,k) ! thickness converted from km to m plv = 100.*prsl(i,k) ! convert pressure from mb to Pa tv = tvly(i,k) ! virtual temp in K rho = plv / ( con_rd * tv) ! air density in kg/m3 do m = 1, KCM - aerms(k,m) = aerfld(i,k,m)*rho ! dry mass (kg/m3) + aerms(k,m) = aerfld(i,k,m)*rho ! dry mass (kg/m3) enddo -! +! ! --- calculate sw/lw aerosol optical properties for the ! corresponding frequency bands @@ -4440,14 +4440,14 @@ subroutine aeropt sum_tau = f_zero sum_ssa = f_zero sum_asy = f_zero - + ! --- determine tau, ssa, asy for dust aerosols ext1 = f_zero asy1 = f_zero sca1 = f_zero ssa1 = f_zero do m = 1, kcm1 - cm = max(aerms(k,m),0.0) * dz1(k) + cm = max(aerms(k,m),0.0) * dz1(k) ext1 = ext1 + cm*extrhi_grt(m,ib) sca1 = sca1 + cm*scarhi_grt(m,ib) ssa1 = ssa1 + cm*extrhi_grt(m,ib) * ssarhi_grt(m,ib) @@ -4457,7 +4457,7 @@ subroutine aeropt if (ext1 > f_zero) ssa=min(f_one, ssa1/ext1) if (sca1 > f_zero) asy=min(f_one, asy1/sca1) -! --- update aod from individual species +! --- update aod from individual species if ( ib==nv_aod ) then spcodp(1) = spcodp(1) + tau endif @@ -4476,7 +4476,7 @@ subroutine aeropt do nbin = 1, num_radius(ntrc) m1 = radius_lower(ntrc) + nbin - 1 m = m1 - num_radius(1) ! exclude dust aerosols - cm = max(aerms(k,m1),0.0) * dz1(k) + cm = max(aerms(k,m1),0.0) * dz1(k) ext01 = extrhd_grt(ih1,m,ib) + & & rdrh * (extrhd_grt(ih2,m,ib)-extrhd_grt(ih1,m,ib)) sca01 = scarhd_grt(ih1,m,ib) + & @@ -4493,7 +4493,7 @@ subroutine aeropt tau = ext1 if (ext1 > f_zero) ssa=min(f_one, ssa1/ext1) if (sca1 > f_zero) asy=min(f_one, asy1/sca1) -! --- update aod from individual species +! --- update aod from individual species if ( ib==nv_aod ) then spcodp(ktrc) = spcodp(ktrc) + tau endif From 6dcbd09ddfe2c4af7881f5450e96d5ef1a373713 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 11 Apr 2020 06:20:49 -0600 Subject: [PATCH 076/141] Bugfix in physics/GFS_surface_composites.F90 when fractional landmask is true --- physics/GFS_surface_composites.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index b6d833796..7cd552e69 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -63,7 +63,6 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl integer, intent(out) :: errflg ! Local variables - real(kind=kind_phys) :: tem integer :: i ! Initialize CCPP error handling variables @@ -367,10 +366,10 @@ subroutine GFS_surface_composites_post_run ( qss(i) = txl*qss_lnd(i) + tem*qss_ice(i) gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) else - evap(i) = txl*evap_lnd(i) + tem*evap_ice(i) + txo*evap_ocn(i) - hflx(i) = txl*hflx_lnd(i) + tem*hflx_ice(i) + txo*hflx_ocn(i) - qss(i) = txl*qss_lnd(i) + tem*qss_ice(i) + txo*qss_ocn(i) - gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) + txo*gflx_ocn(i) + evap(i) = txl*evap_lnd(i) + txi*evap_ice(i) + txo*evap_ocn(i) + hflx(i) = txl*hflx_lnd(i) + txi*hflx_ice(i) + txo*hflx_ocn(i) + qss(i) = txl*qss_lnd(i) + txi*qss_ice(i) + txo*qss_ocn(i) + gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_ocn(i) endif tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_ocn(i) From 86cdd35a84c29cdea87883bd624f4366692cd34e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 13 Apr 2020 08:10:20 -0600 Subject: [PATCH 077/141] physics/GFS_phys_time_vary.scm.F90: bugfix for OpenMP regions; physics/rrtmgp_?w_aerosol_optics.*: pass in aerosol tracer concentrations for MG --- physics/GFS_phys_time_vary.fv3.F90 | 13 ++++++++++--- physics/GFS_phys_time_vary.scm.F90 | 2 +- physics/aerinterp.F90 | 11 +++++++---- physics/rrtmgp_lw_aerosol_optics.F90 | 13 ++++++++----- physics/rrtmgp_lw_aerosol_optics.meta | 17 +++++++++++++++++ physics/rrtmgp_sw_aerosol_optics.F90 | 15 +++++++++------ physics/rrtmgp_sw_aerosol_optics.meta | 19 ++++++++++++++++++- physics/ugwp_driver_v0.F | 20 ++++++++++---------- 8 files changed, 80 insertions(+), 30 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 915b4fd48..6e51e4aa8 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -61,10 +61,14 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e integer :: nb, nblks, nt integer :: i, j, ix logical :: non_uniform_blocks + character(len=len(errmsg)) :: errmsg2 + integer :: errflg2 ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + errmsg2 = '' + errflg2 = 0 if (is_initialized) return @@ -97,7 +101,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e end if !$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nt,nb) & +!$OMP private (nt,nb,errmsg2,errflg2) & !$OMP shared (Model,Data,Interstitial,errmsg,errflg) & !$OMP shared (levozp,oz_coeff,oz_pres) & !$OMP shared (levh2o,h2o_coeff,h2o_pres) & @@ -167,8 +171,11 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm ntrcaer = size(Data(1)%Tbd%aer_nm, dim=3) ! Read aerosol climatology - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) - if (errflg/=0) return + call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg2,errflg2) + if (errflg2/=0) then + errflg = max(errflg,errflg2) + errmsg = trim(errmsg) // ' ' // trim(errmsg2) + end if endif else ! Update the value of ntrcaer in aerclm_def with the value defined diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 01b48f5d7..5fcc9ed84 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -111,7 +111,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf ntrcaer = size(Tbd%aer_nm, dim=3) ! Read aerosol climatology call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) - if (errflg/=0) return + if (errflg/=0) return endif else ! Update the value of ntrcaer in aerclm_def with the value defined diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index d6bf822f7..9e73ff8c4 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -22,8 +22,8 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) !--- in/out integer, intent(in) :: me, master, iflip, idate(4) - character(len=*), intent(inout) :: errmsg - integer, intent(inout) :: errflg + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg !--- locals integer :: ncid, varid, ndims, dim1, dim2, dim3, hmx @@ -38,6 +38,9 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) real(kind=kind_io8),allocatable,dimension(:) :: aer_lati real(kind=kind_io8),allocatable,dimension(:) :: aer_loni ! + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 !! =================================================================== if (me == master) then if ( iflip == 0 ) then ! data from toa to sfc @@ -53,7 +56,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) fname=trim("aeroclim.m"//'01'//".nc") inquire (file = fname, exist = file_exist) if (.not. file_exist) then - errmsg = errmsg // ' error in read_aerdata: file ' // trim(fname) // ' not found' + errmsg = 'Error in read_aerdata: file ' // trim(fname) // ' not found' errflg = 1 return endif @@ -126,7 +129,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) fname=trim("aeroclim.m"//mn//".nc") inquire (file = fname, exist = file_exist) if (.not. file_exist) then - errmsg = errmsg // ' error in read_aerdata: file ' // trim(fname) // ' not found' + errmsg = 'Error in read_aerdata: file ' // trim(fname) // ' not found' errflg = 1 return endif diff --git a/physics/rrtmgp_lw_aerosol_optics.F90 b/physics/rrtmgp_lw_aerosol_optics.F90 index eb23ba21a..2047deaf4 100644 --- a/physics/rrtmgp_lw_aerosol_optics.F90 +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -28,9 +28,9 @@ end subroutine rrtmgp_lw_aerosol_optics_init !! \section arg_table_rrtmgp_lw_aerosol_optics_run !! \htmlinclude rrtmgp_lw_aerosol_optics.html !! - subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, p_lev, p_lay, p_lk, & - tv_lay, relhum, lsmask, tracer, lon, lat, lw_gas_props, sw_gas_props, & - aerodp, lw_optical_props_aerosol, errmsg, errflg) + subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer,& + p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & + lw_gas_props, sw_gas_props, aerodp, lw_optical_props_aerosol, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -38,7 +38,8 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, p_lev, p_l integer, intent(in) :: & nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers - nTracer ! Number of tracers + nTracer, & ! Number of tracers + nTracerAer ! Number of aerosol tracers real(kind_phys), dimension(nCol), intent(in) :: & lon, & ! Longitude lat, & ! Latitude @@ -50,6 +51,8 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, p_lev, p_l p_lk ! Exner function @ layer-centers (1) real(kind_phys), dimension(nCol, nLev, nTracer),intent(in) :: & tracer ! trace gas concentrations + real(kind_phys), dimension(nCol, nLev, nTracerAer),intent(in) :: & + aerfld ! aerosol input concentrations real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & p_lev ! Pressure @ layer-interfaces (Pa) type(ty_gas_optics_rrtmgp),intent(in) :: & @@ -80,7 +83,7 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, p_lev, p_l if (.not. doLWrad) return ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile - call setaer(p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, lon, lat, ncol, nLev, & + call setaer(p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, ncol, nLev, & nLev+1, .true., .true., aerosolssw, aerosolslw, aerodp) ! Allocate RRTMGP DDT: Aerosol optics [nCol,nlev,nBands] diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index ea123e236..305151270 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -33,6 +33,14 @@ type = integer intent = in optional = F +[nTracerAer] + standard_name = number_of_aerosol_tracers_MG + long_name = number of aerosol tracers for Morrison Gettelman MP + units = count + dimensions = () + type = integer + intent = in + optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation @@ -96,6 +104,15 @@ kind = kind_phys intent = in optional = F +[aerfld] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in + optional = F [lon] standard_name = longitude long_name = longitude diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 index effbfae72..4bb034279 100644 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -28,10 +28,10 @@ end subroutine rrtmgp_sw_aerosol_optics_init !! \section arg_table_rrtmgp_sw_aerosol_optics_run !! \htmlinclude rrtmgp_sw_aerosol_optics_run.html !! - subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxday, p_lev,& - p_lay, p_lk, tv_lay, relhum, lsmask, tracer, lon, lat, lw_gas_props, sw_gas_props, & - aerodp, sw_optical_props_aerosol, errmsg, errflg) - + subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nTracerAer, nDay, & + idxday, p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & + lw_gas_props, sw_gas_props, aerodp, sw_optical_props_aerosol, errmsg, errflg ) + ! Inputs logical, intent(in) :: & doSWrad ! Logical flag for shortwave radiation call @@ -39,7 +39,8 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxd nCol, & ! Number of horizontal grid points nDay, & ! Number of daylit points nLev, & ! Number of vertical layers - nTracer ! Number of tracers + nTracer, & ! Number of tracers + nTracerAer ! Number of aerosol tracers integer,intent(in),dimension(nCol) :: & idxday ! Indices for daylit points. real(kind_phys), dimension(nCol), intent(in) :: & @@ -53,6 +54,8 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxd p_lk ! Exner function @ layer-centers (1) real(kind_phys), dimension(nCol, nLev, nTracer),intent(in) :: & tracer ! trace gas concentrations + real(kind_phys), dimension(nCol, nLev, nTracerAer),intent(in) :: & + aerfld ! aerosol input concentrations real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & p_lev ! Pressure @ layer-interfaces (Pa) type(ty_gas_optics_rrtmgp),intent(in) :: & @@ -84,7 +87,7 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxd if (nDay .gt. 0) then ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile - call setaer(p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, lon, lat, nCol, nLev, & + call setaer(p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, nCol, nLev, & nLev+1, .true., .true., aerosolssw2, aerosolslw, aerodp) ! Store aerosol optical properties diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index 20240327f..1aaabf4f1 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -33,6 +33,14 @@ type = integer intent = in optional = F +[nTracerAer] + standard_name = number_of_aerosol_tracers_MG + long_name = number of aerosol tracers for Morrison Gettelman MP + units = count + dimensions = () + type = integer + intent = in + optional = F [nday] standard_name = daytime_points_dimension long_name = daytime points dimension @@ -112,6 +120,15 @@ kind = kind_phys intent = in optional = F +[aerfld] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in + optional = F [lon] standard_name = longitude long_name = longitude @@ -179,4 +196,4 @@ dimensions = () type = integer intent = out - optional = F \ No newline at end of file + optional = F diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index ff6e30b83..4edd84a7a 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -1839,16 +1839,16 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! !--------------------------------------------------------------------------- ! -! if (kdt == 1 .and. mpi_id == master) then -! print *, 'vgw done ' -!! -! print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' -! print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay' -! print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' -! print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps' -!! -!! print *, ' ugwp -heating rates ' -! endif + if (kdt == 1 .and. mpi_id == master) then + print *, 'vgw done ' +! + print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' + print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay' + print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' + print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps' +! +! print *, ' ugwp -heating rates ' + endif return end subroutine fv3_ugwp_solv2_v0 From 316f464277397ee55cbc8e03e89720c404a2a74a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 13 Apr 2020 14:33:24 -0600 Subject: [PATCH 078/141] physics/GFS_phys_time_vary.fv3.F90, physics/aerinterp.F90: bugfix for use of CCPP error handling variables in OpenMP threaded environments --- physics/GFS_phys_time_vary.fv3.F90 | 13 ++----------- physics/aerinterp.F90 | 7 ++----- 2 files changed, 4 insertions(+), 16 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 6e51e4aa8..bed8e14e1 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -61,14 +61,9 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e integer :: nb, nblks, nt integer :: i, j, ix logical :: non_uniform_blocks - character(len=len(errmsg)) :: errmsg2 - integer :: errflg2 - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - errmsg2 = '' - errflg2 = 0 if (is_initialized) return @@ -101,7 +96,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e end if !$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nt,nb,errmsg2,errflg2) & +!$OMP private (nt,nb) & !$OMP shared (Model,Data,Interstitial,errmsg,errflg) & !$OMP shared (levozp,oz_coeff,oz_pres) & !$OMP shared (levh2o,h2o_coeff,h2o_pres) & @@ -171,11 +166,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm ntrcaer = size(Data(1)%Tbd%aer_nm, dim=3) ! Read aerosol climatology - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg2,errflg2) - if (errflg2/=0) then - errflg = max(errflg,errflg2) - errmsg = trim(errmsg) // ' ' // trim(errmsg2) - end if + call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) endif else ! Update the value of ntrcaer in aerclm_def with the value defined diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index 9e73ff8c4..e7cd6ca20 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -22,8 +22,8 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) !--- in/out integer, intent(in) :: me, master, iflip, idate(4) - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg !--- locals integer :: ncid, varid, ndims, dim1, dim2, dim3, hmx @@ -38,9 +38,6 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) real(kind=kind_io8),allocatable,dimension(:) :: aer_lati real(kind=kind_io8),allocatable,dimension(:) :: aer_loni ! - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 !! =================================================================== if (me == master) then if ( iflip == 0 ) then ! data from toa to sfc From 8d9b7991a94ead20595b4d8cb0627aab9df2daad Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 17 Apr 2020 14:40:19 +0000 Subject: [PATCH 079/141] Updating MYNN-EDMF part I: ccpp-physics part --- physics/GFS_debug.F90 | 2 +- physics/module_MYNNPBL_wrapper.F90 | 127 +- physics/module_MYNNPBL_wrapper.meta | 71 +- physics/module_SGSCloud_RadPre.F90 | 40 +- physics/module_SGSCloud_RadPre.meta | 13 +- physics/module_bl_mynn.F90 | 1656 +++++++++++++++++---------- 6 files changed, 1206 insertions(+), 703 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 3bb50d9ef..b99529cc5 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -356,7 +356,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Diag%edmf_qc ', Diag%edmf_qc) call print_var(mpirank,omprank, blkno, 'Diag%nupdraft ', Diag%nupdraft) call print_var(mpirank,omprank, blkno, 'Diag%maxMF ', Diag%maxMF) - call print_var(mpirank,omprank, blkno, 'Diag%ktop_shallow', Diag%ktop_shallow) + call print_var(mpirank,omprank, blkno, 'Diag%ktop_plume ', Diag%ktop_plume) call print_var(mpirank,omprank, blkno, 'Diag%exch_h ', Diag%exch_h) call print_var(mpirank,omprank, blkno, 'Diag%exch_m ', Diag%exch_m) end if diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 36c9e55de..320585f15 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -24,7 +24,7 @@ end subroutine mynnedmf_wrapper_finalize #endif SUBROUTINE mynnedmf_wrapper_run( & & ix,im,levs, & - & flag_init,flag_restart, & + & flag_init,flag_restart,cycling, & & lssav, ldiag3d, lsidea, & & delt,dtf,dx,zorl, & & phii,u,v,omega,t3d, & @@ -46,10 +46,11 @@ SUBROUTINE mynnedmf_wrapper_run( & & qke,qke_adv,Tsq,Qsq,Cov, & & el_pbl,sh3d,exch_h,exch_m, & & Pblh,kpbl, & - & qc_bl,cldfra_bl, & + & qc_bl,qi_bl,cldfra_bl, & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & - & nupdraft,maxMF,ktop_shallow, & + & sub_thl,sub_sqv,det_thl,det_sqv,& + & nupdraft,maxMF,ktop_plume, & & RTHRATEN, & & dudt, dvdt, dtdt, & & dqdt_water_vapor, dqdt_liquid_cloud, & @@ -62,6 +63,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & bl_mynn_cloudpdf, bl_mynn_mixlength, & & bl_mynn_edmf, bl_mynn_edmf_mom, bl_mynn_edmf_tke, & & bl_mynn_edmf_part, bl_mynn_cloudmix, bl_mynn_mixqt,& + & bl_mynn_output, & & icloud_bl, do_mynnsfclay, & & imp_physics, imp_physics_gfdl, & & imp_physics_thompson, imp_physics_wsm6, & @@ -157,7 +159,7 @@ SUBROUTINE mynnedmf_wrapper_run( & LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea ! NAMELIST OPTIONS (INPUT): LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect, ltaerosol, & - lprnt, do_mynnsfclay + lprnt, do_mynnsfclay, cycling INTEGER, INTENT(IN) :: & & bl_mynn_cloudpdf, & & bl_mynn_mixlength, & @@ -169,6 +171,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & bl_mynn_cloudmix, & & bl_mynn_mixqt, & & bl_mynn_tkebudget, & + & bl_mynn_output, & & grav_settling, & & imp_physics, imp_physics_wsm6, & & imp_physics_thompson, imp_physics_gfdl @@ -206,10 +209,12 @@ SUBROUTINE mynnedmf_wrapper_run( & & dqdt_ozone, dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc real(kind=kind_phys), dimension(im,levs), intent(inout) :: & & qke, qke_adv, EL_PBL, Sh3D, & - & qc_bl, cldfra_bl - real(kind=kind_phys), dimension(im,levs), intent(inout) :: & + & qc_bl, qi_bl, cldfra_bl +!These 10 arrays are only allocated when bl_mynn_output > 0 + real(kind=kind_phys), dimension(:,:), intent(inout) :: & & edmf_a,edmf_w,edmf_qt, & - & edmf_thl,edmf_ent,edmf_qc + & edmf_thl,edmf_ent,edmf_qc, & + & sub_thl,sub_sqv,det_thl,det_sqv real(kind=kind_phys), dimension(im,levs), intent(in) :: & & u,v,omega,t3d, & & exner,prsl, & @@ -230,8 +235,8 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind=kind_phys), dimension(im, levs), intent(in) :: htrsw, htrlw !LOCAL real(kind=kind_phys), dimension(im,levs) :: & - & qvsh,qc,qi,qnc,qni,ozone,qnwfa,qnifa, & - & dz, w, p, rho, th, qv, tke_pbl, & + & sqv,sqc,sqi,qnc,qni,ozone,qnwfa,qnifa, & + & dz, w, p, rho, th, qv, & & RUBLTEN, RVBLTEN, RTHBLTEN, RQVBLTEN, & & RQCBLTEN, RQNCBLTEN, RQIBLTEN, RQNIBLTEN, & & RQNWFABLTEN, RQNIFABLTEN, & @@ -256,7 +261,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & dtsfci_diag,dqsfci_diag,dtsfc_diag,dqsfc_diag, & & maxMF integer, dimension(im), intent(inout) :: & - & kpbl,nupdraft,ktop_shallow + & kpbl,nupdraft,ktop_plume !LOCAL real, dimension(im) :: & @@ -302,9 +307,9 @@ SUBROUTINE mynnedmf_wrapper_run( & p_qni= 0 do k=1,levs do i=1,im - qvsh(i,k) = qgrs_water_vapor(i,k) - qc(i,k) = qgrs_liquid_cloud(i,k) - qi(i,k) = qgrs_ice_cloud(i,k) + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = qgrs_ice_cloud(i,k) ozone(i,k) = qgrs_ozone(i,k) qnc(i,k) = 0. qni(i,k) = 0. @@ -330,9 +335,9 @@ SUBROUTINE mynnedmf_wrapper_run( & p_qni= 0 do k=1,levs do i=1,im - qvsh(i,k) = qgrs_water_vapor(i,k) - qc(i,k) = qgrs_liquid_cloud(i,k) - qi(i,k) = qgrs_ice_cloud(i,k) + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = qgrs_ice_cloud(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -356,9 +361,9 @@ SUBROUTINE mynnedmf_wrapper_run( & p_qni= 0 do k=1,levs do i=1,im - qvsh(i,k) = qgrs_water_vapor(i,k) - qc(i,k) = qgrs_liquid_cloud(i,k) - qi(i,k) = qgrs_ice_cloud(i,k) + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = qgrs_ice_cloud(i,k) qnc(i,k) = 0. qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -384,9 +389,9 @@ SUBROUTINE mynnedmf_wrapper_run( & p_qni= 0 do k=1,levs do i=1,im - qvsh(i,k) = qgrs_water_vapor(i,k) - qc(i,k) = qgrs_liquid_cloud(i,k) - qi(i,k) = qgrs_ice_cloud(i,k) + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = qgrs_ice_cloud(i,k) qnc(i,k) = 0. qni(i,k) = 0. qnwfa(i,k) = 0. @@ -411,9 +416,9 @@ SUBROUTINE mynnedmf_wrapper_run( & p_qni= 0 do k=1,levs do i=1,im - qvsh(i,k) = qgrs_water_vapor(i,k) - qc(i,k) = qgrs_liquid_cloud(i,k) - qi(i,k) = 0. + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = 0. qnc(i,k) = 0. qni(i,k) = 0. qnwfa(i,k) = 0. @@ -428,9 +433,10 @@ SUBROUTINE mynnedmf_wrapper_run( & do i=1,im dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv th(i,k)=t3d(i,k)/exner(i,k) - qv(i,k)=qvsh(i,k)/(1.0 - qvsh(i,k)) - qc(i,k)=qc(i,k)/(1.0 - qvsh(i,k)) - qi(i,k)=qi(i,k)/(1.0 - qvsh(i,k)) + ! keep as specific humidity + ! qv(i,k)=qvsh(i,k)/(1.0 - qvsh(i,k)) + ! qc(i,k)=qc(i,k)/(1.0 - qvsh(i,k)) + ! qi(i,k)=qi(i,k)/(1.0 - qvsh(i,k)) rho(i,k)=prsl(i,k)/(r_d*t3d(i,k)) w(i,k) = -omega(i,k)/(rho(i,k)*g) pattern_spp_pbl(i,k)=0.0 @@ -498,9 +504,9 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"dz:",dz(1,1),dz(1,2),dz(1,levs) print*,"u:",u(1,1),u(1,2),u(1,levs) print*,"v:",v(1,1),v(1,2),v(1,levs) - print*,"qv:",qv(1,1),qv(1,2),qv(1,levs) - print*,"qc:",qc(1,1),qc(1,2),qc(1,levs) - print*,"qi:",qi(1,1),qi(1,2),qi(1,levs) + print*,"sqv:",sqv(1,1),sqv(1,2),sqv(1,levs) + print*,"sqc:",sqc(1,1),sqc(1,2),sqc(1,levs) + print*,"sqi:",sqi(1,1),sqi(1,2),sqi(1,levs) print*,"rmol:",rmol(1)," ust:",ust(1) print*," dx=",dx(1),"initflag=",initflag print*,"Tsurf:",tsurf(1)," Thetasurf:",ts(1) @@ -511,7 +517,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"im=",im," levs=",levs print*,"PBLH=",pblh(1)," KPBL=",KPBL(1)," xland=",xland(1) print*,"vdfg=",vdfg(1)," ch=",ch(1) - print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) + !print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) print*,"qke:",qke(1,1),qke(1,2),qke(1,levs) print*,"el_pbl:",el_pbl(1,1),el_pbl(1,2),el_pbl(1,levs) print*,"Sh3d:",Sh3d(1,1),sh3d(1,2),sh3d(1,levs) @@ -523,17 +529,17 @@ SUBROUTINE mynnedmf_wrapper_run( & CALL mynn_bl_driver( & & initflag=initflag,restart=flag_restart, & + & cycling=cycling, & & grav_settling=grav_settling, & & delt=delt,dz=dz,dx=dx,znt=znt, & - & u=u,v=v,w=w,th=th,qv=qv,qc=qc, & - & qi=qi,qni=qni,qnc=qnc, & - & qnwfa=qnwfa,qnifa=qnifa, & + & u=u,v=v,w=w,th=th,sqv3D=sqv,sqc3D=sqc, & + & sqi3D=sqi,qni=qni,qnc=qnc, & + & qnwfa=qnwfa,qnifa=qnifa,ozone=ozone, & & p=prsl,exner=exner,rho=rho,T3D=t3d, & & xland=xland,ts=ts,qsfc=qsfc,qcg=qcg,ps=ps, & & ust=ust,ch=ch,hfx=hfx,qfx=qfx,rmol=rmol, & & wspd=wspd,uoce=uoce,voce=voce,vdfg=vdfg, & !input - & qke=QKE,TKE_PBL=TKE_PBL, & - & sh3d=Sh3d, & !output + & qke=QKE,sh3d=Sh3d, & !output & qke_adv=qke_adv,bl_mynn_tkeadvect=bl_mynn_tkeadvect,& #if (WRF_CHEM == 1) & chem3d=chem,vd3d=vd,nchem=nchem,kdvel=kdvel, & @@ -544,7 +550,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & RQVBLTEN=RQVBLTEN,RQCBLTEN=rqcblten, & & RQIBLTEN=rqiblten,RQNCBLTEN=rqncblten, & !output & RQNIBLTEN=rqniblten,RQNWFABLTEN=RQNWFABLTEN, & !output - & RQNIFABLTEN=RQNIFABLTEN, & !output + & RQNIFABLTEN=RQNIFABLTEN,dozone=dqdt_ozone, & !output & EXCH_H=exch_h,EXCH_M=exch_m, & !output & pblh=pblh,KPBL=KPBL & !output & ,el_pbl=el_pbl & !output @@ -555,17 +561,20 @@ SUBROUTINE mynnedmf_wrapper_run( & & ,bl_mynn_cloudpdf=bl_mynn_cloudpdf & !input parameter & ,bl_mynn_mixlength=bl_mynn_mixlength & !input parameter & ,icloud_bl=icloud_bl & !input parameter - & ,qc_bl=qc_bl,cldfra_bl=cldfra_bl & !output + & ,qc_bl=qc_bl,qi_bl=qi_bl,cldfra_bl=cldfra_bl & !output & ,levflag=levflag,bl_mynn_edmf=bl_mynn_edmf & !input parameter & ,bl_mynn_edmf_mom=bl_mynn_edmf_mom & !input parameter & ,bl_mynn_edmf_tke=bl_mynn_edmf_tke & !input parameter & ,bl_mynn_mixscalars=bl_mynn_mixscalars & !input parameter + & ,bl_mynn_output=bl_mynn_output & !input parameter & ,bl_mynn_cloudmix=bl_mynn_cloudmix & !input parameter & ,bl_mynn_mixqt=bl_mynn_mixqt & !input parameter & ,edmf_a=edmf_a,edmf_w=edmf_w,edmf_qt=edmf_qt & !output & ,edmf_thl=edmf_thl,edmf_ent=edmf_ent,edmf_qc=edmf_qc &!output + & ,sub_thl3D=sub_thl,sub_sqv3D=sub_sqv & + & ,det_thl3D=det_thl,det_sqv3D=det_sqv & & ,nupdraft=nupdraft,maxMF=maxMF & !output - & ,ktop_shallow=ktop_shallow & !output + & ,ktop_plume=ktop_plume & !output & ,spp_pbl=spp_pbl,pattern_spp_pbl=pattern_spp_pbl & !input & ,RTHRATEN=RTHRATEN & !input & ,FLAG_QI=flag_qi,FLAG_QNI=flag_qni & !input @@ -605,9 +614,9 @@ SUBROUTINE mynnedmf_wrapper_run( & ! WSM6 do k=1,levs do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 enddo enddo @@ -625,10 +634,10 @@ SUBROUTINE mynnedmf_wrapper_run( & if(ltaerosol) then do k=1,levs do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) !dqdt_ozone(i,k) = 0.0 dqdt_water_aer_num_conc(i,k) = RQNWFABLTEN(i,k) @@ -651,9 +660,9 @@ SUBROUTINE mynnedmf_wrapper_run( & !Thompson (2008) do k=1,levs do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) !dqdt_ozone(i,k) = 0.0 enddo @@ -672,9 +681,9 @@ SUBROUTINE mynnedmf_wrapper_run( & ! GFDL MP do k=1,levs do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_rain(i,k) = 0.0 !dqdt_snow(i,k) = 0.0 !dqdt_graupel(i,k) = 0.0 @@ -693,8 +702,8 @@ SUBROUTINE mynnedmf_wrapper_run( & ! print*,"In MYNN wrapper. Unknown microphysics scheme, imp_physics=",imp_physics do k=1,levs do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_cloud(i,k) = 0.0 !dqdt_rain(i,k) = 0.0 !dqdt_snow(i,k) = 0.0 @@ -736,9 +745,9 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"dz:",dz(1,1),dz(1,2),dz(1,levs) print*,"u:",u(1,1),u(1,2),u(1,levs) print*,"v:",v(1,1),v(1,2),v(1,levs) - print*,"qv:",qv(1,1),qv(1,2),qv(1,levs) - print*,"qc:",qc(1,1),qc(1,2),qc(1,levs) - print*,"qi:",qi(1,1),qi(1,2),qi(1,levs) + print*,"sqv:",sqv(1,1),sqv(1,2),sqv(1,levs) + print*,"sqc:",sqc(1,1),sqc(1,2),sqc(1,levs) + print*,"sqi:",sqi(1,1),sqi(1,2),sqi(1,levs) print*,"rmol:",rmol(1)," ust:",ust(1) print*,"dx(1)=",dx(1),"initflag=",initflag print*,"Tsurf:",tsurf(1)," Thetasurf:",ts(1) @@ -749,7 +758,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"im=",im," levs=",levs print*,"PBLH=",pblh(1)," KPBL=",KPBL(1)," xland=",xland(1) print*,"vdfg=",vdfg(1)," ch=",ch(1) - print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) + !print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) print*,"qke:",qke(1,1),qke(1,2),qke(1,levs) print*,"el_pbl:",el_pbl(1,1),el_pbl(1,2),el_pbl(1,levs) print*,"Sh3d:",Sh3d(1,1),sh3d(1,2),sh3d(1,levs) @@ -761,7 +770,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"dudt:",dudt(1,1),dudt(1,2),dudt(1,levs) print*,"dvdt:",dvdt(1,1),dvdt(1,2),dvdt(1,levs) print*,"dqdt:",dqdt_water_vapor(1,1),dqdt_water_vapor(1,2),dqdt_water_vapor(1,levs) - print*,"ktop_shallow:",ktop_shallow(1)," maxmf:",maxmf(1) + print*,"ktop_plume:",ktop_plume(1)," maxmf:",maxmf(1) print*,"nup:",nupdraft(1) print* endif diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 61a9ccb70..2e267b059 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -41,6 +41,14 @@ type = logical intent = in optional = F +[cycling] + standard_name = flag_for_cycling + long_name = flag for cycling or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F [lssav] standard_name = flag_diagnostics long_name = logical flag for storing diagnostics @@ -488,8 +496,17 @@ intent = inout optional = F [QC_BL] - standard_name = subgrid_cloud_mixing_ratio_pbl - long_name = subgrid cloud cloud mixing ratio from PBL scheme + standard_name = subgrid_cloud_water_mixing_ratio_pbl + long_name = subgrid cloud water mixing ratio from PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[QI_BL] + standard_name = subgrid_cloud_ice_mixing_ratio_pbl + long_name = subgrid cloud ice mixing ratio from PBL scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -559,6 +576,42 @@ kind = kind_phys intent = inout optional = F +[sub_thl] + standard_name = theta_subsidence_tendency + long_name = updraft theta subsidence tendency + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sub_sqv] + standard_name = water_vapor_subsidence_tendency + long_name = updraft water vapor subsidence tendency + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[det_thl] + standard_name = theta_detrainment_tendency + long_name = updraft theta detrainment tendency + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[det_sqv] + standard_name = water_vapor_detrainment_tendency + long_name = updraft water vapor detrainment tendency + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [nupdraft] standard_name = number_of_plumes long_name = number of plumes per grid column @@ -576,9 +629,9 @@ kind = kind_phys intent = out optional = F -[ktop_shallow] - standard_name = k_level_of_highest_reaching_plume - long_name = k-level of highest reaching plume +[ktop_plume] + standard_name = k_level_of_highest_plume + long_name = k-level of highest plume units = count dimensions = (horizontal_dimension) type = integer @@ -852,6 +905,14 @@ type = integer intent = in optional = F +[bl_mynn_output] + standard_name = mynn_output_flag + long_name = flag initialize and output extra 3D variables + units = flag + dimensions = () + type = integer + intent = in + optional = F [icloud_bl] standard_name = couple_sgs_clouds_to_radiation_flag long_name = flag for coupling sgs clouds to radiation diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index 544fe1004..e78941d81 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -40,7 +40,7 @@ subroutine sgscloud_radpre_run( & qci_conv, & imfdeepcnv, imfdeepcnv_gf, & qc_save, qi_save, & - qc_bl,cldfra_bl, & + qc_bl,qi_bl,cldfra_bl, & delp,clouds1,clouds2,clouds3, & clouds4,clouds5,slmsk, & nlay, plyr, xlat, dz,de_lgth, & @@ -67,7 +67,7 @@ subroutine sgscloud_radpre_run( & real(kind=kind_phys), dimension(im,levs), intent(inout) :: & & clouds1,clouds2,clouds3,clouds4,clouds5 real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc_save, qi_save - real(kind=kind_phys), dimension(im,levs), intent(in) :: qc_bl, cldfra_bl + real(kind=kind_phys), dimension(im,levs), intent(in) :: qc_bl, qi_bl, cldfra_bl real(kind=kind_phys), dimension(im), intent(in) :: slmsk, xlat, de_lgth real(kind=kind_phys), dimension(im,nlay), intent(in) :: plyr, dz real(kind=kind_phys), dimension(im,5), intent(inout) :: cldsa @@ -104,7 +104,8 @@ subroutine sgscloud_radpre_run( & end do end do - ! add boundary layer clouds + ! add boundary layer clouds - Note: now the temperature-dependent sorting of + ! ice and water subgrid-scale clouds is done inside the MYNN-EDMF if (do_mynnedmf) then do k = 1, levs do i = 1, im @@ -116,33 +117,30 @@ subroutine sgscloud_radpre_run( & ! clouds1(i,k) = cldfra_bl(i,k) !endif - 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 - !approximation of Hobbs et al. (1974). This allows us to only use - !one 3D array for both cloud water & ice. - !Wice = 1. - MIN(1., MAX(0., (t(i,k)-254.)/15.)) - !Wh2o = 1. - Wice - !clouds1(i,k)=MAX(clouds1(i,k),CLDFRA_BL(i,k)) - !clouds1(i,k)=MAX(0.0,MIN(1.0,clouds1(i,k))) - qc(i,k) = qc_bl(i,k)*(min(1., max(0., (T3D(i,k)-244.)/25.)))*cldfra_bl(i,k) - qi(i,k) = qc_bl(i,k)*(1. - min(1., max(0., (T3D(i,k)-244.)/25.)))*cldfra_bl(i,k) + if (qc(i,k) < 1.e-6 .and. cldfra_bl(i,k)>0.001) then + qc(i,k) = qc_bl(i,k)*cldfra_bl(i,k) + if (nint(slmsk(i)) == 1) then !land + if(qc(i,k)>1.E-8)clouds3(i,k)=5.4 !eff radius cloud water (microns) + else + !eff radius cloud water (microns), from Miles et al. + if(qc(i,k)>1.E-8)clouds3(i,k)=9.6 + endif + !calculate the liquid water path using additional BL clouds + clouds2(i,k) = max(0.0, qc(i,k) * gfac * delp(i,k)) + endif + if (qi(i,k) < 1.e-8 .and. cldfra_bl(i,k)>0.001) then + qi(i,k) = qi_bl(i,k)*cldfra_bl(i,k) Tc = T3D(i,k) - 273.15 !iwc = qi(i,k)*1.0e6*rho(i,k) - if (nint(slmsk(i)) == 1) then !land - if(qc(i,k)>1.e-8)clouds3(i,k)=5.4 !eff radius cloud water (microns) - !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos) + !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) else - !eff radius cloud water (microns), from Miles et al. - if(qc(i,k)>1.E-8)clouds3(i,k)=9.6 - !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 8b) !IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) endif - !calculate water and ice paths for additional BL clouds - clouds2(i,k) = max(0.0, qc(i,k) * gfac * delp(i,k)) + !calculate the ice water path using additional BL clouds clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) endif diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index 507f4ba91..f8da4b262 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -140,8 +140,17 @@ intent = inout optional = F [QC_BL] - standard_name = subgrid_cloud_mixing_ratio_pbl - long_name = subgrid cloud cloud mixing ratio from PBL scheme + standard_name = subgrid_cloud_water_mixing_ratio_pbl + long_name = subgrid cloud water mixing ratio from PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[QI_BL] + standard_name = subgrid_cloud_ice_mixing_ratio_pbl + long_name = subgrid cloud ice mixing ratio from PBL scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index e472a2873..4c1468797 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -1,118 +1,131 @@ !>\file module_bl_mynn.F90 !! This file contains the entity of MYNN-EDMF PBL scheme. - !WRF:MODEL_LAYER:PHYSICS ! +! translated from NN f77 to F90 and put into WRF by Mariusz Pagowski +! NOAA/GSD & CIRA/CSU, Feb 2008 +! changes to original code: +! 1. code is 1D (in z) +! 2. no advection of TKE, covariances and variances +! 3. Cranck-Nicholson replaced with the implicit scheme +! 4. removed terrain dependent grid since input in WRF in actual +! distances in z[m] +! 5. cosmetic changes to adhere to WRF standard (remove common blocks, +! intent etc) +!------------------------------------------------------------------- +!Modifications implemented by Joseph Olson and Jaymes Kenyon NOAA/GSD/MDB - CU/CIRES +! +! Departures from original MYNN (Nakanish & Niino 2009) +! 1. Addition of BouLac mixing length in the free atmosphere. +! 2. Changed the turbulent mixing length to be integrated from the +! surface to the top of the BL + a transition layer depth. +! v3.4.1: Option to use Kitamura/Canuto modification which removes +! the critical Richardson number and negative TKE (default). +! Hybrid PBL height diagnostic, which blends a theta-v-based +! definition in neutral/convective BL and a TKE-based definition +! in stable conditions. +! TKE budget output option (bl_mynn_tkebudget) +! v3.5.0: TKE advection option (bl_mynn_tkeadvect) +! v3.5.1: Fog deposition related changes. +! v3.6.0: Removed fog deposition from the calculation of tendencies +! Added mixing of qc, qi, qni +! Added output for wstar, delta, TKE_PBL, & KPBL for correct +! coupling to shcu schemes +! v3.8.0: Added subgrid scale cloud output for coupling to radiation +! schemes (activated by setting icloud_bl =1 in phys namelist). +! Added WRF_DEBUG prints (at level 3000) +! Added Tripoli and Cotton (1981) correction. +! Added namelist option bl_mynn_cloudmix to test effect of mixing +! cloud species (default = 1: on). +! Added mass-flux option (bl_mynn_edmf, = 1 for DMP mass-flux, 0: off). +! Related options: +! bl_mynn_edmf_mom = 1 : activate momentum transport in MF scheme +! bl_mynn_edmf_tke = 1 : activate TKE transport in MF scheme +! Added mixing length option (bl_mynn_mixlength, see notes below) +! Added more sophisticated saturation checks, following Thompson scheme +! Added new cloud PDF option (bl_mynn_cloudpdf = 2) from Chaboureau +! and Bechtold (2002, JAS, with mods) +! Added capability to mix chemical species when env variable +! WRF_CHEM = 1, thanks to Wayne Angevine. +! Added scale-aware mixing length, following Junshi Ito's work +! Ito et al. (2015, BLM). +! v3.9.0 Improvement to the mass-flux scheme (dynamic number of plumes, +! better plume/cloud depth, significant speed up, better cloud +! fraction). +! Added Stochastic Parameter Perturbation (SPP) implementation. +! Many miscellaneous tweaks to the mixing lengths and stratus +! component of the subgrid clouds. +! v.4.0 Removed or added alternatives to WRF-specific functions/modules +! for the sake of portability to other models. +! the sake of portability to other models. +! Further refinement of mass-flux scheme from SCM experiments with +! Wayne Angevine: switch to linear entrainment and back to +! Simpson and Wiggert-type w-equation. +! Addition of TKE production due to radiation cooling at top of +! clouds (proto-version); not activated by default. +! Some code rewrites to move if-thens out of loops in an attempt to +! improve computational efficiency. +! New tridiagonal solver, which is supposedly 14% faster and more +! conservative. Impact seems very small. +! Many miscellaneous tweaks to the mixing lengths and stratus +! component of the subgrid-scale (SGS) clouds. +! v4.1 Big improvements in downward SW radiation due to revision of subgrid clouds +! - better cloud fraction and subgrid scale mixing ratios. +! - may experience a small cool bias during the daytime now that high +! SW-down bias is greatly reduced... +! Some tweaks to increase the turbulent mixing during the daytime for +! bl_mynn_mixlength option 2 to alleviate cool bias (very small impact). +! Improved ensemble spread from changes to SPP in MYNN +! - now perturbing eddy diffusivity and eddy viscosity directly +! - now perturbing background rh (in SGS cloud calc only) +! - now perturbing entrainment rates in mass-flux scheme +! Added IF checks (within IFDEFS) to protect mixchem code from being used +! when HRRR smoke is used (no impact on regular non-wrf chem use) +! Important bug fix for wrf chem when transporting chemical species in MF scheme +! Removed 2nd mass-flux scheme (no only bl_mynn_edmf = 1, no option 2) +! Removed unused stochastic code for mass-flux scheme +! Changed mass-flux scheme to be integrated on interface levels instead of +! mass levels - impact is small +! Added option to mix 2nd moments in MYNN as opposed to the scalar_pblmix option. +! - activated with bl_mynn_mixscalars = 1; this sets scalar_pblmix = 0 +! - added tridagonal solver used in scalar_pblmix option to duplicate tendencies +! - this alone changes the interface call considerably from v4.0. +! Slight revision to TKE production due to radiation cooling at top of clouds +! Added the non-Guassian buoyancy flux function of Bechtold and Siebesma (1998, JAS). +! - improves TKE in SGS clouds +! Added heating due to dissipation of TKE (small impact, maybe + 0.1 C daytime PBL temp) +! Misc changes made for FV3/MPAS compatibility +! v4.2 A series of small tweaks to help reduce a cold bias in the PBL: +! - slight increase in diffusion in convective conditions +! - relaxed criteria for mass-flux activation/strength +! - added capability to cycle TKE for continuity in hourly updating HRRR +! - added effects of compensational environmental subsidence in mass-flux scheme, +! which resulted in tweaks to detrainment rates. +! Bug fix for diagnostic-decay of SGS clouds - noticed by Greg Thompson. This has +! a very small, but primarily positive, impact on SW-down biases. +! Tweak to calculation of KPBL - urged by Laura Fowler - to make more intuitive. +! Tweak to temperature range of blending for saturation check (water to ice). This +! slightly reduces excessive SGS clouds in polar region. No impact warm clouds. +! Added namelist option bl_mynn_output (0 or 1) to suppress or activate the +! allocation and output of 10 3D variables. Most people will want this +! set to 0 (default) to save memory and disk space. +! Added new array qi_bl as opposed to using qc_bl for both SGS qc and qi. This +! gives us more control of the magnitudes which can be confounded by using +! a single array. As a results, many subroutines needed to be modified, +! especially mym_condensation. +! Added the blending of the stratus component of the SGS clouds to the mass-flux +! clouds to account for situations where stratus and cumulus may exist in the +! grid cell. +! Misc small-impact bugfixes: +! 1) dz was incorrectly indexed in mym_condensation +! 2) configurations with icloud_bl = 0 were using uninitialized arrays +! +! Many of these changes are now documented in Olson et al. (2019, +! NOAA Technical Memorandum) +! +! For more explanation of some configuration options, see "JOE's mods" below: +!------------------------------------------------------------------- -!>\defgroup gsd_mynn_edmf GSD MYNN-EDMF PBL Scheme Module -!! The MYNN-EDMF scheme (Olson et al. 2019 \cite olson_et_al_2019) represents the local -!! mixing using an eddy-diffusivity approach tied to turbulent kinetic energy (TKE). -!! The nonlocal mixing, important for convective boundary layers, is represented using -!! a mass-flux approach. The scheme can be run with either a 2.5 or 3.0 closure and includes -!! a partial-condensation scheme, commonly referred to as a cloud PDF or statistical-cloud -!! scheme, to represent the effects of subgrid-scale (SGS) clouds on buoyancy. -!! This module was originally translated from Nakanishi and Niino (2009) \cite NAKANISHI_2009 -!! and put into the WRF model by Mariusz Pagowski NOAA/GSD and CIRA/CSU in 2008. It was -!! extensively modified by Joseph Olson and Jaymes Kenyon of NOAA/GSD and CU/CIRES. -!! -!! Changes to original code introduced by M. Pagowski in 2008: -!! -# Code is 1D (in z) -!! -# No advection of TKE, covariances and variances -!! -# Cranck-Nicholson replaced with the implicit scheme -!! -# Removed terrain dependent grid since input in WRF in actual distances in z[m] -!! -# Cosmetic changes to adhere to WRF standard (remove common blocks, intent etc) -!! -!! Further modifications implemented by J. Olson and J. Kenyon: -!! -!! Departures from original MYNN (Nakanish and Niino (2009) \cite NAKANISHI_2009) -!! -# Added the of BouLac mixing length in the free atmosphere. -!! -# Changed the turbulent mixing length to be integrated from the -!! surface to the top of the BL plus a transition layer depth. -!! -!! Changes made in various versions of the WRF model: -!!\version v3.4.1: -!! - Option to use Kitamura/Canuto modification which removes -!! the critical Richardson number and negative TKE (default) -!! - Hybrid PBL height diagnostic, which blends a theta-v-based -!! definition in neutral/convective BL and a TKE-based definition -!! in stable conditions. -!! - TKE budget output option (bl_mynn_tkebudget) -!!\version v3.5.0: -!! - TKE advection option (bl_mynn_tkeadvect) -!!\version v3.5.1: -!! - Fog deposition related changes -!!\version v3.6.0: -!! - Removed fog deposition from the calculation of tendencies -!! - Added mixing of qc, qi, qni -!! - Added output for wstar, delta, TKE_PBL, & KPBL for correct -!! coupling to shcu schemes -!!\version v3.8.0: -!! - Added subgrid scale cloud output for coupling to radiation -!! schemes (activated by setting icloud_bl =1 in phys namelist) -!! - Added WRF_DEBUG prints (at level 3000) -!! - Added Tripoli and Cotton (1981) \cite Tripoli_1981 correction -!! - Added namelist option bl_mynn_cloudmix to test effect of mixing cloud species (default = 1: on) -!! - Added mass-flux option (bl_mynn_edmf, = 1 for DMP mass-flux, 0: off). Related options: -!! - bl_mynn_edmf_mom = 1 : activate momentum transport in MF scheme -!! - bl_mynn_edmf_tke = 1 : activate TKE transport in MF scheme -!! - Added mixing length option (bl_mynn_mixlength, see notes below) -!! - Added more sophisticated saturation checks, following Thompson scheme -!! - Added new cloud PDF option (bl_mynn_cloudpdf = 2) from Chaboureau -!! and Bechtold (2002) \cite Chaboureau_2002 with modifications -!! - Added capability to mix chemical species when env variable -!! WRF_CHEM = 1, thanks to Wayne Angevine -!! - Added scale-aware mixing length, following Junshi Ito's work -!! Ito et al. (2015, BLM) \cite Ito_2015 -!!\version v3.9.0: -!! - Improvement to the mass-flux scheme (dynamic number of plumes, -!! better plume/cloud depth, significant speed up, better cloud fraction) -!! - Added Stochastic Parameter Perturbation (SPP) implementation -!! - Many miscellaneous tweaks to the mixing lengths and stratus -!! component of the subgrid clouds -!!\version v4.0: -!! - Removed or added alternatives to WRF-specific functions/modules -!! for the sake of portability to other models -!! - Further refinement of mass-flux scheme from SCM experiments with -!! Wayne Angevine: switch to linear entrainment and back to -!! Simpson and Wiggert-type w-equation -!! - Addition of TKE production due to radiation cooling at top of -!! clouds (proto-version); not activated by default -!! - Some code rewrites to move if-thens out of loops in an attempt to -!! improve computational efficiency -!! - New tridiagonal solver, which is supposedly 14% faster and more -!! conservative. Impact seems very small -!! - Many miscellaneous tweaks to the mixing lengths and stratus -!! component of the subgrid-scale (SGS) clouds -!!\version v4.1: -!! - Big improvements in downward SW radiation due to revision of subgrid clouds -!! - better cloud fraction and subgrid scale mixing ratios -!! - may experience a small cool bias during the daytime now that high -!! SW-down bias is greatly reduced -!! - Some tweaks to increase the turbulent mixing during the daytime for -!! bl_mynn_mixlength option 2 to alleviate cool bias (very small impact) -!! - Improved ensemble spread from changes to Stochastic Parameter Perturbation (SPP) in MYNN -!! - now perturbing eddy diffusivity and eddy viscosity directly -!! - now perturbing background rh (in SGS cloud calc only) -!! - now perturbing entrainment rates in mass-flux scheme -!! - Added IF checks (within IFDEFS) to protect mixchem code from being used -!! when HRRR smoke is used (no impact when WRF-CHEM is not used) -!! - Important bug fix for WRF-CHEM when transporting chemical species in MF scheme -!! - Removed 2nd mass-flux scheme (no only bl_mynn_edmf = 1, no option 2) -!! - Removed unused stochastic code for mass-flux scheme -!! - Changed mass-flux scheme to be integrated on interface levels instead of -!! mass levels - impact is small -!! - Added option to mix second moments in MYNN as opposed to the scalar_pblmix option. -!! - activated with bl_mynn_mixscalars = 1; this sets scalar_pblmix = 0 -!! - added tridagonal solver used in scalar_pblmix option to duplicate tendencies -!! - this alone changes the interface call considerably from v4.0 -!! - Slight revision to TKE production due to radiation cooling at top of clouds -!! - Added the non-Guassian buoyancy flux function of Bechtold and Siebesma (1998) \cite Bechtold_1998 -!! - improves TKE in SGS clouds -!! - Added heating due to dissipation of TKE (small impact, maybe + 0.1 C daytime PBL temp) -!! - Miscellaneous changes made for FV3/MPAS compatibility -!! -!!Many of these changes are now documented in Olson et al. (2019, -!! NOAA Technical Memorandum) MODULE module_bl_mynn !================================================================== @@ -219,7 +232,8 @@ MODULE module_bl_mynn REAL, PARAMETER :: rr2=0.7071068, rrp=0.3989423 ! 'parameters' for Poisson distribution (EDMF scheme) - REAL, PARAMETER :: zero = 0.0, half = 0.5, one = 1.0, two = 2.0 + REAL, PARAMETER :: zero = 0.0, half = 0.5, one = 1.0, two = 2.0, & + onethird = 1./3., twothirds = 2./3. !>Use Canuto/Kitamura mod (remove Ric and negative TKE) (1:yes, 0:no) !!For more info, see Canuto et al. (2008 JAS) and Kitamura (Journal of the @@ -245,7 +259,10 @@ MODULE module_bl_mynn !>Option to activate heating due to dissipation of TKE (to activate, set to 1.0) REAL, PARAMETER :: dheat_opt = 1. - !>option to print out more stuff for debugging purposes + !Option to activate environmental subsidence in mass-flux scheme + LOGICAL, PARAMETER :: env_subs = .true. + + !option to print out more stuff for debugging purposes LOGICAL, PARAMETER :: debug_code = .false. ! JAYMES- @@ -450,12 +467,14 @@ SUBROUTINE mym_initialize ( & & Qke, Tsq, Qsq, Cov, Psig_bl, cldfra_bl1D, & & bl_mynn_mixlength, & & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf, & + & INITIALIZE_QKE, & & spp_pbl,rstoch_col) ! !------------------------------------------------------------------- INTEGER, INTENT(IN) :: kts,kte INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf + LOGICAL, INTENT(IN) :: INITIALIZE_QKE ! REAL, INTENT(IN) :: ust, rmo, pmz, phh, flt, flq REAL, INTENT(IN) :: ust, rmo, Psig_bl REAL, DIMENSION(kts:kte), INTENT(in) :: dz @@ -493,7 +512,15 @@ SUBROUTINE mym_initialize ( & ! ** Preliminary setting ** el (kts) = 0.0 - qke(kts) = ust**2 * ( b1*pmz )**(2.0/3.0) + IF (INITIALIZE_QKE) THEN + !qke(kts) = ust**2 * ( b1*pmz )**(2.0/3.0) + qke(kts) = 1.5 * ust**2 * ( b1*pmz )**(2.0/3.0) + DO k = kts+1,kte + !qke(k) = 0.0 + !linearly taper off towards top of pbl + qke(k)=qke(kts)*MAX((ust*700. - zw(k))/(MAX(ust,0.01)*700.), 0.01) + ENDDO + ENDIF ! phm = phh*b2 / ( b1*pmz )**(1.0/3.0) tsq(kts) = phm*( flt/ust )**2 @@ -503,7 +530,7 @@ SUBROUTINE mym_initialize ( & DO k = kts+1,kte vkz = vk*zw(k) el (k) = vkz/( 1.0 + vkz/100.0 ) - qke(k) = 0.0 +! qke(k) = 0.0 ! tsq(k) = 0.0 qsq(k) = 0.0 @@ -512,7 +539,7 @@ SUBROUTINE mym_initialize ( & ! ! ** Initialization with an iterative manner ** ! ** lmax is the iteration count. This is arbitrary. ** - lmax = 5 + lmax = 5 ! DO l = 1,lmax ! @@ -522,7 +549,7 @@ SUBROUTINE mym_initialize ( & & dz, zw, & & rmo, flt, flq, & & vt, vq, & - & qke, & + & u, v, qke, & & dtv, & & el, & & zi,theta, & @@ -540,34 +567,38 @@ SUBROUTINE mym_initialize ( & ! ! ** Strictly, vkz*h(i,j) -> vk*( 0.5*dz(1)*h(i,j)+z0 ) ** vkz = vk*0.5*dz(kts) -! - elv = 0.5*( el(kts+1)+el(kts) ) / vkz - qke(kts) = ust**2 * ( b1*pmz*elv )**(2.0/3.0) -! + elv = 0.5*( el(kts+1)+el(kts) ) / vkz + IF (INITIALIZE_QKE)THEN + !qke(kts) = ust**2 * ( b1*pmz*elv )**(2.0/3.0) + qke(kts) = 1.0 * MAX(ust,0.02)**2 * ( b1*pmz*elv )**(2.0/3.0) + ENDIF + phm = phh*b2 / ( b1*pmz/elv**2 )**(1.0/3.0) tsq(kts) = phm*( flt/ust )**2 qsq(kts) = phm*( flq/ust )**2 cov(kts) = phm*( flt/ust )*( flq/ust ) -! + DO k = kts+1,kte-1 b1l = b1*0.25*( el(k+1)+el(k) ) - tmpq=MAX(b1l*( pdk(k+1)+pdk(k) ),qkemin) + !tmpq=MAX(b1l*( pdk(k+1)+pdk(k) ),qkemin) + !add MIN to limit unreasonable QKE + tmpq=MIN(MAX(b1l*( pdk(k+1)+pdk(k) ),qkemin),125.) ! PRINT *,'tmpqqqqq',tmpq,pdk(k+1),pdk(k) - qke(k) = tmpq**(2.0/3.0) + IF (INITIALIZE_QKE)THEN + qke(k) = tmpq**twothirds + ENDIF -! IF ( qke(k) .LE. 0.0 ) THEN b2l = 0.0 ELSE b2l = b2*( b1l/b1 ) / SQRT( qke(k) ) END IF -! + tsq(k) = b2l*( pdt(k+1)+pdt(k) ) qsq(k) = b2l*( pdq(k+1)+pdq(k) ) cov(k) = b2l*( pdc(k+1)+pdc(k) ) END DO -! END DO !! qke(kts)=qke(kts+1) @@ -575,7 +606,10 @@ SUBROUTINE mym_initialize ( & !! qsq(kts)=qsq(kts+1) !! cov(kts)=cov(kts+1) - qke(kte)=qke(kte-1) + IF (INITIALIZE_QKE)THEN + qke(kts)=0.5*(qke(kts)+qke(kts+1)) + qke(kte)=qke(kte-1) + ENDIF tsq(kte)=tsq(kte-1) qsq(kte)=qsq(kte-1) cov(kte)=cov(kte-1) @@ -760,7 +794,7 @@ SUBROUTINE mym_length ( & & dz, zw, & & rmo, flt, flq, & & vt, vq, & - & qke, & + & u1, v1, qke, & & dtv, & & el, & & zi,theta, & @@ -780,7 +814,7 @@ SUBROUTINE mym_length ( & REAL, DIMENSION(kts:kte), INTENT(in) :: dz REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw REAL, INTENT(in) :: rmo,flt,flq,Psig_bl - REAL, DIMENSION(kts:kte), INTENT(IN) :: qke,vt,vq,cldfra_bl1D,& + REAL, DIMENSION(kts:kte), INTENT(IN) :: u1,v1,qke,vt,vq,cldfra_bl1D,& edmf_w1,edmf_a1,edmf_qc1 REAL, DIMENSION(kts:kte), INTENT(out) :: qkw, el REAL, DIMENSION(kts:kte), INTENT(in) :: dtv @@ -819,7 +853,8 @@ SUBROUTINE mym_length ( & INTEGER :: i,j,k REAL :: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud,elb,els,els1,elf, & - & el_stab,el_unstab,el_mf,el_stab_mf,elb_mf,PBLH_PLUS_ENT,el_les + & el_stab,el_unstab,el_mf,el_stab_mf,elb_mf,PBLH_PLUS_ENT, & + & Uonset,Ugrid,el_les ! tv0 = 0.61*tref ! gtr = 9.81/tref @@ -1003,13 +1038,15 @@ SUBROUTINE mym_length ( & CASE (2) !Experimental mixing length formulation - cns = 3.5 - alp1 = 0.25 + 0.02*MIN(MAX(zi-200.,0.),1000.)/1000. !0.23 - alp2 = 0.6 !0.3 - alp3 = 3.0 !2.0 - alp4 = 20. !10. - alp5 = 0.6 !0.3 !like alp2, but for free atmosphere - alp6 = 50.0 !used for MF mixing length instead of BouLac (x times MF) + Uonset = 2.5 + dz(kts)*0.1 + Ugrid = sqrt(u1(kts)**2 + v1(kts)**2) + cns = 3.5 * (1.0 - MIN(MAX(Ugrid - Uonset, 0.0)/10.0, 1.0)) + alp1 = 0.23 + alp2 = 0.30 + alp3 = 2.0 + alp4 = 20. !10. + alp5 = alp2 !like alp2, but for free atmosphere + alp6 = 50.0 !used for MF mixing length ! Impose limits on the height integration for elt and the transition layer depth !zi2=MAX(zi,minzi) @@ -1025,7 +1062,7 @@ SUBROUTINE mym_length ( & afk = dz(k)/( dz(k)+dz(k-1) ) abk = 1.0 -afk qkw(k) = SQRT(MAX(qke(k)*abk+qke(k-1)*afk,1.0e-3)) - qtke(k) = 0.5*qkw(k) ! q -> TKE + qtke(k) = 0.5*qkw(k) ! qkw -> TKE END DO elt = 1.0e-5 @@ -1046,7 +1083,7 @@ SUBROUTINE mym_length ( & elt = MAX(alp1*elt/vsc, 10.) vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq - vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**(1.0/3.0) + vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**onethird ! ** Strictly, el(i,j,1) is not zero. ** el(kts) = 0.0 @@ -1061,7 +1098,7 @@ SUBROUTINE mym_length ( & bv = SQRT( gtr*dtv(k) ) !elb_mf = alp2*qkw(k) / bv & elb_mf = MAX(alp2*qkw(k), & -! &MAX(1.-2.0*cldavg,0.0)**0.5*alp6*edmf_a1(k)*edmf_w1(k)) / bv & +! &MAX(1.-0.5*cldavg,0.0)**0.5 * alp6*edmf_a1(k)*edmf_w1(k)) / bv & & alp6*edmf_a1(k)*edmf_w1(k)) / bv & & *( 1.0 + alp3*SQRT( vsc/( bv*elt ) ) ) elb = MIN(alp5*qkw(k)/bv, zwk) @@ -1084,7 +1121,7 @@ SUBROUTINE mym_length ( & ! velocity scale), except that elt is relpaced ! by zi, and zero is replaced by 1.0e-4 to ! prevent division by zero. - tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(flt,1.0e-4))**(1.0/3.0)),50.),150.) + tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(flt,1.0e-4))**onethird),50.),150.) !minimize influence of surface heat flux on tau far away from the PBLH. wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 tau_cloud = tau_cloud*(1.-wt) + 50.*wt @@ -1598,7 +1635,7 @@ SUBROUTINE mym_turbulence ( & & dz, zw, & & rmo, flt, flq, & & vt, vq, & - & qke, & + & u, v, qke, & & dtv, & & el, & & zi,theta, & @@ -1996,7 +2033,7 @@ END SUBROUTINE mym_turbulence ! ================================================================== ! SUBROUTINE mym_predict: ! -!! Input variables: see subroutine mym_initialize and turbulence +! Input variables: see subroutine mym_initialize and turbulence ! qke(nx,nz,ny) : qke at (n)th time level ! tsq, ...cov : ditto ! @@ -2361,11 +2398,12 @@ END SUBROUTINE mym_predict !! use of the namelist parameter \p bl_mynn_cloudpdf . SUBROUTINE mym_condensation (kts,kte, & & dx, dz, zw, & - & thl, qw, & + & thl, qw, qv, qc, qi, & & p,exner, & & tsq, qsq, cov, & & Sh, el, bl_mynn_cloudpdf,& - & qc_bl1D, cldfra_bl1D, & + & qc_bl1D, qi_bl1D, & + & cldfra_bl1D, & & PBLH1,HFX1, & & Vt, Vq, th, sgm, rmo, & & spp_pbl,rstoch_col ) @@ -2382,18 +2420,20 @@ SUBROUTINE mym_condensation (kts,kte, & REAL, INTENT(IN) :: dx,PBLH1,HFX1,rmo REAL, DIMENSION(kts:kte), INTENT(IN) :: dz REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw - REAL, DIMENSION(kts:kte), INTENT(IN) :: p,exner, thl, qw, & + REAL, DIMENSION(kts:kte), INTENT(IN) :: p,exner,thl,qw,qv,qc,qi, & &tsq, qsq, cov, th REAL, DIMENSION(kts:kte), INTENT(INOUT) :: vt,vq,sgm - REAL, DIMENSION(kts:kte) :: qmq,alp,a,bet,b,ql,q1,cld,RH - REAL, DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,cldfra_bl1D + REAL, DIMENSION(kts:kte) :: qmq,alp,a,bet,b,ql,q1,RH + REAL, DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,qi_bl1D, & + cldfra_bl1D DOUBLE PRECISION :: t3sq, r3sq, c3sq REAL :: qsl,esat,qsat,tlk,qsat_tl,dqsl,cld0,q1k,eq1,qll,& &q2p,pt,rac,qt,t,xl,rsl,cpm,cdhdz,Fng,qww,alpha,beta,bb,& - &ls_min,ls,wt,cld_factor,fac_damp + &ls_min,ls,wt,cld_factor,fac_damp,liq_frac,ql_ice,ql_water,& + &low_weight INTEGER :: i,j,k REAL :: erf @@ -2403,12 +2443,8 @@ SUBROUTINE mym_condensation (kts,kte, & REAL, DIMENSION(kts:kte), INTENT(IN) :: Sh,el !JOE: variables for BL clouds - REAL::zagl,cld9,damp,edown,RHcrit,RHmean,RHsum,RHnum,Hshcu,PBLH2,ql_limit - REAL, PARAMETER :: Hfac = 3.0 !cloud depth factor for HFX (m^3/W) - REAL, PARAMETER :: HFXmin = 50.0 !min W/m^2 for BL clouds - REAL :: RH_00L, RH_00O, phi_dz, lfac - REAL, PARAMETER :: cdz = 2.0 - REAL, PARAMETER :: mdz = 1.5 + REAL::zagl,damp,PBLH2,ql_limit + REAL :: lfac !JAYMES: variables for tropopause-height estimation REAL :: theta1, theta2, ht1, ht2 @@ -2463,14 +2499,10 @@ SUBROUTINE mym_condensation (kts,kte, & qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) !dqw/dT: Clausius-Clapeyron dqsl = qsl*ep_2*ev/( rd*t**2 ) - !RH (0 to 1.0) - RH(k)=MAX(MIN(1.0,qw(k)/MAX(1.E-8,qsl)),0.001) alp(k) = 1.0/( 1.0+dqsl*xlvcp ) bet(k) = dqsl*exner(k) - !NOTE: negative bl_mynn_cloudpdf will zero-out the stratus subgrid clouds - ! at the end of this subroutine. !Sommeria and Deardorff (1977) scheme, as implemented !in Nakanishi and Niino (2009), Appendix B t3sq = MAX( tsq(k), 0.0 ) @@ -2480,13 +2512,38 @@ SUBROUTINE mym_condensation (kts,kte, & r3sq = r3sq +bet(k)**2*t3sq -2.0*bet(k)*c3sq !DEFICIT/EXCESS WATER CONTENT qmq(k) = qw(k) -qsl - !ORIGINAL STANDARD DEVIATION: limit e-6 produces ~10% more BL clouds - !than e-10 + !ORIGINAL STANDARD DEVIATION sgm(k) = SQRT( MAX( r3sq, 1.0d-10 )) !NORMALIZED DEPARTURE FROM SATURATION q1(k) = qmq(k) / sgm(k) !CLOUD FRACTION. rr2 = 1/SQRT(2) = 0.707 - cld(k) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) + cldfra_bl1D(k) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) + + eq1 = rrp*EXP( -0.5*q1k*q1k ) + qll = MAX( cldfra_bl1D(k)*q1k + eq1, 0.0 ) + !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) + ql(k) = alp(k)*sgm(k)*qll + !LIMIT SPECIES TO TEMPERATURE RANGES + liq_frac = min(1.0, max(0.0,(t-240.0)/29.0)) + qc_bl1D(k) = liq_frac*ql(k) + qi_bl1D(k) = (1.0 - liq_frac)*ql(k) + + if(cldfra_bl1D(k)>0.01 .and. qc_bl1D(k)<1.E-6)qc_bl1D(k)=1.E-6 + if(cldfra_bl1D(k)>0.01 .and. qi_bl1D(k)<1.E-8)qi_bl1D(k)=1.E-8 + + !Now estimate the buiyancy flux functions + q2p = xlvcp/exner(k) + pt = thl(k) +q2p*ql(k) ! potential temp + + !qt is a THETA-V CONVERSION FOR TOTAL WATER (i.e., THETA-V = qt*THETA) + qt = 1.0 +p608*qw(k) -(1.+p608)*(qc_bl1D(k)+qi_bl1D(k))*cldfra_bl1D(k) + rac = alp(k)*( cldfra_bl1D(K)-qll*eq1 )*( q2p*qt-(1.+p608)*pt ) + + !BUOYANCY FACTORS: wherever vt and vq are used, there is a + !"+1" and "+tv0", respectively, so these are subtracted out here. + !vt is unitless and vq has units of K. + vt(k) = qt-1.0 -rac*bet(k) + vq(k) = p608*pt-tv0 +rac END DO @@ -2501,8 +2558,6 @@ SUBROUTINE mym_condensation (kts,kte, & qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) !dqw/dT: Clausius-Clapeyron dqsl = qsl*ep_2*ev/( rd*t**2 ) - !RH (0 to 1.0) - RH(k)=MAX(MIN(1.0,qw(k)/MAX(1.E-8,qsl)),0.001) alp(k) = 1.0/( 1.0+dqsl*xlvcp ) bet(k) = dqsl*exner(k) @@ -2510,7 +2565,7 @@ SUBROUTINE mym_condensation (kts,kte, & if (k .eq. kts) then dzk = 0.5*dz(k) else - dzk = 0.5*( dz(k) + dz(k-1) ) + dzk = dz(k) end if dth = 0.5*(thl(k+1)+thl(k)) - 0.5*(thl(k)+thl(MAX(k-1,kts))) dqw = 0.5*(qw(k+1) + qw(k)) - 0.5*(qw(k) + qw(MAX(k-1,kts))) @@ -2519,12 +2574,44 @@ SUBROUTINE mym_condensation (kts,kte, & (dqw/dzk - bet(k)*(dth/dzk ))**2 , 1.0e-10) ) qmq(k) = qw(k) -qsl q1(k) = qmq(k) / sgm(k) - cld(k) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) + cldfra_bl1D(K) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) + + !now compute estimated lwc for PBL scheme's use + !qll IS THE NORMALIZED LIQUID WATER CONTENT (Sommeria and + !Deardorff (1977, eq 29a). rrp = 1/(sqrt(2*pi)) = 0.3989 + q1k = q1(k) + eq1 = rrp*EXP( -0.5*q1k*q1k ) + qll = MAX( cldfra_bl1D(K)*q1k + eq1, 0.0 ) + !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) + ql (k) = alp(k)*sgm(k)*qll + liq_frac = min(1.0, max(0.0,(t-240.0)/29.0)) + qc_bl1D(k) = liq_frac*ql(k) + qi_bl1D(k) = (1.0 - liq_frac)*ql(k) + + if(cldfra_bl1D(k)>0.01 .and. qc_bl1D(k)<1.E-6)qc_bl1D(k)=1.E-6 + if(cldfra_bl1D(k)>0.01 .and. qi_bl1D(k)<1.E-8)qi_bl1D(k)=1.E-8 + + !Now estimate the buiyancy flux functions + q2p = xlvcp/exner(k) + pt = thl(k) +q2p*ql(k) ! potential temp + + !qt is a THETA-V CONVERSION FOR TOTAL WATER (i.e., THETA-V = qt*THETA) + qt = 1.0 +p608*qw(k) -(1.+p608)*(qc_bl1D(k)+qi_bl1D(k))*cldfra_bl1D(k) + rac = alp(k)*( cldfra_bl1D(K)-qll*eq1 )*( q2p*qt-(1.+p608)*pt ) + + !BUOYANCY FACTORS: wherever vt and vq are used, there is a + !"+1" and "+tv0", respectively, so these are subtracted out here. + !vt is unitless and vq has units of K. + vt(k) = qt-1.0 -rac*bet(k) + vq(k) = p608*pt-tv0 +rac + END DO CASE (2, -2) - !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS - !JAYMES- this added 27 Apr 2015 + !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS + !JAYMES- this added 27 Apr 2015 + PBLH2=MAX(10.,PBLH1) + zagl = 0. DO k = kts,kte-1 t = th(k)*exner(k) !SATURATED VAPOR PRESSURE @@ -2541,48 +2628,38 @@ SUBROUTINE mym_condensation (kts,kte, & bet(k) = dqsl*exner(k) xl = xl_blend(t) ! obtain latent heat - tlk = thl(k)*(p(k)/p1000mb)**rcp ! recover liquid temp (tl) from thl - qsat_tl = qsat_blend(tlk,p(k)) ! get saturation water vapor mixing ratio ! at tl and p - rsl = xl*qsat_tl / (r_v*tlk**2) ! slope of C-C curve at t = tl ! CB02, Eqn. 4 - cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 - a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" - !SPP qw_pert = qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) - !qmq(k) = a(k) * (qw(k) - qsat_tl) ! saturation deficit/excess; ! the numerator of Q1 qmq(k) = a(k) * (qw_pert - qsat_tl) - b(k) = a(k)*rsl ! CB02 variable "b" - dtl = 0.5*(thl(k+1)*(p(k+1)/p1000mb)**rcp + tlk) & & - 0.5*(tlk + thl(MAX(k-1,kts))*(p(MAX(k-1,kts))/p1000mb)**rcp) - dqw = 0.5*(qw(k+1) + qw(k)) - 0.5*(qw(k) + qw(MAX(k-1,kts))) if (k .eq. kts) then dzk = 0.5*dz(k) else - dzk = 0.5*( dz(k) + dz(k-1) ) + dzk = dz(k) end if cdhdz = dtl/dzk + (g/cpm)*(1.+qw(k)) ! expression below Eq. 9 ! in CB02 - zagl = zagl + dz(k) !Use analog to surface layer length scale to make the cloud mixing length scale !become less than z in stable conditions. - els = zagl ! /(1.0 + 1.0*MIN( 0.5*dz(1)*MAX(rmo,0.0), 1. )) + els = zagl !save for more testing: /(1.0 + 1.0*MIN( 0.5*dz(1)*MAX(rmo,0.0), 1. )) - ls_min = 300. + MIN(3.*MAX(HFX1,0.),300.) + !ls_min = 300. + MIN(3.*MAX(HFX1,0.),300.) + ls_min = 300. + MIN(2.*MAX(HFX1,0.),150.) ls_min = MIN(MAX(els,25.),ls_min) ! Let this be the minimum possible length scale: if (zagl > PBLH1+2000.) ls_min = MAX(ls_min + 0.5*(PBLH1+2000.-zagl),300.) ! 25 m < ls_min(=zagl) < 300 m @@ -2590,7 +2667,6 @@ SUBROUTINE mym_condensation (kts,kte, & ! lfac(750 m) = 4.4 ! lfac(3 km) = 5.0 ! lfac(13 km) = 6.0 - ls = MAX(MIN(lfac*el(k),600.),ls_min) ! Bounded: ls_min < ls < 600 m ! Note: CB02 use 900 m as a constant free-atmosphere length scale. @@ -2606,118 +2682,80 @@ SUBROUTINE mym_condensation (kts,kte, & ! based on tests q1(k) = qmq(k) / sgm(k) ! Q1, the normalized saturation - - cld(k) = MAX(0., MIN(1., 0.5+0.36*ATAN(1.55*q1(k)))) ! Eq. 7 in CB02 - - END DO - - END SELECT - - zagl = 0. - RHsum=0. - RHnum=0. - RHmean=0.1 !initialize with small value for small PBLH cases - damp =0 - PBLH2=MAX(10.,PBLH1) - - SELECT CASE(bl_mynn_cloudpdf) - - CASE (-1 : 1) ! ORIGINAL MYNN PARTIAL-CONDENSATION SCHEME - ! OR KUWANO ET AL. - DO k = kts,kte-1 - t = th(k)*exner(k) - q1k = q1(k) - zagl = zagl + dz(k) - !q1=0. - !cld(k)=0. - - !COMPUTE MEAN RH IN PBL (NOT PRESSURE WEIGHTED). - IF (zagl < PBLH2 .AND. PBLH2 > 400.) THEN - RHsum=RHsum+RH(k) - RHnum=RHnum+1.0 - RHmean=RHsum/RHnum - ENDIF - - RHcrit = 1. - 0.35*(1.0 - (MAX(250.- MAX(HFX1,HFXmin),0.0)/200.)**2) - if (HFX1 > HFXmin) then - cld9=MIN(MAX(0., (rh(k)-RHcrit)/(1.1-RHcrit)), 1.)**2 - else - cld9=0.0 - endif - - edown=PBLH2*.1 - !Vary BL cloud depth (Hshcu) by mean RH in PBL and HFX - !(somewhat following results from Zhang and Klein (2013, JAS)) - Hshcu=200. + (RHmean+0.5)**1.5*MAX(HFX1,0.)*Hfac - if (zagl < PBLH2-edown) then - damp=MIN(1.0,exp(-ABS(((PBLH2-edown)-zagl)/edown))) - elseif(zagl >= PBLH2-edown .AND. zagl < PBLH2+Hshcu)then - damp=1. - elseif (zagl >= PBLH2+Hshcu)then - damp=MIN(1.0,exp(-ABS((zagl-(PBLH2+Hshcu))/500.))) - endif - cldfra_bl1D(k)=cld9*damp - !cldfra_bl1D(k)=cld(k) ! JAYMES: use this form to retain the Sommeria-Deardorff value - - !use alternate cloud fraction to estimate qc for use in BL clouds-radiation - eq1 = rrp*EXP( -0.5*q1k*q1k ) - qll = MAX( cldfra_bl1D(k)*q1k + eq1, 0.0 ) - !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) - ql (k) = alp(k)*sgm(k)*qll - if(cldfra_bl1D(k)>0.01 .and. ql(k)<1.E-6)ql(k)=1.E-6 - qc_bl1D(k)=ql(k)*damp - !qc_bl1D(k)=ql(k) ! JAYMES: use this form to retain the Sommeria-Deardorff value - - !now recompute estimated lwc for PBL scheme's use - !qll IS THE NORMALIZED LIQUID WATER CONTENT (Sommeria and - !Deardorff (1977, eq 29a). rrp = 1/(sqrt(2*pi)) = 0.3989 - eq1 = rrp*EXP( -0.5*q1k*q1k ) - qll = MAX( cld(k)*q1k + eq1, 0.0 ) - !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) - ql (k) = alp(k)*sgm(k)*qll - - q2p = xlvcp/exner(k) - pt = thl(k) +q2p*ql(k) ! potential temp - - !qt is a THETA-V CONVERSION FOR TOTAL WATER (i.e., THETA-V = qt*THETA) - qt = 1.0 +p608*qw(k) -(1.+p608)*ql(k) - rac = alp(k)*( cld(k)-qll*eq1 )*( q2p*qt-(1.+p608)*pt ) - - !BUOYANCY FACTORS: wherever vt and vq are used, there is a - !"+1" and "+tv0", respectively, so these are subtracted out here. - !vt is unitless and vq has units of K. - vt(k) = qt-1.0 -rac*bet(k) - vq(k) = p608*pt-tv0 +rac + cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.36*ATAN(1.55*q1(k)))) ! Eq. 7 in CB02 END DO - CASE ( 2, -2) + ! JAYMES- this option added 8 May 2015 ! The cloud water formulations are taken from CB02, Eq. 8. ! "fng" represents the non-Gaussian contribution to the liquid ! water flux; these formulations are from Cuijpers and Bechtold ! (1995), Eq. 7. CB95 also draws from Bechtold et al. 1995, ! hereafter BCMT95 + zagl = 0. DO k = kts,kte-1 t = th(k)*exner(k) q1k = q1(k) zagl = zagl + dz(k) - IF (q1k < 0.) THEN - ql (k) = sgm(k)*EXP(1.2*q1k-1) - ELSE IF (q1k > 2.) THEN - ql (k) = sgm(k)*q1k - ELSE - ql (k) = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) + + !CLOUD WATER AND ICE + IF (q1k < 0.) THEN !unstaurated + ql_water = sgm(k)*EXP(1.2*q1k-1) +! ql_ice = sgm(k)*EXP(0.9*q1k-2.6) + !Reduce ice mixing ratios in the upper troposphere + low_weight = MIN(MAX(p(k)-40000.0, 0.0),40000.0)/40000.0 + ql_ice = low_weight * sgm(k)*EXP(1.1*q1k-1.6) & !low-lev + + (1.-low_weight) * sgm(k)*EXP(1.1*q1k-2.8)!upper-lev + ELSE IF (q1k > 2.) THEN !supersaturated + ql_water = sgm(k)*q1k + ql_ice = MIN(80.*qv(k),0.1)*sgm(k)*q1k + ELSE !slightly saturated (0 > q1 < 2) + ql_water = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) + ql_ice = MIN(80.*qv(k),0.1)*sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) ENDIF - + + !In saturated grid cells, use average of current estimate and prev time step + IF ( qc(k) > 1.e-7 ) ql_water = 0.5 * ( ql_water + qc(k) ) + IF ( qi(k) > 1.e-9 ) ql_ice = 0.5 * ( ql_ice + qi(k) ) + + IF (cldfra_bl1D(K) < 0.005) THEN + ql_ice = 0.0 + ql_water = 0.0 + ENDIF + + !PHASE PARTITIONING: Make some inferences about the relative amounts of subgrid cloud water vs. ice + !based on collocated explicit clouds. Otherise, use a simple temperature-dependent partitioning. + IF ( qc(k) + qi(k) > 0.0 ) THEN ! explicit condensate exists, so attempt to retain its phase partitioning + IF ( qi(k) == 0.0 ) THEN ! explicit contains no ice; assume subgrid liquid + liq_frac = 1.0 + ELSE IF ( qc(k) == 0.0 ) THEN ! explicit contains no liquid; assume subgrid ice + liq_frac = 0.0 + ELSE IF ( (qc(k) >= 1.E-10) .AND. (qi(k) >= 1.E-10) ) THEN ! explicit contains mixed phase of workably + ! large amounts; assume subgrid follows + ! same partioning + liq_frac = qc(k) / ( qc(k) + qi(k) ) + ELSE + liq_frac = MIN(1.0, MAX(0.0, (t-238.)/31.)) ! explicit contains mixed phase, but at least one + ! species is very small, so make a temperature- + ! depedent guess + ENDIF + ELSE ! no explicit condensate, so make a temperature-dependent guess + liq_frac = MIN(1.0, MAX(0.0, (t-238.)/31.)) + ENDIF + + qc_bl1D(k) = liq_frac*ql_water ! apply liq_frac to ql_water and ql_ice + qi_bl1D(k) = (1.0-liq_frac)*ql_ice + !Above tropopause: eliminate subgrid clouds from CB scheme if (k .ge. k_tropo-1) then - cld(k) = 0. - ql(k) = 0. + cldfra_bl1D(K) = 0. + qc_bl1D(k) = 0. + qi_bl1D(k) = 0. endif !Buoyancy-flux-related calculations follow... ! "Fng" represents the non-Gaussian transport factor - ! (non-dimensional) from from Bechtold et al. 1995 + ! (non-dimensional) from Bechtold et al. 1995 ! (hereafter BCMT95), section 3(c). Their suggested ! forms for Fng (from their Eq. 20) are: !IF (q1k < -2.) THEN @@ -2751,33 +2789,21 @@ SUBROUTINE mym_condensation (kts,kte, & qww = 1.+0.61*qw(k) alpha = 0.61*th(k) beta = (th(k)/t)*(xl/cp) - 1.61*th(k) - - vt(k) = qww - MIN(cld(k),0.99)*beta*bb*Fng - 1. - vq(k) = alpha + MIN(cld(k),0.99)*beta*a(k)*Fng - tv0 + vt(k) = qww - MIN(cldfra_bl1D(K),0.5)*beta*bb*Fng - 1. + vq(k) = alpha + MIN(cldfra_bl1D(K),0.5)*beta*a(k)*Fng - tv0 ! vt and vq correspond to beta-theta and beta-q, respectively, ! in NN09, Eq. B8. They also correspond to the bracketed ! expressions in BCMT95, Eq. 15, since (s*ql/sigma^2) = cldfra*Fng ! The "-1" and "-tv0" terms are included for consistency with ! the legacy vt and vq formulations (above). - !OLD-- - ! increase the cloud fraction estimate below PBLH+1km - !if (zagl .lt. PBLH2+1000.) then - ! cld_factor = 1.0 + MAX(0.0, ( RH(k) - 0.83 ) / 0.18 ) - ! cld(k) = MIN( 1., cld_factor*cld(k) ) - !end if - !NEW-- ! dampen the amplification factor (cld_factor) with height in order ! to limit excessively large cloud fractions aloft fac_damp = 1. -MIN(MAX( zagl-(PBLH2+1000.),0.0)/ & MAX((zw(k_tropo)-(PBLH2+1000.)),500.), 1.) !cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.5 ) / 0.51 )**3.3 - cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.75 ) / 0.26 )**1.9 - cld(k) = MIN( 1., cld_factor*cld(k) ) - - ! return a cloud condensate and cloud fraction for icloud_bl option: - cldfra_bl1D(k) = cld(k) - qc_bl1D(k) = ql(k) + cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.75 ) / 0.26 )**1.9 + cldfra_bl1D(K) = MIN( 1., cld_factor*cldfra_bl1D(K) ) END DO @@ -2786,16 +2812,17 @@ SUBROUTINE mym_condensation (kts,kte, & !FOR TESTING PURPOSES ONLY, ISOLATE ON THE MASS-CLOUDS. IF (bl_mynn_cloudpdf .LT. 0) THEN DO k = kts,kte-1 - cldfra_bl1D(k) = 0.0 - qc_bl1D(k) = 0.0 + cldfra_bl1D(k) = 0.0 + qc_bl1D(k) = 0.0 + qi_bl1D(k) = 0.0 END DO ENDIF ! - cld(kte) = cld(kte-1) ql(kte) = ql(kte-1) vt(kte) = vt(kte-1) vq(kte) = vq(kte-1) qc_bl1D(kte)=0. + qi_bl1D(kte)=0. cldfra_bl1D(kte)=0. RETURN @@ -2817,23 +2844,26 @@ SUBROUTINE mynn_tendencies(kts,kte, & &u,v,th,tk,qv,qc,qi,qnc,qni, & &p,exner, & &thl,sqv,sqc,sqi,sqw, & - &qnwfa,qnifa, & + &qnwfa,qnifa,ozone, & &ust,flt,flq,flqv,flqc,wspd,qcg, & &uoce,voce, & &tsq,qsq,cov, & &tcd,qcd, & &dfm,dfh,dfq, & &Du,Dv,Dth,Dqv,Dqc,Dqi,Dqnc,Dqni, & - &Dqnwfa,Dqnifa, & + &Dqnwfa,Dqnifa,Dozone, & &vdfg1,diss_heat, & &s_aw,s_awthl,s_awqt,s_awqv,s_awqc, & &s_awu,s_awv, & &s_awqnc,s_awqni, & &s_awqnwfa,s_awqnifa, & + &sub_thl,sub_sqv, & + &sub_u,sub_v, & + &det_thl,det_sqv,det_sqc, & + &det_u,det_v, & &FLAG_QC,FLAG_QI,FLAG_QNC,FLAG_QNI, & &FLAG_QNWFA,FLAG_QNIFA, & &cldfra_bl1d, & - &ztop_shallow,ktop_shallow, & &bl_mynn_cloudmix, & &bl_mynn_mixqt, & &bl_mynn_edmf, & @@ -2863,17 +2893,19 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! flt - surface flux of thl ! flq - surface flux of qw +! mass-flux plumes REAL, DIMENSION(kts:kte+1), INTENT(in) :: s_aw,s_awthl,s_awqt,& &s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv,s_awqnwfa,s_awqnifa +! tendencies from mass-flux environmental subsidence and detrainment + REAL, DIMENSION(kts:kte), INTENT(in) :: sub_thl,sub_sqv, & + &sub_u,sub_v,det_thl,det_sqv,det_sqc,det_u,det_v REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,th,tk,qv,qc,qi,qni,qnc,& &rho,p,exner,dfq,dz,tsq,qsq,cov,tcd,qcd,cldfra_bl1d,diss_heat REAL, DIMENSION(kts:kte), INTENT(inout) :: thl,sqw,sqv,sqc,sqi,& - &qnwfa,qnifa,dfm,dfh + &qnwfa,qnifa,ozone,dfm,dfh REAL, DIMENSION(kts:kte), INTENT(inout) :: du,dv,dth,dqv,dqc,dqi,& - &dqni,dqnc,dqnwfa,dqnifa - REAL, INTENT(IN) :: delt,ust,flt,flq,flqv,flqc,wspd,uoce,voce,qcg,& - ztop_shallow - INTEGER, INTENT(IN) :: ktop_shallow + &dqni,dqnc,dqnwfa,dqnifa,dozone + REAL, INTENT(IN) :: delt,ust,flt,flq,flqv,flqc,wspd,uoce,voce,qcg ! REAL, INTENT(IN) :: delt,ust,flt,flq,qcg,& ! &gradu_top,gradv_top,gradth_top,gradqv_top @@ -2882,7 +2914,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & REAL, DIMENSION(kts:kte) :: dtz,vt,vq,dfhc,dfmc !Kh for clouds (Pr < 2) REAL, DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqw2,qni2,qnc2, & !AFTER MIXING - qnwfa2,qnifa2 + qnwfa2,qnifa2,ozone2 REAL, DIMENSION(kts:kte) :: zfac,plumeKh REAL, DIMENSION(kts:kte) :: a,b,c,d,x REAL, DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface @@ -2940,7 +2972,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & a(1)=0. b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff c(1)=-dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff - d(1)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + d(1)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + & + sub_u(k)*delt + det_u(k)*delt !JOE - tend test ! a(k)=0. @@ -2953,7 +2986,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & a(k)= - dtz(k)*dfm(k) + 0.5*dtz(k)*s_aw(k)*onoff b(k)=1. + dtz(k)*(dfm(k)+dfm(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff c(k)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff - d(k)=u(k) + dtz(k)*(s_awu(k)-s_awu(k+1))*onoff + d(k)=u(k) + dtz(k)*(s_awu(k)-s_awu(k+1))*onoff + & + sub_u(k)*delt + det_u(k)*delt ENDDO !! no flux at the top @@ -2992,7 +3026,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff c(1)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff !! d(1)=v(k) - d(1)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + d(1)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + & + sub_v(k)*delt + det_v(k)*delt !JOE - tend test ! a(k)=0. @@ -3005,7 +3040,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & a(k)= - dtz(k)*dfm(k) + 0.5*dtz(k)*s_aw(k)*onoff b(k)=1. + dtz(k)*(dfm(k)+dfm(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff c(k)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff - d(k)=v(k) + dtz(k)*(s_awv(k)-s_awv(k+1))*onoff + d(k)=v(k) + dtz(k)*(s_awv(k)-s_awv(k+1))*onoff + & + sub_v(k)*delt + det_v(k)*delt ENDDO !! no flux at the top @@ -3040,18 +3076,37 @@ SUBROUTINE mynn_tendencies(kts,kte, & !!============================================ k=kts - a(k)=0. - b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt & - & -dtz(k)*s_awthl(kts+1) + diss_heat(k)*delt*dheat_opt +! a(k)=0. +! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt & +! & -dtz(k)*s_awthl(kts+1) + diss_heat(k)*delt*dheat_opt + & +! & sub_thl(k)*delt + det_thl(k)*delt +! +! DO k=kts+1,kte-1 +! a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) +! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! d(k)=thl(k) + tcd(k)*delt + dtz(k)*(s_awthl(k)-s_awthl(k+1)) & +! & + diss_heat(k)*delt*dheat_opt + & +! & sub_thl(k)*delt + det_thl(k)*delt +! ENDDO + +!rho-weighted: + a(k)= -dtz(k)*khdz(k)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt - dtz(k)*s_awthl(k+1) + & + & diss_heat(k)*delt*dheat_opt + sub_thl(k)*delt + det_thl(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) - b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - d(k)=thl(k) + tcd(k)*delt + dtz(k)*(s_awthl(k)-s_awthl(k+1)) & - & + diss_heat(k)*delt*dheat_opt + a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + d(k)=thl(k) + tcd(k)*delt + dtz(k)*(s_awthl(k)-s_awthl(k+1)) + & + & + diss_heat(k)*delt*dheat_opt + & + & sub_thl(k)*delt + det_thl(k)*delt ENDDO !! no flux at the top @@ -3074,7 +3129,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=thl(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) +! CALL tridiag2(kte,a,b,c,d,x) + CALL tridiag3(kte,a,b,c,d,x) DO k=kts,kte !thl(k)=d(k-kts+1) @@ -3091,19 +3147,30 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)=0. - b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - - !rhs= qcd(k) !+ (gfluxp - gfluxm)/dz(k)& +! a(k)=0. +! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! !rhs= qcd(k) !+ (gfluxp - gfluxm)/dz(k)& +! d(k)=sqw(k) + dtz(k)*flq + qcd(k)*delt - dtz(k)*s_awqt(k+1) +! +! DO k=kts+1,kte-1 +! a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) +! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! d(k)=sqw(k) + qcd(k)*delt + dtz(k)*(s_awqt(k)-s_awqt(k+1)) +! ENDDO - d(k)=sqw(k) + dtz(k)*flq + qcd(k)*delt - dtz(k)*s_awqt(k+1) +!rho-weighted: + a(k)= -dtz(k)*khdz(k)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + d(k)=sqw(k) + dtz(k)*flq + qcd(k)*delt - dtz(k)*s_awqt(k+1) DO k=kts+1,kte-1 - a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) - b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - + a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=sqw(k) + qcd(k)*delt + dtz(k)*(s_awqt(k)-s_awqt(k+1)) ENDDO @@ -3125,7 +3192,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=sqw(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,sqw2) +! CALL tridiag2(kte,a,b,c,d,sqw2) + CALL tridiag3(kte,a,b,c,d,sqw2) ! DO k=kts,kte ! sqw2(k)=d(k-kts+1) @@ -3143,18 +3211,34 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)=0. - b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! a(k)=0. +! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! d(k)=sqc(k) + dtz(k)*flqc + qcd(k)*delt - & +! dtz(k)*s_awqc(k+1) + det_sqc(k)*delt +! +! DO k=kts+1,kte-1 +! a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) +! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! d(k)=sqc(k) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + & +! det_sqc(k)*delt +! ENDDO - d(k)=sqc(k) + dtz(k)*flqc + qcd(k)*delt -dtz(k)*s_awqc(k+1) +!rho-weighted: + a(k)= -dtz(k)*khdz(k)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + d(k)=sqc(k) + dtz(k)*flqc + qcd(k)*delt - dtz(k)*s_awqc(k+1) + & + & det_sqc(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) - b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - - d(k)=sqc(k) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + d(k)=sqc(k) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + & + & det_sqc(k)*delt ENDDO ! prescribed value @@ -3164,7 +3248,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=sqc(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,sqc2) +! CALL tridiag2(kte,a,b,c,d,sqc2) + CALL tridiag3(kte,a,b,c,d,sqc2) ! DO k=kts,kte ! sqc2(k)=d(k-kts+1) @@ -3183,16 +3268,34 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)=0. - b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - d(k)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*s_awqv(k+1) +! a(k)=0. +! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! d(k)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*s_awqv(k+1) + & +! & sub_sqv(k)*delt + det_sqv(k)*delt +! +! DO k=kts+1,kte-1 +! a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) +! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! d(k)=sqv(k) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + & +! & sub_sqv(k)*delt + det_sqv(k)*delt +! ENDDO + +!rho-weighted: + a(k)= -dtz(k)*khdz(k)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + d(k)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*s_awqv(k+1) + & + & sub_sqv(k)*delt + det_sqv(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) - b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - d(k)=sqv(k) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + d(k)=sqv(k) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + & + & sub_sqv(k)*delt + det_sqv(k)*delt ENDDO ! no flux at the top @@ -3215,7 +3318,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=sqv(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,sqv2) +! CALL tridiag2(kte,a,b,c,d,sqv2) + CALL tridiag3(kte,a,b,c,d,sqv2) ! DO k=kts,kte ! sqv2(k)=d(k-kts+1) @@ -3231,16 +3335,29 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)=0. - b(k)=1.+dtz(k)*dfh(k+1) - c(k)= -dtz(k)*dfh(k+1) - d(k)=sqi(k) !+ qcd(k)*delt !should we have qcd for ice? +! a(k)=0. +! b(k)=1.+dtz(k)*dfh(k+1) +! c(k)= -dtz(k)*dfh(k+1) +! d(k)=sqi(k) !+ qcd(k)*delt !should we have qcd for ice? +! +! DO k=kts+1,kte-1 +! a(k)= -dtz(k)*dfh(k) +! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) +! c(k)= -dtz(k)*dfh(k+1) +! d(k)=sqi(k) !+ qcd(k)*delt +! ENDDO + +!rho-weighted: + a(k)= -dtz(k)*khdz(k)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) + c(k)= -dtz(k)*khdz(k+1)/rho(k) + d(k)=sqi(k) DO k=kts+1,kte-1 - a(k)= -dtz(k)*dfh(k) - b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) - c(k)= -dtz(k)*dfh(k+1) - d(k)=sqi(k) !+ qcd(k)*delt + a(k)= -dtz(k)*khdz(k)/rho(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + c(k)= -dtz(k)*khdz(k+1)/rho(k) + d(k)=sqi(k) ENDDO !! no flux at the top @@ -3263,7 +3380,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=sqi(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,sqi2) +! CALL tridiag2(kte,a,b,c,d,sqi2) + CALL tridiag3(kte,a,b,c,d,sqi2) ! DO k=kts,kte ! sqi2(k)=d(k-kts+1) @@ -3437,6 +3555,39 @@ SUBROUTINE mynn_tendencies(kts,kte, & qnifa2=qnifa ENDIF +!============================================ +! Ozone - local mixing only +!============================================ + + k=kts + +!rho-weighted: + a(k)= -dtz(k)*khdz(k)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) + c(k)= -dtz(k)*khdz(k+1)/rho(k) + d(k)=ozone(k) + + DO k=kts+1,kte-1 + a(k)= -dtz(k)*khdz(k)/rho(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + c(k)= -dtz(k)*khdz(k+1)/rho(k) + d(k)=ozone(k) + ENDDO + +! prescribed value + a(kte)=0. + b(kte)=1. + c(kte)=0. + d(kte)=ozone(kte) + +! CALL tridiag(kte,a,b,c,d) +! CALL tridiag2(kte,a,b,c,d,x) + CALL tridiag3(kte,a,b,c,d,x) + + DO k=kts,kte + !ozone2(k)=d(k-kts+1) + dozone(k)=(x(k)-ozone(k))/delt + ENDDO !!============================================ !! Compute tendencies and convert to mixing ratios for WRF. @@ -3476,7 +3627,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! WATER VAPOR TENDENCY !===================== DO k=kts,kte - Dqv(k)=(sqv2(k)/(1.-sqv2(k)) - qv(k))/delt + !Dqv(k)=(sqv2(k)/(1.-sqv2(k)) - qv(k))/delt !mixing ratio + Dqv(k)=(sqv2(k) - sqv(k))/delt !spec humidity !IF(-Dqv(k) > qv(k)) Dqv(k)=-qv(k) ENDDO @@ -3489,10 +3641,11 @@ SUBROUTINE mynn_tendencies(kts,kte, & !print*,"FLAG_QC:",FLAG_QC IF (FLAG_QC) THEN DO k=kts,kte - Dqc(k)=(sqc2(k)/(1.-sqv2(k)) - qc(k))/delt - IF(Dqc(k)*delt + qc(k) < 0.) THEN + !Dqc(k)=(sqc2(k)/(1.-sqv2(k)) - qc(k))/delt !mixing ratio + Dqc(k)=(sqc2(k) - sqc(k))/delt !spec humidity + IF(Dqc(k)*delt + sqc(k) < 0.) THEN !print*,' neg qc:',qsl,sqw2(k),sqi2(k),sqc2(k),qc(k),tk(k) - Dqc(k)=-qc(k)/delt + Dqc(k)=-sqc(k)/delt ENDIF ENDDO ELSE @@ -3521,10 +3674,11 @@ SUBROUTINE mynn_tendencies(kts,kte, & !=================== IF (FLAG_QI) THEN DO k=kts,kte - Dqi(k)=(sqi2(k)/(1.-sqv2(k)) - qi(k))/delt - IF(Dqi(k)*delt + qi(k) < 0.) THEN + !Dqi(k)=(sqi2(k)/(1.-sqv2(k)) - qi(k))/delt !mixing ratio + Dqi(k)=(sqi2(k) - sqi(k))/delt !spec humidity + IF(Dqi(k)*delt + sqi(k) < 0.) THEN ! !print*,' neg qi;',qsl,sqw2(k),sqi2(k),sqc2(k),qi(k),tk(k) - Dqi(k)=-qi(k)/delt + Dqi(k)=-sqi(k)/delt ENDIF ENDDO ELSE @@ -3566,16 +3720,16 @@ SUBROUTINE mynn_tendencies(kts,kte, & & - th(k))/delt !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy: - !Dth(k)=(thl(k)*(1.+ xlvcp/MAX(tk(k),TKmin)*sqc2(k) & - ! & + xlscp/MAX(tk(k),TKmin)*sqi2(k)) & + !Dth(k)=(thl(k)*(1.+ xlvcp/MAX(tk(k),TKmin)*sqc(k) & + ! & + xlscp/MAX(tk(k),TKmin)*sqi(k)) & ! & - th(k))/delt ENDDO ELSE DO k=kts,kte - Dth(k)=(thl(k)+xlvcp/exner(k)*sqc2(k) - th(k))/delt + Dth(k)=(thl(k)+xlvcp/exner(k)*sqc(k) - th(k))/delt !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. - !Dth(k)=(thl(k)*(1.+ xlvcp/MAX(tk(k),TKmin)*sqc2(k)) & + !Dth(k)=(thl(k)*(1.+ xlvcp/MAX(tk(k),TKmin)*sqc(k)) & !& - th(k))/delt ENDDO ENDIF @@ -3845,16 +3999,18 @@ end subroutine tridiag3 !!\section gen_mynn_bl_driver GSD mynn_bl_driver General Algorithm !> @{ SUBROUTINE mynn_bl_driver( & - &initflag,restart,grav_settling, & + &initflag,restart,cycling, & + &grav_settling, & &delt,dz,dx,znt, & - &u,v,w,th,qv,qc,qi,qnc,qni, & - &qnwfa,qnifa, & + &u,v,w,th,sqv3D,sqc3D,sqi3D, & + &qnc,qni, & + &qnwfa,qnifa,ozone, & &p,exner,rho,T3D, & &xland,ts,qsfc,qcg,ps, & &ust,ch,hfx,qfx,rmol,wspd, & &uoce,voce, & !ocean current &vdfg, & !Katata-added for fog dep - &Qke,tke_pbl, & + &Qke, & !TKE_PBL, & &qke_adv,bl_mynn_tkeadvect, & !ACF for QKE advection #if (WRF_CHEM == 1) chem3d, vd3d, nchem, & ! WA 7/29/15 For WRF-Chem @@ -3864,7 +4020,7 @@ SUBROUTINE mynn_bl_driver( & &RUBLTEN,RVBLTEN,RTHBLTEN, & &RQVBLTEN,RQCBLTEN,RQIBLTEN, & &RQNCBLTEN,RQNIBLTEN, & - &RQNWFABLTEN,RQNIFABLTEN, & + &RQNWFABLTEN,RQNIFABLTEN,DOZONE, & &exch_h,exch_m, & &Pblh,kpbl, & &el_pbl, & @@ -3873,14 +4029,17 @@ SUBROUTINE mynn_bl_driver( & &bl_mynn_tkebudget, & &bl_mynn_cloudpdf,Sh3D, & &bl_mynn_mixlength, & - &icloud_bl,qc_bl,cldfra_bl, & + &icloud_bl,qc_bl,qi_bl,cldfra_bl,& &levflag,bl_mynn_edmf, & &bl_mynn_edmf_mom,bl_mynn_edmf_tke, & &bl_mynn_mixscalars, & + &bl_mynn_output, & &bl_mynn_cloudmix,bl_mynn_mixqt, & &edmf_a,edmf_w,edmf_qt, & &edmf_thl,edmf_ent,edmf_qc, & - &nupdraft,maxMF,ktop_shallow, & + &sub_thl3D,sub_sqv3D, & + &det_thl3D,det_sqv3D, & + &nupdraft,maxMF,ktop_plume, & &spp_pbl,pattern_spp_pbl, & &RTHRATEN, & &FLAG_QC,FLAG_QI,FLAG_QNC, & @@ -3892,26 +4051,27 @@ SUBROUTINE mynn_bl_driver( & !------------------------------------------------------------------- INTEGER, INTENT(in) :: initflag - LOGICAL, INTENT(IN) :: restart !INPUT NAMELIST OPTIONS: + LOGICAL, INTENT(in) :: restart,cycling INTEGER, INTENT(in) :: levflag INTEGER, INTENT(in) :: grav_settling INTEGER, INTENT(in) :: bl_mynn_tkebudget INTEGER, INTENT(in) :: bl_mynn_cloudpdf INTEGER, INTENT(in) :: bl_mynn_mixlength INTEGER, INTENT(in) :: bl_mynn_edmf - LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect + LOGICAL, INTENT(in) :: bl_mynn_tkeadvect INTEGER, INTENT(in) :: bl_mynn_edmf_mom INTEGER, INTENT(in) :: bl_mynn_edmf_tke INTEGER, INTENT(in) :: bl_mynn_mixscalars + INTEGER, INTENT(in) :: bl_mynn_output INTEGER, INTENT(in) :: bl_mynn_cloudmix INTEGER, INTENT(in) :: bl_mynn_mixqt INTEGER, INTENT(in) :: icloud_bl - LOGICAL, INTENT(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& + LOGICAL, INTENT(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& FLAG_QNWFA,FLAG_QNIFA - INTEGER,INTENT(IN) :: & + INTEGER,INTENT(in) :: & & IDS,IDE,JDS,JDE,KDS,KDE & &,IMS,IME,JMS,JME,KMS,KME & &,ITS,ITE,JTS,JTE,KTS,KTE @@ -3936,21 +4096,23 @@ SUBROUTINE mynn_bl_driver( & REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(in) :: dx !END FV3 REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(in) :: dz,& - &u,v,w,th,qv,p,exner,rho,T3D + &u,v,w,th,sqv3D,p,exner,rho,T3D REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), OPTIONAL, INTENT(in)::& - &qc,qi,qni,qnc,qnwfa,qnifa + &sqc3D,sqi3D,qni,qnc,qnwfa,qnifa + REAL, DIMENSION(IMS:IME,KMS:KME), OPTIONAL, INTENT(in):: ozone REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(in) :: xland,ust,& - &ch,rmol,ts,qsfc,qcg,ps,hfx,qfx, wspd,uoce,voce, vdfg,znt + &ch,rmol,ts,qsfc,qcg,ps,hfx,qfx,wspd,uoce,voce,vdfg,znt REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(inout) :: & &Qke,Tsq,Qsq,Cov, & - &tke_pbl, & !JOE-added for coupling (TKE_PBL = QKE/2) + !&tke_pbl, & !JOE-added for coupling (TKE_PBL = QKE/2) &qke_adv !ACF for QKE advection REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(inout) :: & &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN,& &RQIBLTEN,RQNIBLTEN,RQNCBLTEN, & &RQNWFABLTEN,RQNIFABLTEN + REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: DOZONE REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(in) :: & &RTHRATEN @@ -3958,8 +4120,10 @@ SUBROUTINE mynn_bl_driver( & REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(out) :: & &exch_h,exch_m - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), OPTIONAL, INTENT(inout) :: & - & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc + !These 10 arrays are only allocated when bl_mynn_output > 0 + REAL, DIMENSION(:,:), OPTIONAL, INTENT(inout) :: & + & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & + & sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(inout) :: & &Pblh,wstar,delta !JOE-added for GRIMS @@ -3968,7 +4132,7 @@ SUBROUTINE mynn_bl_driver( & &Psig_bl,Psig_shcu INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: & - &KPBL,nupdraft,ktop_shallow + &KPBL,nupdraft,ktop_plume REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: & &maxmf @@ -3985,9 +4149,9 @@ SUBROUTINE mynn_bl_driver( & REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: Sh3D REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(inout) :: & - &qc_bl,cldfra_bl - REAL, DIMENSION(KTS:KTE) :: qc_bl1D,cldfra_bl1D,& - qc_bl1D_old,cldfra_bl1D_old + &qc_bl,qi_bl,cldfra_bl + REAL, DIMENSION(KTS:KTE) :: qc_bl1D,qi_bl1D,cldfra_bl1D,& + qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old ! WA 7/29/15 Mix chemical arrays #if (WRF_CHEM == 1) @@ -4003,25 +4167,28 @@ SUBROUTINE mynn_bl_driver( & !local vars INTEGER :: ITF,JTF,KTF, IMD,JMD INTEGER :: i,j,k - REAL, DIMENSION(KTS:KTE) :: thl,thvl,tl,sqv,sqc,sqi,sqw,& + REAL, DIMENSION(KTS:KTE) :: thl,thvl,tl,qv1,qc1,qi1,sqw,& &El, Dfm, Dfh, Dfq, Tcd, Qcd, Pdk, Pdt, Pdq, Pdc, & &Vt, Vq, sgm, thlsg REAL, DIMENSION(KTS:KTE) :: thetav,sh,u1,v1,w1,p1,ex1,dz1,th1,tk1,rho1,& - & qke1,tsq1,qsq1,cov1,qv1,qi1,qc1,du1,dv1,dth1,dqv1,dqc1,dqi1, & - & k_m1,k_h1,qni1,dqni1,qnc1,dqnc1,qnwfa1,qnifa1,dqnwfa1,dqnifa1 + & qke1,tsq1,qsq1,cov1,sqv,sqi,sqc,du1,dv1,dth1,dqv1,dqc1,dqi1,ozone1, & + & k_m1,k_h1,qni1,dqni1,qnc1,dqnc1,qnwfa1,qnifa1,dqnwfa1,dqnifa1,dozone1 !JOE: mass-flux variables REAL, DIMENSION(KTS:KTE) :: dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf REAL, DIMENSION(KTS:KTE) :: edmf_a1,edmf_w1,edmf_qt1,edmf_thl1,& edmf_ent1,edmf_qc1 + REAL, DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & + det_thl,det_sqv,det_sqc,det_u,det_v REAL,DIMENSION(KTS:KTE+1) :: s_aw1,s_awthl1,s_awqt1,& s_awqv1,s_awqc1,s_awu1,s_awv1,s_awqke1,& s_awqnc1,s_awqni1,s_awqnwfa1,s_awqnifa1 REAL, DIMENSION(KTS:KTE+1) :: zw - REAL :: cpm,sqcg,flt,flq,flqv,flqc,pmz,phh,exnerg,zet,& - &afk,abk,ts_decay,th_sfc,ztop_shallow,sqc9,sqi9 + REAL :: cpm,sqcg,flt,flq,flqv,flqc,pmz,phh,exnerg,zet,& + & afk,abk,ts_decay, qc_bl2, qi_bl2, & + & th_sfc,ztop_plume,sqc9,sqi9 !JOE-add GRIMS parameters & variables real,parameter :: d1 = 0.02, d2 = 0.05, d3 = 0.001 @@ -4040,7 +4207,9 @@ SUBROUTINE mynn_bl_driver( & logical :: cloudflg !JOE-end top down -! INTEGER, SAVE :: levflag +!for WRF INTEGER, SAVE :: levflag + + LOGICAL :: INITIALIZE_QKE ! Stochastic fields INTEGER, INTENT(IN) ::spp_pbl @@ -4073,13 +4242,19 @@ SUBROUTINE mynn_bl_driver( & ! setup random seed !call init_random_seed - edmf_a(its:ite,kts:kte,jts:jte)=0. - edmf_w(its:ite,kts:kte,jts:jte)=0. - edmf_qt(its:ite,kts:kte,jts:jte)=0. - edmf_thl(its:ite,kts:kte,jts:jte)=0. - edmf_ent(its:ite,kts:kte,jts:jte)=0. - edmf_qc(its:ite,kts:kte,jts:jte)=0. - ktop_shallow(its:ite,jts:jte)=0 !int + IF (bl_mynn_output > 0) THEN !research mode + edmf_a(its:ite,kts:kte)=0. + edmf_w(its:ite,kts:kte)=0. + edmf_qt(its:ite,kts:kte)=0. + edmf_thl(its:ite,kts:kte)=0. + edmf_ent(its:ite,kts:kte)=0. + edmf_qc(its:ite,kts:kte)=0. + sub_thl3D(its:ite,kts:kte)=0. + sub_sqv3D(its:ite,kts:kte)=0. + det_thl3D(its:ite,kts:kte)=0. + det_sqv3D(its:ite,kts:kte)=0. + ENDIF + ktop_plume(its:ite,jts:jte)=0 !int nupdraft(its:ite,jts:jte)=0 !int maxmf(its:ite,jts:jte)=0. ENDIF @@ -4091,8 +4266,22 @@ SUBROUTINE mynn_bl_driver( & !! several arrays are initialized and k-oriented (vertical) subroutines are called !! at every i and j point, corresponding to the x- and y- directions, respectively. IF (initflag > 0) THEN + + !Test to see if we want to initialize qke + IF ( (restart .or. cycling)) THEN + IF (MAXVAL(QKE(its:ite,kts,jts:jte)) < 0.0002) THEN + INITIALIZE_QKE = .TRUE. + !print*,"QKE is too small, must initialize" + ELSE + INITIALIZE_QKE = .FALSE. + !print*,"Using background QKE, will not initialize" + ENDIF + ELSE ! not cycling or restarting: + INITIALIZE_QKE = .TRUE. + !print*,"not restart nor cycling, must initialize QKE" + ENDIF - if (.not.restart) THEN + if (.not.restart .or. .not.cycling) THEN Sh3D(its:ite,kts:kte,jts:jte)=0. el_pbl(its:ite,kts:kte,jts:jte)=0. tsq(its:ite,kts:kte,jts:jte)=0. @@ -4108,7 +4297,9 @@ SUBROUTINE mynn_bl_driver( & dqnc1(kts:kte)=0.0 dqnwfa1(kts:kte)=0.0 dqnifa1(kts:kte)=0.0 + dozone1(kts:kte)=0.0 qc_bl1D(kts:kte)=0.0 + qi_bl1D(kts:kte)=0.0 cldfra_bl1D(kts:kte)=0.0 qc_bl1D_old(kts:kte)=0.0 cldfra_bl1D_old(kts:kte)=0.0 @@ -4152,11 +4343,16 @@ SUBROUTINE mynn_bl_driver( & th1(k)=th(i,k,j) tk1(k)=T3D(i,k,j) rho1(k)=rho(i,k,j) - sqc(k)=qc(i,k,j)/(1.+qv(i,k,j)) - sqv(k)=qv(i,k,j)/(1.+qv(i,k,j)) + sqc(k)=sqc3D(i,k,j) !/(1.+qv(i,k,j)) + sqv(k)=sqv3D(i,k,j) !/(1.+qv(i,k,j)) thetav(k)=th(i,k,j)*(1.+0.61*sqv(k)) - IF (PRESENT(qi) .AND. FLAG_QI ) THEN - sqi(k)=qi(i,k,j)/(1.+qv(i,k,j)) + IF (icloud_bl > 0) THEN + CLDFRA_BL1D(k)=CLDFRA_BL(i,k,j) + QC_BL1D(k)=QC_BL(i,k,j) + QI_BL1D(k)=QI_BL(i,k,j) + ENDIF + IF (PRESENT(sqi3D) .AND. FLAG_QI ) THEN + sqi(k)=sqi3D(i,k,j) !/(1.+qv(i,k,j)) sqw(k)=sqv(k)+sqc(k)+sqi(k) thl(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc(k) & & - xlscp/exner(i,k,j)*sqi(k) @@ -4165,9 +4361,9 @@ SUBROUTINE mynn_bl_driver( & !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL(i,k,j)>0.001)THEN - sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) - sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN + sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) + sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) ELSE sqc9=sqc(k) sqi9=sqi(k) @@ -4182,9 +4378,9 @@ SUBROUTINE mynn_bl_driver( & !suggested min temperature to improve accuracy. !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. CLDFRA_BL(i,k,j)>0.001)THEN - sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) - sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN + sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) + sqi9=0.0 ELSE sqc9=sqc(k) sqi9=0.0 @@ -4199,11 +4395,14 @@ SUBROUTINE mynn_bl_driver( & ELSE zw(k)=zw(k-1)+dz(i,k-1,j) ENDIF - if (restart) then - qke1(k) = qke(i,k,j) - else - qke1(k)=0.1-MIN(zw(k)*0.001, 0.0) !for initial PBLH calc only - end if + IF (INITIALIZE_QKE) THEN + !Initialize tke for initial PBLH calc only - using + !simple PBLH form of Koracin and Berkowicz (1988, BLM) + !to linearly taper off tke towards top of PBL. + qke1(k)=5.*ust(i,j) * MAX((ust(i,j)*700. - zw(k))/(MAX(ust(i,j),0.01)*700.), 0.01) + ELSE + qke1(k)=qke(i,k,j) + ENDIF el(k)=el_pbl(i,k,j) sh(k)=Sh3D(i,k,j) tsq1(k)=tsq(i,k,j) @@ -4247,6 +4446,7 @@ SUBROUTINE mynn_bl_driver( & &Psig_bl(i,j), cldfra_bl1D, & &bl_mynn_mixlength, & &edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf,& + &INITIALIZE_QKE, & &spp_pbl,rstoch_col ) IF (.not.restart) THEN @@ -4295,6 +4495,14 @@ SUBROUTINE mynn_bl_driver( & IF ( bl_mynn_tkebudget == 1) THEN dqke(i,k,j)=qke(i,k,j) END IF + IF (icloud_bl > 0) THEN + CLDFRA_BL1D(k)=CLDFRA_BL(i,k,j) + QC_BL1D(k)=QC_BL(i,k,j) + QI_BL1D(k)=QI_BL(i,k,j) + cldfra_bl1D_old(k)=cldfra_bl(i,k,j) + qc_bl1D_old(k)=qc_bl(i,k,j) + qi_bl1D_old(k)=qi_bl(i,k,j) + ENDIF dz1(k)= dz(i,k,j) u1(k) = u(i,k,j) v1(k) = v(i,k,j) @@ -4302,21 +4510,20 @@ SUBROUTINE mynn_bl_driver( & th1(k)= th(i,k,j) tk1(k)=T3D(i,k,j) rho1(k)=rho(i,k,j) - qv1(k)= qv(i,k,j) - qc1(k)= qc(i,k,j) - sqv(k)= qv(i,k,j)/(1.+qv(i,k,j)) - sqc(k)= qc(i,k,j)/(1.+qv(i,k,j)) - IF(icloud_bl > 0)cldfra_bl1D_old(k)=cldfra_bl(i,k,j) - IF(icloud_bl > 0)qc_bl1D_old(k)=qc_bl(i,k,j) + qv1(k)= sqv3D(i,k,j)/(1.-sqv3D(i,k,j)) + qc1(k)= sqc3D(i,k,j)/(1.-sqv3D(i,k,j)) + sqv(k)= sqv3D(i,k,j) !/(1.+qv(i,k,j)) + sqc(k)= sqc3D(i,k,j) !/(1.+qv(i,k,j)) dqc1(k)=0.0 dqi1(k)=0.0 dqni1(k)=0.0 dqnc1(k)=0.0 dqnwfa1(k)=0.0 dqnifa1(k)=0.0 - IF(PRESENT(qi) .AND. FLAG_QI)THEN - qi1(k)= qi(i,k,j) - sqi(k)= qi(i,k,j)/(1.+qv(i,k,j)) + dozone1(k)=0.0 + IF(PRESENT(sqi3D) .AND. FLAG_QI)THEN + qi1(k)= sqi3D(i,k,j)/(1.-sqv3D(i,k,j)) + sqi(k)= sqi3D(i,k,j) !/(1.+qv(i,k,j)) sqw(k)= sqv(k)+sqc(k)+sqi(k) thl(k)= th(i,k,j) - xlvcp/exner(i,k,j)*sqc(k) & & - xlscp/exner(i,k,j)*sqi(k) @@ -4325,9 +4532,9 @@ SUBROUTINE mynn_bl_driver( & !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL(i,k,j)>0.001)THEN - sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) - sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN + sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) + sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) ELSE sqc9=sqc(k) sqi9=sqi(k) @@ -4343,16 +4550,16 @@ SUBROUTINE mynn_bl_driver( & !suggested min temperature to improve accuracy. !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. CLDFRA_BL(i,k,j)>0.001)THEN - sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) - sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN + sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) + sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) ELSE sqc9=sqc(k) sqi9=0.0 ENDIF thlsg(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc9 & - & - xlscp/exner(i,k,j)*sqi9 - ENDIF + & - xlscp/exner(i,k,j)*sqi9 + ENDIF thetav(k)=th(i,k,j)*(1.+0.608*sqv(k)) thvl(k)=thlsg(k)*(1.+0.61*sqv(k)) @@ -4376,6 +4583,11 @@ SUBROUTINE mynn_bl_driver( & ELSE qnifa1(k)=0.0 ENDIF + IF (PRESENT(ozone)) THEN + ozone1(k)=ozone(i,k) + ELSE + ozone1(k)=0.0 + ENDIF p1(k) = p(i,k,j) ex1(k)= exner(i,k,j) el(k) = el_pbl(i,k,j) @@ -4407,6 +4619,15 @@ SUBROUTINE mynn_bl_driver( & s_awqni1(k)=0. s_awqnwfa1(k)=0. s_awqnifa1(k)=0. + sub_thl(k)=0. + sub_sqv(k)=0. + sub_u(k)=0. + sub_v(k)=0. + det_thl(k)=0. + det_sqv(k)=0. + det_sqc(k)=0. + det_u(k)=0. + det_v(k)=0. #if (WRF_CHEM == 1) IF (bl_mynn_mixchem == 1) THEN @@ -4480,7 +4701,7 @@ SUBROUTINE mynn_bl_driver( & ENDIF sqcg= 0.0 !JOE, it was: qcg(i,j)/(1.+qcg(i,j)) - cpm=cp*(1.+0.84*qv(i,kts,j)) + cpm=cp*(1.+0.84*qv1(kts)) exnerg=(ps(i,j)/p1000mb)**rcp !----------------------------------------------------- @@ -4531,10 +4752,10 @@ SUBROUTINE mynn_bl_driver( & !! selected by use of the namelist parameter \p bl_mynn_cloudpdf. CALL mym_condensation ( kts,kte, & - &dx(i,j),dz1,zw,thl,sqw,p1,ex1, & - &tsq1, qsq1, cov1, & + &dx(i,j),dz1,zw,thl,sqw,sqv,sqc,sqi,& + &p1,ex1,tsq1,qsq1,cov1, & &Sh,el,bl_mynn_cloudpdf, & - &qc_bl1D,cldfra_bl1D, & + &qc_bl1D,qi_bl1D,cldfra_bl1D, & &PBLH(i,j),HFX(i,j), & &Vt, Vq, th1, sgm, rmol(i,j), & &spp_pbl, rstoch_col ) @@ -4591,11 +4812,17 @@ SUBROUTINE mynn_bl_driver( & radflux=radflux*cp/g*(p1(kk)-p1(kk+1)) ! converts temp/s to W/m^2 if (radflux < 0.0 ) radsum=abs(radflux)+radsum ENDDO - radsum=MIN(radsum,60.0) + + !More strict limits over land to reduce stable-layer mixouts + if ((xland(i,j)-1.5).GE.0)THEN ! WATER + radsum=MIN(radsum,120.0) + bfx0 = max(radsum/rho1(k)/cp,0.) + else ! LAND + radsum=MIN(0.25*radsum,30.0)!practically turn off over land + bfx0 = max(radsum/rho1(k)/cp - max(sflux,0.0),0.) + endif !entrainment from PBL top thermals - bfx0 = max(radsum/rho1(k)/cp - max(sflux,0.0),0.) - !bfx0 = max(radsum/rho1(k)/cp,0.) wm3 = g/thetav(k)*bfx0*MIN(pblh(i,j),1500.) ! this is wstar3(i) wm2 = wm2 + wm3**h2 bfxpbl = - ent_eff * bfx0 @@ -4631,12 +4858,9 @@ SUBROUTINE mynn_bl_driver( & TKEprodTD(kts:kte)=0.0 ENDIF !end top-down check -!> - Call dmp_mf() to calculate the nonlocal turbulent transport from -!! the dynamic multiplume mass-flux scheme as well as the shallow-cumulus -!! component of the subgrid clouds. - IF (bl_mynn_edmf == 1) THEN + IF (bl_mynn_edmf > 0) THEN !PRINT*,"Calling DMP Mass-Flux: i= ",i," j=",j - CALL DMP_mf( & + CALL DMP_mf( & &kts,kte,delt,zw,dz1,p1, & &bl_mynn_edmf_mom, & &bl_mynn_edmf_tke, & @@ -4659,16 +4883,21 @@ SUBROUTINE mynn_bl_driver( & & s_awu1,s_awv1,s_awqke1, & & s_awqnc1,s_awqni1, & & s_awqnwfa1,s_awqnifa1, & + & sub_thl,sub_sqv, & + & sub_u,sub_v, & + & det_thl,det_sqv,det_sqc, & + & det_u,det_v, & #if (WRF_CHEM == 1) & nchem,chem1,s_awchem1, & #endif & qc_bl1D,cldfra_bl1D, & + & qc_bl1D_old,cldfra_bl1D_old, & & FLAG_QC,FLAG_QI, & & FLAG_QNC,FLAG_QNI, & & FLAG_QNWFA,FLAG_QNIFA, & & Psig_shcu(i,j), & - & nupdraft(i,j),ktop_shallow(i,j), & - & maxmf(i,j),ztop_shallow, & + & nupdraft(i,j),ktop_plume(i,j), & + & maxmf(i,j),ztop_plume, & & spp_pbl,rstoch_col & ) @@ -4707,7 +4936,7 @@ SUBROUTINE mynn_bl_driver( & DO k=kts,kte-1 ! Set max dissipative heating rate close to 0.1 K per hour (=0.000027...) - diss_heat(k) = MIN(MAX(0.5*(qke1(k)**1.5)/(b1*MAX(0.5*(el(k)+el(k+1)),1.))/cp, 0.0),0.00002) + diss_heat(k) = MIN(MAX(twothirds*(qke1(k)**1.5)/(b1*MAX(0.5*(el(k)+el(k+1)),1.))/cp, 0.0),0.00003) ENDDO diss_heat(kte) = 0. @@ -4719,7 +4948,7 @@ SUBROUTINE mynn_bl_driver( & &u1, v1, th1, tk1, qv1, & &qc1, qi1, qnc1, qni1, & &p1, ex1, thl, sqv, sqc, sqi, sqw,& - &qnwfa1, qnifa1, & + &qnwfa1, qnifa1, ozone1, & &ust(i,j),flt,flq,flqv,flqc, & &wspd(i,j),qcg(i,j), & &uoce(i,j),voce(i,j), & @@ -4728,17 +4957,20 @@ SUBROUTINE mynn_bl_driver( & &dfm, dfh, dfq, & &Du1, Dv1, Dth1, Dqv1, & &Dqc1, Dqi1, Dqnc1, Dqni1, & - &Dqnwfa1, Dqnifa1, & + &Dqnwfa1, Dqnifa1, Dozone1, & &vdfg(i,j), diss_heat, & ! mass flux components &s_aw1,s_awthl1,s_awqt1, & &s_awqv1,s_awqc1,s_awu1,s_awv1, & &s_awqnc1,s_awqni1, & &s_awqnwfa1,s_awqnifa1, & + &sub_thl,sub_sqv, & + &sub_u,sub_v, & + &det_thl,det_sqv,det_sqc, & + &det_u,det_v, & &FLAG_QC,FLAG_QI,FLAG_QNC, & &FLAG_QNI,FLAG_QNWFA,FLAG_QNIFA, & &cldfra_bl1d, & - &ztop_shallow,ktop_shallow(i,j), & &bl_mynn_cloudmix, & &bl_mynn_mixqt, & &bl_mynn_edmf, & @@ -4781,11 +5013,11 @@ SUBROUTINE mynn_bl_driver( & RTHBLTEN(i,k,j)=dth1(k) RQVBLTEN(i,k,j)=dqv1(k) IF(bl_mynn_cloudmix > 0)THEN - IF (PRESENT(qc) .AND. FLAG_QC) RQCBLTEN(i,k,j)=dqc1(k) - IF (PRESENT(qi) .AND. FLAG_QI) RQIBLTEN(i,k,j)=dqi1(k) + IF (PRESENT(sqc3D) .AND. FLAG_QC) RQCBLTEN(i,k,j)=dqc1(k) + IF (PRESENT(sqi3D) .AND. FLAG_QI) RQIBLTEN(i,k,j)=dqi1(k) ELSE - IF (PRESENT(qc) .AND. FLAG_QC) RQCBLTEN(i,k,j)=0. - IF (PRESENT(qi) .AND. FLAG_QI) RQIBLTEN(i,k,j)=0. + IF (PRESENT(sqc3D) .AND. FLAG_QC) RQCBLTEN(i,k,j)=0. + IF (PRESENT(sqi3D) .AND. FLAG_QI) RQIBLTEN(i,k,j)=0. ENDIF IF(bl_mynn_cloudmix > 0 .AND. bl_mynn_mixscalars > 0)THEN IF (PRESENT(qnc) .AND. FLAG_QNC) RQNCBLTEN(i,k,j)=dqnc1(k) @@ -4798,37 +5030,34 @@ SUBROUTINE mynn_bl_driver( & IF (PRESENT(qnwfa) .AND. FLAG_QNWFA) RQNWFABLTEN(i,k,j)=0. IF (PRESENT(qnifa) .AND. FLAG_QNIFA) RQNIFABLTEN(i,k,j)=0. ENDIF + DOZONE(i,k)=DOZONE1(k) IF(icloud_bl > 0)THEN - !make BL clouds scale aware - may already be done in mym_condensation - qc_bl(i,k,j)=qc_bl1D(k) !*Psig_shcu(i,j) - cldfra_bl(i,k,j)=cldfra_bl1D(k) !*Psig_shcu(i,j) - !DIAGNOSTIC-DECAY FOR SUBGRID-SCALE CLOUDS -!> - Compute the temporal decay of diagnostic subgrid cloud. This allows the diagnostic -!! sugrid clouds to persist for an eddy turnover time scale. - IF (CLDFRA_BL(i,k,j) < cldfra_bl1D_old(k)) THEN + IF (CLDFRA_BL1D(k) < cldfra_bl1D_old(k)) THEN !DECAY TIMESCALE FOR CALM CONDITION IS THE EDDY TURNOVER - !TIMESCALE, BUT FOR - !WINDY CONDITIONS, IT IS THE ADVECTIVE TIMESCALE. USE THE - !MINIMUM OF THE TWO. + !TIMESCALE, BUT FOR WINDY CONDITIONS, IT IS THE ADVECTIVE + !TIMESCALE. USE THE MINIMUM OF THE TWO. ts_decay = MIN( 1800., 3.*dx(i,j)/MAX(SQRT(u1(k)**2 + v1(k)**2),1.0) ) cldfra_bl(i,k,j)= MAX(cldfra_bl1D(k),cldfra_bl1D_old(k)-(0.25*delt/ts_decay)) - IF (cldfra_bl(i,k,j) < 0.005) THEN - CLDFRA_BL(i,k,j)= 0. - QC_BL(i,k,j) = 0. + ! qc_bl2 and qi_bl2 are decay rates + qc_bl2 = MAX(qc_bl1D(k),qc_bl1D_old(k)) + qc_bl2 = MAX(qc_bl2,1.0E-5) + qi_bl2 = MAX(qi_bl1D(k),qi_bl1D_old(k)) + qi_bl2 = MAX(qi_bl2,1.0E-6) + qc_bl(i,k,j) = MAX(qc_bl1D(k),qc_bl1D_old(k)-(MIN(qc_bl2,1.0E-4) * delt/ts_decay)) + qi_bl(i,k,j) = MAX(qi_bl1D(k),qi_bl1D_old(k)-(MIN(qi_bl2,1.0E-5) * delt/ts_decay)) + IF (cldfra_bl(i,k,j) < 0.005 .OR. & + (qc_bl(i,k,j) + qi_bl(i,k,j)) < 1E-9) THEN + CLDFRA_BL(i,k,j)= 0. + QC_BL(i,k,j) = 0. + QI_BL(i,k,j) = 0. ENDIF + ELSE + qc_bl(i,k,j)=qc_bl1D(k) + qi_bl(i,k,j)=qi_bl1D(k) + cldfra_bl(i,k,j)=cldfra_bl1D(k) ENDIF - - !Reapply checks on cldfra_bl and qc_bl to avoid FPEs in radiation driver - ! when these two quantities are multiplied by eachother (they may have changed - ! in the MF scheme: - !IF (icloud_bl > 0) THEN - IF ( zw(k) < 3000.0 ) THEN - IF (QC_BL(i,k,j) < 5E-6 .AND. CLDFRA_BL(i,k,j) > 0.005) QC_BL(i,k,j)= 5E-6 - ELSE - IF (QC_BL(i,k,j) < 1E-8 .AND. CLDFRA_BL(i,k,j) > 0.005) QC_BL(i,k,j)= 1E-8 - ENDIF ENDIF el_pbl(i,k,j)=el(k) @@ -4838,26 +5067,37 @@ SUBROUTINE mynn_bl_driver( & cov(i,k,j)=cov1(k) sh3d(i,k,j)=sh(k) - IF ( bl_mynn_tkebudget == 1) THEN + ENDDO !end-k + + IF ( bl_mynn_tkebudget == 1) THEN + DO k = kts,kte dqke(i,k,j) = (qke1(k)-dqke(i,k,j))*0.5 !qke->tke qWT(i,k,j) = qWT1(k)*delt qSHEAR(i,k,j)= qSHEAR1(k)*delt qBUOY(i,k,j) = qBUOY1(k)*delt qDISS(i,k,j) = qDISS1(k)*delt - ENDIF + ENDDO + ENDIF - !update updraft properties - IF (bl_mynn_edmf > 0) THEN - edmf_a(i,k,j)=edmf_a1(k) - edmf_w(i,k,j)=edmf_w1(k) - edmf_qt(i,k,j)=edmf_qt1(k) - edmf_thl(i,k,j)=edmf_thl1(k) - edmf_ent(i,k,j)=edmf_ent1(k) - edmf_qc(i,k,j)=edmf_qc1(k) - ENDIF + !update updraft properties + IF (bl_mynn_output > 0) THEN !research mode == 1 + DO k = kts,kte + edmf_a(i,k)=edmf_a1(k) + edmf_w(i,k)=edmf_w1(k) + edmf_qt(i,k)=edmf_qt1(k) + edmf_thl(i,k)=edmf_thl1(k) + edmf_ent(i,k)=edmf_ent1(k) + edmf_qc(i,k)=edmf_qc1(k) + sub_thl3D(i,k)=sub_thl(k) + sub_sqv3D(i,k)=sub_sqv(k) + det_thl3D(i,k)=det_thl(k) + det_sqv3D(i,k)=det_sqv(k) + ENDDO + ENDIF - !*** Begin debug prints - IF ( debug_code ) THEN + !*** Begin debug prints + IF ( debug_code ) THEN + DO k = kts,kte IF ( sh(k) < 0. .OR. sh(k)> 200.)print*,& "SUSPICIOUS VALUES AT: i,j,k=",i,j,k," sh=",sh(k) IF ( qke(i,k,j) < -1. .OR. qke(i,k,j)> 200.)print*,& @@ -4881,30 +5121,27 @@ SUBROUTINE mynn_bl_driver( & PRINT*,"SUSPICIOUS VALUES: CLDFRA_BL=",cldfra_bl(i,k,j)," qc_bl=",QC_BL(i,k,j) ENDIF ENDIF - ENDIF - !*** End debug prints - ENDDO + + !IF (I==IMD .AND. J==JMD) THEN + ! PRINT*,"MYNN DRIVER END: k=",k," sh=",sh(k) + ! PRINT*," sqw=",sqw(k)," thl=",thl(k)," exch_m=",exch_m(i,k,j) + ! PRINT*," xland=",xland(i,j)," rmol=",rmol(i,j)," ust=",ust(i,j) + ! PRINT*," qke=",qke(i,k,j)," el=",el_pbl(i,k,j)," tsq=",tsq(i,k,j) + ! PRINT*," PBLH=",PBLH(i,j)," u=",u(i,k,j)," v=",v(i,k,j) + ! PRINT*," vq=",vq(k)," vt=",vt(k)," vdfg=",vdfg(i,j) + !ENDIF + ENDDO !end-k + ENDIF + !*** End debug prints !JOE-add tke_pbl for coupling w/shallow-cu schemes (TKE_PBL = QKE/2.) ! TKE_PBL is defined on interfaces, while QKE is at middle of layer. - tke_pbl(i,kts,j) = 0.5*MAX(qke(i,kts,j),1.0e-10) - DO k = kts+1,kte - afk = dz1(k)/( dz1(k)+dz1(k-1) ) - abk = 1.0 -afk - tke_pbl(i,k,j) = 0.5*MAX(qke(i,k,j)*abk+qke(i,k-1,j)*afk,1.0e-3) - ENDDO - -!*** Begin debugging -! IF(I==IMD .AND. J==JMD)THEN -! k=kdebug -! PRINT*,"MYNN DRIVER END: k=",1," sh=",sh(k) -! PRINT*," sqw=",sqw(k)," thl=",thl(k)," k_m=",k_m(i,k,j) -! PRINT*," xland=",xland(i,j)," rmol=",rmol(i,j)," ust=",ust(i,j) -! PRINT*," qke=",qke(i,k,j)," el=",el_pbl(i,k,j)," tsq=",tsq(i,k,j) -! PRINT*," PBLH=",PBLH(i,j)," u=",u(i,k,j)," v=",v(i,k,j) -! PRINT*," vq=",vq(k)," vt=",vt(k)," vdfg=",vdfg(i,j) -! ENDIF -!*** End debugging + !tke_pbl(i,kts,j) = 0.5*MAX(qke(i,kts,j),1.0e-10) + !DO k = kts+1,kte + ! afk = dz1(k)/( dz1(k)+dz1(k-1) ) + ! abk = 1.0 -afk + ! tke_pbl(i,k,j) = 0.5*MAX(qke(i,k,j)*abk+qke(i,k-1,j)*afk,1.0e-3) + !ENDDO ENDDO ENDDO @@ -4927,9 +5164,10 @@ END SUBROUTINE mynn_bl_driver !>\ingroup gsd_mynn_edmf SUBROUTINE mynn_bl_init_driver( & &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & - &RQCBLTEN,RQIBLTEN & !,RQNIBLTEN,RQNCBLTEN & - &,QKE,TKE_PBL,EXCH_H & -! &,icloud_bl,qc_bl,cldfra_bl & !JOE-subgrid bl clouds + &RQCBLTEN,RQIBLTEN & !,RQNIBLTEN,RQNCBLTEN & + &,QKE, & + &EXCH_H & + !&,icloud_bl,qc_bl,cldfra_bl & &,RESTART,ALLOWED_TO_READ,LEVEL & &,IDS,IDE,JDS,JDE,KDS,KDE & &,IMS,IME,JMS,JME,KMS,KME & @@ -4947,7 +5185,7 @@ SUBROUTINE mynn_bl_init_driver( & REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: & &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & &RQCBLTEN,RQIBLTEN,& !RQNIBLTEN,RQNCBLTEN & - &QKE,TKE_PBL,EXCH_H + &QKE,EXCH_H ! REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: & ! &qc_bl,cldfra_bl @@ -4971,7 +5209,6 @@ SUBROUTINE mynn_bl_init_driver( & !if( p_qnc >= param_first_scalar ) RQNCBLTEN(i,k,j)=0. !if( p_qni >= param_first_scalar ) RQNIBLTEN(i,k,j)=0. !QKE(i,k,j)=0. - TKE_PBL(i,k,j)=0. EXCH_H(i,k,j)=0. ! if(icloud_bl > 0) qc_bl(i,k,j)=0. ! if(icloud_bl > 0) cldfra_bl(i,k,j)=0. @@ -5036,15 +5273,13 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) REAL, DIMENSION(KTS:KTE+1), INTENT(IN) :: zw1D !LOCAL VARS REAL :: PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv - REAL :: delt_thv !< delta theta-v; dependent on land/sea point - REAL, PARAMETER :: sbl_lim = 200. !< upper limit of stable BL height (m). - REAL, PARAMETER :: sbl_damp = 400. !< transition length for blending (m). - INTEGER :: I,J,K,kthv,ktke,kzi,kzi2 + REAL :: delt_thv !delta theta-v; dependent on land/sea point + REAL, PARAMETER :: sbl_lim = 200. !upper limit of stable BL height (m). + REAL, PARAMETER :: sbl_damp = 400. !transition length for blending (m). + INTEGER :: I,J,K,kthv,ktke,kzi - !ADD KPBL (kzi) - !KZI2 is the TKE-based part of the hybrid KPBL + !Initialize KPBL (kzi) kzi = 2 - kzi2= 2 !> - FIND MIN THETAV IN THE LOWEST 200 M AGL k = kts+1 @@ -5076,11 +5311,9 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) ! DO WHILE (zi .EQ. 0.) DO k=kts+1,kte-1 IF (thetav1D(k) .GE. (minthv + delt_thv))THEN - !kzi = MAX(k-1,1) zi = zw1D(k) - dz1D(k-1)* & & MIN((thetav1D(k)-(minthv + delt_thv))/ & & MAX(thetav1D(k)-thetav1D(k-1),1E-6),1.0) - kzi= MAX(k-1,1) + NINT((zi-zw1D(k-1))/dz1D(k-1)) ENDIF !k = k+1 IF (k .EQ. kte-1) zi = zw1D(kts+1) !EXIT SAFEGUARD @@ -5107,12 +5340,10 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) qtke =MAX(Qke1D(k)/2.,0.) ! maximum TKE qtkem1=MAX(Qke1D(k-1)/2.,0.) IF (qtke .LE. TKEeps) THEN - !kzi2 = MAX(k-1,1) PBLH_TKE = zw1D(k) - dz1D(k-1)* & & MIN((TKEeps-qtke)/MAX(qtkem1-qtke, 1E-6), 1.0) !IN CASE OF NEAR ZERO TKE, SET PBLH = LOWEST LEVEL. PBLH_TKE = MAX(PBLH_TKE,zw1D(kts+1)) - kzi2 = MAX(k-1,1) + NINT((PBLH_TKE-zw1D(k-1))/dz1D(k-1)) !print *,"PBLH_TKE:",i,j,PBLH_TKE, Qke1D(k)/2., zw1D(kts+1) ENDIF !k = k+1 @@ -5137,8 +5368,13 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) zi=PBLH_TKE*(1.-wt) + zi*wt ENDIF - !ADD KPBL (kzi) for coupling to some Cu schemes - kzi = MAX(INT(kzi2*(1.-wt) + kzi*wt),1) + !Compute KPBL (kzi) + DO k=kts+1,kte-1 + IF ( zw1D(k) >= zi) THEN + kzi = k-1 + exit + ENDIF + ENDDO #ifdef HARDCODE_VERTICAL # undef kts @@ -5188,11 +5424,16 @@ SUBROUTINE DMP_mf( & & s_awu,s_awv,s_awqke, & & s_awqnc,s_awqni, & & s_awqnwfa,s_awqnifa, & + & sub_thl,sub_sqv, & + & sub_u,sub_v, & + & det_thl,det_sqv,det_sqc, & + & det_u,det_v, & #if (WRF_CHEM == 1) & nchem,chem,s_awchem, & #endif ! in/outputs - subgrid scale clouds - & qc_bl1d,cldfra_bl1d, & + & qc_bl1d,cldfra_bl1d, & + & qc_bl1D_old,cldfra_bl1D_old, & ! inputs - flags for moist arrays & F_QC,F_QI, & F_QNC,F_QNI, & @@ -5244,7 +5485,8 @@ SUBROUTINE DMP_mf( & s_awv, & s_awqke, s_aw2 - REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: qc_bl1d,cldfra_bl1d + REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: qc_bl1d,cldfra_bl1d, & + qc_bl1d_old,cldfra_bl1d_old INTEGER, PARAMETER :: NUP=10, debug_mf=0 @@ -5260,7 +5502,7 @@ SUBROUTINE DMP_mf( & ! internal variables INTEGER :: K,I,k50 REAL :: fltv,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & - pwmin,pwmax,wmin,wmax,wlv,wtv,Psig_w,maxw,maxqc,wpbl + pwmin,pwmax,wmin,wmax,wlv,Psig_w,maxw,maxqc,wpbl REAL :: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,QNCn,QNIn,QNWFAn,QNIFAn, & Wn2,Wn,EntEXP,EntW,BCOEFF,THVkm1,THVk,Pk @@ -5304,24 +5546,41 @@ SUBROUTINE DMP_mf( & ! VARIABLES FOR CHABOUREAU-BECHTOLD CLOUD FRACTION REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: vt, vq, sgm REAL :: sigq,xl,tlk,qsat_tl,rsl,cpm,a,qmq,mf_cf,Q1,diffqt,& - Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid + Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid, & + Ac_mf,Ac_strat,qc_mf ! Variables for plume interpolation/saturation check REAL,DIMENSION(KTS:KTE) :: exneri,dzi - REAL :: THp, QTp, QCp, esat, qsl + REAL :: THp, QTp, QCp, QCs, esat, qsl ! WA TEST 11/9/15 for consistent reduction of updraft params - REAL :: csigma,acfac,EntThrottle + REAL :: csigma,acfac !JOE- plume overshoot INTEGER :: overshoot - REAL :: bvf, Frz + REAL :: bvf, Frz, dzp !Flux limiter: not let mass-flux of heat between k=1&2 exceed (fluxportion)*(surface heat flux). !This limiter makes adjustments to the entire column. REAL :: adjustment, flx1 REAL, PARAMETER :: fluxportion=0.75 ! set liberally, so has minimal impact. 0.5 starts to have a noticeable impact ! over land (decrease maxMF by 10-20%), but no impact over water. + + !Subsidence + REAL,DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence + det_thl,det_sqv,det_sqc,det_u,det_v, & !tendencied due to detrainment + envm_a,envm_w,envm_thl,envm_sqv,envm_sqc, & + envm_u,envm_v !environmental variables defined at middle of layer + REAL,DIMENSION(KTS:KTE+1) :: envi_a,envi_w !environmental variables defined at model interface + REAL :: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & + detrateUV,oow,exc_fac,aratio,detturb,qc_grid + REAL, PARAMETER :: Cdet = 1./45. + !parameter "Csub" determines the propotion of upward vertical velocity that contributes to + !environmenatal subsidence. Some portion is expected to be compensated by downdrafts instead of + !gentle environmental subsidence. 1.0 assumes all upward vertical velocity in the mass-flux scheme + !is compensated by "gentle" environmental subsidence. + REAL, PARAMETER :: Csub=0.25 + ! check the inputs ! print *,'dt',dt ! print *,'dz',dz @@ -5385,7 +5644,16 @@ SUBROUTINE DMP_mf( & s_awchem(kts:kte+1,1:nchem) = 0.0 ENDIF #endif - +! Initialize explicit tendencies for subsidence & detrainment + sub_thl = 0. + sub_sqv = 0. + sub_u = 0. + sub_v = 0. + det_thl = 0. + det_sqv = 0. + det_sqc = 0. + det_u = 0. + det_v = 0. ! Taper off MF scheme when significant resolved-scale motions ! are present This function needs to be asymetric... @@ -5411,8 +5679,8 @@ SUBROUTINE DMP_mf( & !k = k + 1 ENDDO !print*," maxw before manipulation=", maxw - maxw = MAX(0.,maxw - 0.5) ! do nothing for small w, but - Psig_w = MAX(0.0, 1.0 - maxw/0.5) ! linearly taper off for w > 0.5 m/s + maxw = MAX(0.,maxw - 1.0) ! do nothing for small w (< 1 m/s), but + Psig_w = MAX(0.0, 1.0 - maxw) ! linearly taper off for w > 1.0 m/s Psig_w = MIN(Psig_w, Psig_shcu) !print*," maxw=", maxw," Psig_w=",Psig_w," Psig_shcu=",Psig_shcu @@ -5431,7 +5699,7 @@ SUBROUTINE DMP_mf( & ELSE hux = -0.005 ! LAND ! dT/dz must be < - 0.5 K per 100 m. ENDIF - DO k=1,MAX(1,k50-1) + DO k=1,MAX(1,k50-1) !use "-1" because k50 used interface heights (zw). IF (k == 1) then IF ((th(k)-ts)/(0.5*dz(k)) < hux) THEN superadiabatic = .true. @@ -5453,23 +5721,25 @@ SUBROUTINE DMP_mf( & ! Some of these criteria may be a little redundant but useful for bullet-proofing. ! (1) largest plume = 1.0 * dx. ! (2) Apply a scale-break, assuming no plumes with diameter larger than PBLH can exist. - ! (3) max plume size beneath clouds deck approx = height of cloud_base. - ! (4) add shear-dependent limit, when plume model breaks down. (taken out) + ! (3) max plume size beneath clouds deck approx = 0.5 * cloud_base. + ! (4) add wspd-dependent limit, when plume model breaks down. (hurricanes) ! (5) land-only limit to reduce plume sizes in weakly forced conditions ! Criteria (1) NUP2 = max(1,min(NUP,INT(dx*dcut/dl))) - ! Criteria (2) and (4) - !wspd_pbl=SQRT(MAX(u(kpbl)**2 + v(kpbl)**2, 0.01)) - maxwidth = 1.2*PBLH !- MIN(15.*MAX(wspd_pbl - 7.5, 0.), 0.3*PBLH) + !Criteria (2) + maxwidth = 1.2*PBLH ! Criteria (3) - maxwidth = MIN(maxwidth,cloud_base) + maxwidth = MIN(maxwidth,0.75*cloud_base) + ! Criteria (4) + wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01)) + !Note: area fraction (acfac) is modified below ! Criteria (5) IF((landsea-1.5).LT.0)THEN width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) maxwidth = MIN(maxwidth,width_flx) ENDIF ! Convert maxwidth to number of plumes - NUP2 = MIN(MAX(INT((maxwidth - MOD(maxwidth,100.))/100), 0), NUP2) + NUP2 = MIN(MAX(INT((maxwidth - MOD(maxwidth,100.))/100), 0), NUP2) !Initialize values: ktop = 0 @@ -5499,7 +5769,12 @@ SUBROUTINE DMP_mf( & UPA(1,I) = N*l*l/(dx*dx) * dl ! fractional area of plume n ! Make updraft area (UPA) a function of the buoyancy flux ! acfac = .5*tanh((fltv - 0.03)/0.09) + .5 - acfac = .5*tanh((fltv - 0.02)/0.09) + .5 +! acfac = .5*tanh((fltv - 0.02)/0.09) + .5 + acfac = .5*tanh((fltv - 0.01)/0.09) + .5 + + !add a windspeed-dependent adjustment to acfac that tapers off + !the mass-flux scheme linearly above sfc wind speeds of 20 m/s: + acfac = acfac*(1. - MIN(MAX(wspd_pbl - 20.0, 0.0), 10.0)/10.) UPA(1,I)=UPA(1,I)*acfac An2 = An2 + UPA(1,I) ! total fractional area of all plumes @@ -5520,12 +5795,22 @@ SUBROUTINE DMP_mf( & ELSE csigma = 1.34 ! LAND ENDIF + + IF (env_subs) THEN + exc_fac = 0.0 + ELSE + exc_fac = 0.58 + ENDIF + + !Note: sigmaW is typically about 0.5*wstar sigmaW =1.34*wstar*(z0/pblh)**(1./3.)*(1 - 0.8*z0/pblh) sigmaQT=csigma*qstar*(z0/pblh)**(-1./3.) sigmaTH=csigma*thstar*(z0/pblh)**(-1./3.) - wmin=MIN(sigmaW*pwmin,0.1) - wmax=MIN(sigmaW*pwmax,0.333) + !Note: Given the pwmin & pwmax set above, these max/mins are + ! rarely exceeded. + wmin=MIN(sigmaW*pwmin,0.05) + wmax=MIN(sigmaW*pwmax,0.4) !recompute acfac for plume excess acfac = .5*tanh((fltv - 0.03)/0.07) + .5 @@ -5534,44 +5819,49 @@ SUBROUTINE DMP_mf( & DO I=1,NUP !NUP2 IF(I > NUP2) exit wlv=wmin+(wmax-wmin)/NUP2*(i-1) - wtv=wmin+(wmax-wmin)/NUP2*i !SURFACE UPDRAFT VERTICAL VELOCITY - !UPW(1,I)=0.5*(wlv+wtv) UPW(1,I)=wmin + REAL(i)/REAL(NUP)*(wmax-wmin) !IF (UPW(1,I) > 0.5*ZW(2)/dt) UPW(1,I) = 0.5*ZW(2)/dt - !SURFACE UPDRAFT AREA - !UPA(1,I)=0.5*ERF(wtv/(sqrt(2.)*sigmaW)) - 0.5*ERF(wlv/(sqrt(2.)*sigmaW)) - !UPA(1,I)=0.25*ERF(wtv/(sqrt(2.)*sigmaW)) - 0.25*ERF(wlv/(sqrt(2.)*sigmaW)) !12.0 - UPU(1,I)=(U(KTS)*DZ(KTS+1)+U(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPV(1,I)=(V(KTS)*DZ(KTS+1)+V(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQC(1,I)=0 !UPQC(1,I)=(QC(KTS)*DZ(KTS+1)+QC(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQT(1,I)=(QT(KTS)*DZ(KTS+1)+QT(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1))& - & +0.58*UPW(1,I)*sigmaQT/sigmaW + & +exc_fac*UPW(1,I)*sigmaQT/sigmaW UPTHV(1,I)=(THV(KTS)*DZ(KTS+1)+THV(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & - & +0.58*UPW(1,I)*sigmaTH/sigmaW + & +exc_fac*UPW(1,I)*sigmaTH/sigmaW !was UPTHL(1,I)= UPTHV(1,I)/(1.+svp1*UPQT(1,I)) !assume no saturated parcel at surface UPTHL(1,I)=(THL(KTS)*DZ(KTS+1)+THL(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & - & +0.58*UPW(1,I)*sigmaTH/sigmaW + & +exc_fac*UPW(1,I)*sigmaTH/sigmaW UPQKE(1,I)=(QKE(KTS)*DZ(KTS+1)+QKE(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNC(1,I)=(QNC(KTS)*DZ(KTS+1)+QNC(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNI(1,I)=(QNI(KTS)*DZ(KTS+1)+QNI(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNWFA(1,I)=(QNWFA(KTS)*DZ(KTS+1)+QNWFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNIFA(1,I)=(QNIFA(KTS)*DZ(KTS+1)+QNIFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) + ENDDO + #if (WRF_CHEM == 1) IF (bl_mynn_mixchem == 1) THEN - do ic = 1,nchem - UPCHEM(1,I,ic)= (CHEM(KTS,ic)*DZ(KTS+1)+CHEM(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - enddo + DO I=1,NUP !NUP2 + IF(I > NUP2) exit + do ic = 1,nchem + UPCHEM(1,I,ic)=(CHEM(KTS,ic)*DZ(KTS+1)+CHEM(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) + enddo + ENDDO ENDIF #endif + !Initialize environmental variables which can be modified by detrainment + DO k=kts,kte + envm_thl(k)=THL(k) + envm_sqv(k)=QV(k) + envm_sqc(k)=QC(k) + envm_u(k)=U(k) + envm_v(k)=V(k) ENDDO - EntThrottle = 0.001 !MAX(0.02/MAX((flt*1.25*1004.)-25.,5.),0.0002) !QCn = 0. ! do integration updraft DO I=1,NUP !NUP2 @@ -5581,19 +5871,18 @@ SUBROUTINE DMP_mf( & l = dl*I ! diameter of plume DO k=KTS+1,KTE-1 !w-dependency for entrainment a la Tian and Kuang (2016) - !ENT(k,i) = 0.5/(MIN(MAX(UPW(K-1,I),0.75),1.5)*l) - !ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.5)*l) - ENT(k,i) = 0.33/(MIN(MAX(UPW(K-1,I),0.666),2.0)*l) + !ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.9)*l) + wmin = 0.3 + l*0.0005 !* MAX(pblh-ZW(k+1), 0.0)/pblh + ENT(k,i) = 0.31/(MIN(MAX(UPW(K-1,I),wmin),1.9)*l) !Entrainment from Negggers (2015, JAMES) !ENT(k,i) = 0.02*l**-0.35 - 0.0009 - !JOE - implement minimum background entrainment + !Minimum background entrainment ENT(k,i) = max(ENT(k,i),0.0003) !ENT(k,i) = max(ENT(k,i),0.05/ZW(k)) !not needed for Tian and Kuang !JOE - increase entrainment for plumes extending very high. - IF(ZW(k) >= MIN(pblh+1500., 3500.))THEN - ENT(k,i)=ENT(k,i) + (ZW(k)-MIN(pblh+1500.,3500.))*5.0E-6 + IF(ZW(k) >= MIN(pblh+1500., 4000.))THEN + ENT(k,i)=ENT(k,i) + (ZW(k)-MIN(pblh+1500.,4000.))*5.0E-6 ENDIF - !IF(UPW(K-1,I) > 2.0) ENT(k,i) = ENT(k,i) + EntThrottle*(UPW(K-1,I) - 2.0) !SPP ENT(k,i) = ENT(k,i) * (1.0 - rstoch_col(k)) @@ -5612,6 +5901,12 @@ SUBROUTINE DMP_mf( & QNWFAn=UPQNWFA(k-1,I)*(1.-EntExp) + QNWFA(k)*EntExp QNIFAn=UPQNIFA(k-1,I)*(1.-EntExp) + QNIFA(k)*EntExp + !capture the updated qc, qt & thl modified by entranment alone, + !since they will be modified later if condensation occurs. + qc_ent = QCn + qt_ent = QTn + thl_ent = THLn + ! Exponential Entrainment: !EntExp= exp(-ENT(K,I)*(ZW(k)-ZW(k-1))) !QTn =QT(K) *(1-EntExp)+UPQT(K-1,I)*EntExp @@ -5671,6 +5966,12 @@ SUBROUTINE DMP_mf( & Wn = UPW(K-1,I) - MIN(1.25*(ZW(k)-ZW(k-1))/200., 2.0) ENDIF Wn = MIN(MAX(Wn,0.0), 3.0) + !Check to make sure that the plume made it up at least one level. + !if it failed, then set nup2=0 and exit the mass-flux portion. + IF (k==kts+1 .AND. Wn == 0.) THEN + NUP2=0 + exit + ENDIF IF (debug_mf == 1) THEN IF (Wn .GE. 3.0) THEN @@ -5683,31 +5984,57 @@ SUBROUTINE DMP_mf( & ENDIF !Allow strongly forced plumes to overshoot if KE is sufficient - IF (fltv > 0.05 .AND. Wn <= 0 .AND. overshoot == 0) THEN + !IF (fltv > 0.05 .AND. Wn <= 0 .AND. overshoot == 0) THEN + IF (Wn <= 0.0 .AND. overshoot == 0) THEN overshoot = 1 IF ( THVk-THVkm1 .GT. 0.0 ) THEN bvf = SQRT( gtr*(THVk-THVkm1)/dz(k) ) !vertical Froude number Frz = UPW(K-1,I)/(bvf*dz(k)) - IF ( Frz >= 0.5 ) Wn = MIN(Frz,1.0)*UPW(K-1,I) + !IF ( Frz >= 0.5 ) Wn = MIN(Frz,1.0)*UPW(K-1,I) + dzp = dz(k)*MAX(MIN(Frz,1.0),0.0) ! portion of highest layer the plume penetrates ENDIF - ELSEIF (fltv > 0.05 .AND. overshoot == 1) THEN - !Do not let overshooting parcel go more than 1 layer up - Wn = 0.0 + !ELSEIF (fltv > 0.05 .AND. overshoot == 1) THEN + ELSE + dzp = dz(k) + ! !Do not let overshooting parcel go more than 1 layer up + ! Wn = 0.0 ENDIF !Limit very tall plumes ! Wn2=Wn2*EXP(-MAX(ZW(k)-(pblh+2000.),0.0)/1000.) ! IF(ZW(k) >= pblh+3000.)Wn2=0. - Wn=Wn*EXP(-MAX(ZW(k+1)-MIN(pblh+2000.,3000.),0.0)/1000.) - IF(ZW(k+1) >= MIN(pblh+3000.,4500.))Wn=0. + Wn=Wn*EXP(-MAX(ZW(k+1)-MIN(pblh+2000.,3500.),0.0)/1000.) !JOE- minimize the plume penetratration in stratocu-topped PBL ! IF (fltv < 0.06) THEN ! IF(ZW(k+1) >= pblh-200. .AND. qc(k) > 1e-5 .AND. I > 4) Wn=0. ! ENDIF + !Modify environment variables (representative of the model layer - envm*) + !following the updraft dynamical detrainment of Asai and Kasahara (1967, JAS). + !Reminder: w is limited to be non-negative (above) + aratio = MIN(UPA(K-1,I)/(1.-UPA(K-1,I)), 0.5) !limit should never get hit + detturb = 0.00008 + oow = -0.064/MAX(1.0,(0.5*(Wn+UPW(K-1,I)))) !coef for dynamical detrainment rate + detrate = MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0004) ! dynamical detrainment rate (m^-1) + detrateUV= MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0001) ! dynamical detrainment rate (m^-1) + envm_thl(k)=envm_thl(k) + (0.5*(thl_ent + UPTHL(K-1,I)) - thl(k))*detrate*aratio*dzp + qv_ent = 0.5*(MAX(qt_ent-qc_ent,0.) + MAX(UPQT(K-1,I)-UPQC(K-1,I),0.)) + envm_sqv(k)=envm_sqv(k) + (qv_ent-QV(K))*detrate*aratio*dzp + IF (UPQC(K-1,I) > 1E-8) THEN + IF (QC(K) > 1E-6) THEN + qc_grid = QC(K) + ELSE + qc_grid = cldfra_bl1d(k)*qc_bl1d(K) + ENDIF + envm_sqc(k)=envm_sqc(k) + MAX(UPA(K-1,I)*0.5*(QCn + UPQC(K-1,I)) - qc_grid, 0.0)*detrate*aratio*dzp + ENDIF + envm_u(k) =envm_u(k) + (0.5*(Un + UPU(K-1,I)) - U(K))*detrateUV*aratio*dzp + envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*dzp + IF (Wn > 0.) THEN + !Update plume variables at current k index UPW(K,I)=Wn !Wn !sqrt(Wn2) UPTHV(K,I)=THVn UPTHL(K,I)=THLn @@ -5761,12 +6088,13 @@ SUBROUTINE DMP_mf( & IF (ktop == 0) THEN ztop = 0.0 ELSE - ztop=zw(ktop+1) + ztop=zw(ktop) ENDIF IF(nup2 > 0) THEN !Calculate the fluxes for each variable + !All s_aw* variable are == 0 at k=1 DO k=KTS,KTE IF(k > KTOP) exit DO i=1,NUP !NUP2 @@ -5782,16 +6110,23 @@ SUBROUTINE DMP_mf( & IF (tke_opt > 0) THEN s_awqke(k+1)= s_awqke(k+1) + UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w ENDIF + ENDDO + s_awqv(k+1) = s_awqt(k+1) - s_awqc(k+1) + ENDDO #if (WRF_CHEM == 1) IF (bl_mynn_mixchem == 1) THEN - do ic = 1,nchem - s_awchem(k+1,ic) = s_awchem(k+1,ic) + UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w - enddo + DO k=KTS,KTE + IF(k > KTOP) exit + DO i=1,NUP !NUP2 + IF(I > NUP2) exit + do ic = 1,nchem + s_awchem(k+1,ic) = s_awchem(k+1,ic) + UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w + enddo + ENDDO + ENDDO ENDIF #endif - ENDDO - s_awqv(k+1) = s_awqt(k+1) - s_awqc(k+1) - ENDDO + IF (scalar_opt > 0) THEN DO k=KTS,KTE IF(k > KTOP) exit @@ -5805,24 +6140,22 @@ SUBROUTINE DMP_mf( & ENDDO ENDIF - !Flux limiter: Check for too large heat flux at top of first model layer - ! Given that the temperature profile is calculated as: - ! d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt & - ! & -dtz(k)*s_awthl(kts+1) + diss_heat(k)*delt*dheat_opt - ! So, s_awthl(kts+1) must be less than flt + !Flux limiter: Check ratio of heat flux at top of first model layer + !and at the surface. Make sure estimated flux out of the top of the + !layer is < fluxportion*surface_heat_flux IF (s_aw(kts+1) /= 0.) THEN - THVk = (THL(kts)*DZ(kts+1)+THL(kts+1)*DZ(kts))/(DZ(kts+1)+DZ(kts)) - flx1 = MAX(s_aw(kts+1)*(s_awthl(kts+1)/s_aw(kts+1) - THVk),0.0) + dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) !dz centered at model interface + flx1 = MAX(s_aw(kts+1)*(TH(kts)-TH(kts+1))/dzi(kts),1.0e-5) ELSE flx1 = 0.0 + !print*,"ERROR: s_aw(kts+1) == 0, NUP=",NUP," NUP2=",NUP2,& + ! " superadiabatic=",superadiabatic," KTOP=",KTOP ENDIF - !flx1 = -dt/dz(kts)*s_awthl(kts+1) - !flx1 = (s_awthl(kts+1)-s_awthl(kts))!/(0.5*(dz(k)+dz(k-1))) adjustment=1.0 - !Print*,"Flux limiter in MYNN-EDMF:" - !Print*,"flx1=",flx1," s_awthl(kts+1)=",s_awthl(kts+1)," s_awthl(kts)=",s_awthl(kts) - IF (flx1 > fluxportion*flt .AND. flx1>0.0) THEN - adjustment= fluxportion*flt/flx1 + !Print*,"Flux limiter in MYNN-EDMF, adjustment=",fluxportion*flt/dz(kts)/flx1 + !Print*,"flt/dz=",flt/dz(kts)," flx1=",flx1," s_aw(kts+1)=",s_aw(kts+1) + IF (flx1 > fluxportion*flt/dz(kts) .AND. flx1>0.0) THEN + adjustment= fluxportion*flt/dz(kts)/flx1 s_aw = s_aw*adjustment s_awthl= s_awthl*adjustment s_awqt = s_awqt*adjustment @@ -5849,6 +6182,7 @@ SUBROUTINE DMP_mf( & !Print*,"adjustment=",adjustment," fluxportion=",fluxportion," flt=",flt !Calculate mean updraft properties for output: + !all edmf_* variables at k=1 correspond to the interface at top of first model layer DO k=KTS,KTE-1 IF(k > KTOP) exit DO I=1,NUP !NUP2 @@ -5868,6 +6202,8 @@ SUBROUTINE DMP_mf( & #endif ENDDO + !Note that only edmf_a is multiplied by Psig_w. This takes care of the + !scale-awareness of the subsidence below: IF (edmf_a(k)>0.) THEN edmf_w(k)=edmf_w(k)/edmf_a(k) edmf_qt(k)=edmf_qt(k)/edmf_a(k) @@ -5888,9 +6224,78 @@ SUBROUTINE DMP_mf( & ENDIF ENDDO + !Calculate the effects environmental subsidence. + !All envi_*variables are valid at the interfaces, like the edmf_* variables + IF (env_subs) THEN + DO k=KTS+1,KTE-1 + !First, smooth the profiles of w & a, since sharp vertical gradients + !in plume variables are not likely extended to env variables + !Note1: w is treated as negative further below + !Note2: both w & a will be transformed into env variables further below + envi_w(k) = onethird*(edmf_w(K-1)+edmf_w(K)+edmf_w(K+1)) + envi_a(k) = onethird*(edmf_a(k-1)+edmf_a(k)+edmf_a(k+1))*adjustment + ENDDO + !define env variables at k=1 (top of first model layer) + envi_w(kts) = edmf_w(kts) + envi_a(kts) = edmf_a(kts) + !define env variables at k=kte + envi_w(kte) = 0.0 + envi_a(kte) = edmf_a(kte) + !define env variables at k=kte+1 + envi_w(kte+1) = 0.0 + envi_a(kte+1) = edmf_a(kte) + !Add limiter for very long time steps (i.e. dt > 300 s) + !Note that this is not a robust check - only for violations in + ! the first model level. + IF (envi_w(kts) > 0.9*DZ(kts)/dt) THEN + sublim = 0.9*DZ(kts)/dt/envi_w(kts) + ELSE + sublim = 1.0 + ENDIF + !Transform w & a into env variables + DO k=KTS,KTE + temp=envi_a(k) + envi_a(k)=1.0-temp + envi_w(k)=csub*sublim*envi_w(k)*temp/(1.-temp) + ENDDO + !calculate tendencies from subsidence and detrainment valid at the middle of + !each model layer + dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) + sub_thl(kts)=0.5*envi_w(kts)*envi_a(kts)*(thl(kts+1)-thl(kts))/dzi(kts) + sub_sqv(kts)=0.5*envi_w(kts)*envi_a(kts)*(qv(kts+1)-qv(kts))/dzi(kts) + DO k=KTS+1,KTE-1 + dzi(k) = 0.5*(DZ(k)+DZ(k+1)) + sub_thl(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & + (thl(k+1)-thl(k))/dzi(k) + sub_sqv(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & + (qv(k+1)-qv(k))/dzi(k) + ENDDO + + DO k=KTS,KTE-1 + det_thl(k)=Cdet*(envm_thl(k)-thl(k))*envi_a(k)*Psig_w + det_sqv(k)=Cdet*(envm_sqv(k)-qv(k))*envi_a(k)*Psig_w + det_sqc(k)=Cdet*(envm_sqc(k)-qc(k))*envi_a(k)*Psig_w + ENDDO + IF (momentum_opt > 1) THEN + sub_u(kts)=0.5*envi_w(kts)*envi_a(kts)*(u(kts+1)-u(kts))/dzi(kts) + sub_v(kts)=0.5*envi_w(kts)*envi_a(kts)*(v(kts+1)-v(kts))/dzi(kts) + DO k=KTS+1,KTE-1 + sub_u(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & + (u(k+1)-u(k))/dzi(k) + sub_v(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & + (v(k+1)-v(k))/dzi(k) + ENDDO + + DO k=KTS,KTE-1 + det_u(k) = Cdet*(envm_u(k)-u(k))*envi_a(k)*Psig_w + det_v(k) = Cdet*(envm_v(k)-v(k))*envi_a(k)*Psig_w + ENDDO + ENDIF + ENDIF !end subsidence/env detranment + !First, compute exner, plume theta, and dz centered at interface !Here, k=1 is the top of the first model layer. These values do not - !need to be defined at k=kte (unused level). + !need to be defined at k=kte (unused level). DO K=KTS,KTE-1 exneri(k) = (exner(k)*DZ(k+1)+exner(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) edmf_th(k)= edmf_thl(k) + xlvcp/exneri(k)*edmf_qc(K) @@ -5973,13 +6378,34 @@ SUBROUTINE DMP_mf( & print*," CB: mf_cf=",mf_cf," cldfra_bl=",cldfra_bl1d(k)," edmf_a=",edmf_a(k) ENDIF + ! Update cloud fractions and specific humidities in grid cells + ! where the mass-flux scheme is active. Now, we also use the + ! stratus component of the SGS clouds as well. The stratus cloud + ! fractions (Ac_strat) are reduced slightly to give way to the + ! mass-flux SGS cloud fractions (Ac_mf). IF (cldfra_bl1d(k) < 0.5) THEN IF (mf_cf > 0.5*(edmf_a(k)+edmf_a(k-1))) THEN - cldfra_bl1d(k) = mf_cf - qc_bl1d(k) = QCp*0.5*(edmf_a(k)+edmf_a(k-1))/mf_cf + !cldfra_bl1d(k) = mf_cf + !qc_bl1d(k) = QCp*0.5*(edmf_a(k)+edmf_a(k-1))/mf_cf + Ac_mf = mf_cf + Ac_strat = cldfra_bl1d(k)*(1.0-mf_cf) + cldfra_bl1d(k) = Ac_mf + Ac_strat + !dillute Qc from updraft area to larger cloud area + qc_mf = QCp*0.5*(edmf_a(k)+edmf_a(k-1))/mf_cf + !The mixing ratios from the stratus component are not well + !estimated in shallow-cumulus regimes. Ensure stratus clouds + !have mixing ratio similar to cumulus + QCs = MIN(MAX(qc_bl1d(k), 0.5*qc_mf), 5E-4) + qc_bl1d(k) = (qc_mf*Ac_mf + QCs*Ac_strat)/cldfra_bl1d(k) ELSE - cldfra_bl1d(k)=0.5*(edmf_a(k)+edmf_a(k-1)) - qc_bl1d(k) = QCp + !cldfra_bl1d(k)=0.5*(edmf_a(k)+edmf_a(k-1)) + !qc_bl1d(k) = QCp + Ac_mf = 0.5*(edmf_a(k)+edmf_a(k-1)) + Ac_strat = cldfra_bl1d(k)*(1.0-Ac_mf) + cldfra_bl1d(k)=Ac_mf + Ac_strat + !Ensure stratus clouds have mixing ratio similar to cumulus + QCs = MIN(MAX(qc_bl1d(k), 0.5*qc_mf), 5E-4) + qc_bl1d(k) = (QCp*Ac_mf + QCs*Ac_strat)/cldfra_bl1d(k) ENDIF ENDIF @@ -6001,8 +6427,8 @@ SUBROUTINE DMP_mf( & Fng = MIN(23.9 + EXP(-1.6*(Q1+2.5)), 60.) ENDIF - vt(k) = qww - MIN(0.4,cldfra_bl1D(k))*beta*bb*Fng - 1. - vq(k) = alpha + MIN(0.4,cldfra_bl1D(k))*beta*a*Fng - tv0 + vt(k) = qww - MIN(0.40,Ac_mf)*beta*bb*Fng - 1. + vq(k) = alpha + MIN(0.40,Ac_mf)*beta*a*Fng - tv0 ENDIF ENDDO @@ -6014,8 +6440,8 @@ SUBROUTINE DMP_mf( & maxqc = maxval(edmf_qc(1:ktop)) IF ( maxqc < 1.E-8) maxmf = -1.0*maxmf ENDIF - -! + +! ! debugging ! IF (edmf_w(1) > 4.0) THEN @@ -6093,14 +6519,14 @@ subroutine condensation_edmf(QT,THL,P,zagl,THV,QC) EXN=(P/p1000mb)**rcp !QC=0. !better first guess QC is incoming from lower level, do not set to zero do i=1,NITER - T=EXN*THL + xlv/cp*QC + T=EXN*THL + xlvcp*QC QS=qsat_blend(T,P) QCOLD=QC QC=0.5*QC + 0.5*MAX((QT-QS),0.) if (abs(QC-QCOLD) 0.0) THEN ! PRINT*,"EDMF SAT, p:",p," iterations:",i @@ -6147,7 +6573,7 @@ SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) Psig_bl=1.0 Psig_shcu=1.0 - dxdh=MAX(dx,10.)/MIN(PBL1,3000.) + dxdh=MAX(2.5*dx,10.)/MIN(PBL1,3000.) ! Honnert et al. 2011, TKE in PBL *** original form used until 201605 !Psig_bl= ((dxdh**2) + 0.07*(dxdh**0.667))/((dxdh**2) + & ! (3./21.)*(dxdh**0.67) + (3./42.)) @@ -6158,7 +6584,7 @@ SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) Psig_bl= ((dxdh**2) + 0.106*(dxdh**0.667))/((dxdh**2) +0.066*(dxdh**0.667) + 0.071) !assume a 500 m cloud depth for shallow-cu clods - dxdh=MAX(dx,10.)/MIN(PBL1+500.,3500.) + dxdh=MAX(2.5*dx,10.)/MIN(PBL1+500.,3500.) ! Honnert et al. 2011, TKE in entrainment layer *** original form used until 201605 !Psig_shcu= ((dxdh**2) + (4./21.)*(dxdh**0.667))/((dxdh**2) + & ! (3./20.)*(dxdh**0.67) + (7./21.)) From 0472bef58e667fd87b44bcb7753eaef2aae89712 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Sat, 18 Apr 2020 03:44:41 +0000 Subject: [PATCH 080/141] add chsp changes from Jongil Han Co-authored-by: Jongil Han --- physics/module_sf_noahmplsm.f90 | 79 ++++++++--------------- physics/satmedmfvdifq.F | 4 +- physics/sfc_diff.f | 24 ++++--- physics/sfc_noahmp_drv.f | 32 +++------- physics/sfc_noahmp_drv.meta | 8 --- physics/sflx.f | 108 ++++++++++++++++---------------- 6 files changed, 106 insertions(+), 149 deletions(-) diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 index a0612d417..02ea70a6e 100644 --- a/physics/module_sf_noahmplsm.f90 +++ b/physics/module_sf_noahmplsm.f90 @@ -291,7 +291,6 @@ subroutine noahmp_sflx (parameters, & qc , soldn , lwdn , & ! in : forcing prcpconv, prcpnonc, prcpshcv, prcpsnow, prcpgrpl, prcphail, & ! in : forcing tbot , co2air , o2air , foln , ficeold , zlvl , & ! in : forcing - lheatstrg , & ! in : canopy heat storage albold , sneqvo , & ! in/out : stc , sh2o , smc , tah , eah , fwet , & ! in/out : canliq , canice , tv , tg , qsfc , qsnow , & ! in/out : @@ -299,9 +298,9 @@ subroutine noahmp_sflx (parameters, & zwt , wa , wt , wslake , lfmass , rtmass , & ! in/out : stmass , wood , stblcp , fastcp , lai , sai , & ! in/out : cm , ch , tauss , & ! in/out : - smcwtd ,deeprech , rech , cpfac , & ! in/out : + smcwtd ,deeprech , rech , & ! in/out : z0wrf , & - fsa , fsr , fira , fshx , ssoil , fcev , & ! out : + fsa , fsr , fira , fsh , ssoil , fcev , & ! out : fgev , fctr , ecan , etran , edir , trad , & ! out : tgb , tgv , t2mv , t2mb , q2v , q2b , & ! out : runsrf , runsub , apar , psn , sav , sag , & ! out : @@ -342,7 +341,6 @@ subroutine noahmp_sflx (parameters, & real , intent(in) :: lwdn !downward longwave radiation (w/m2) real , intent(in) :: sfcprs !pressure (pa) real , intent(inout) :: zlvl !reference height (m) - logical , intent(in) :: lheatstrg ! flag for canopy heat storage parameterization real , intent(in) :: cosz !cosine solar zenith angle [0-1] real , intent(in) :: tbot !bottom condition for soil temp. [k] real , intent(in) :: foln !foliage nitrogen (%) [1-saturated] @@ -401,14 +399,13 @@ subroutine noahmp_sflx (parameters, & real, intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] real, intent(inout) :: deeprech !recharge to or from the water table when deep [m] real, intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) - real, intent(inout) :: cpfac ! heat capacity enhancement factor due to heat storage ! output real , intent(out) :: z0wrf !combined z0 sent to coupled model real , intent(out) :: fsa !total absorbed solar radiation (w/m2) real , intent(out) :: fsr !total reflected solar radiation (w/m2) real , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] - real , intent(out) :: fshx !total sensible heat (w/m2) [+ to atm] + real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] real , intent(out) :: fcev !canopy evap heat (w/m2) [+ to atm] real , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] real , intent(out) :: fctr !transpiration heat (w/m2) [+ to atm] @@ -458,7 +455,6 @@ subroutine noahmp_sflx (parameters, & real :: taux !wind stress: e-w (n/m2) real :: tauy !wind stress: n-s (n/m2) real :: rhoair !density air (kg/m3) - real :: fsh !total sensible heat (w/m2) [+ to atm] ! real, dimension( 1: 5) :: vocflx !voc fluxes [ug c m-2 h-1] real, dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] real :: thair !potential temperature (k) @@ -649,7 +645,6 @@ subroutine noahmp_sflx (parameters, & call energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in isnow ,dt ,rhoair ,sfcprs ,qair , & !in sfctmp ,thair ,lwdn ,uu ,vv ,zlvl , & !in - lheatstrg , & !in co2air ,o2air ,solad ,solai ,cosz ,igs , & !in eair ,tbot ,zsnso ,zsoil , & !in elai ,esai ,fwet ,foln , & !in @@ -658,16 +653,16 @@ subroutine noahmp_sflx (parameters, & z0wrf , & imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out - tauy ,fira ,fsh ,fshx ,fcev ,fgev ,fctr , & !out + tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out trad ,psn ,apar ,ssoil ,btrani ,btran , & !out ponding,ts ,latheav , latheag , frozen_canopy,frozen_ground, & !out tv ,tg ,stc ,snowh ,eah ,tah , & !inout sneqvo ,sneqv ,sh2o ,smc ,snice ,snliq , & !inout albold ,cm ,ch ,dx ,dz8w ,q2 , & !inout #ifdef CCPP - tauss ,cpfac ,errmsg ,errflg , & !inout + tauss ,errmsg ,errflg , & !inout #else - tauss ,cpfac , & !inout + tauss , & !inout #endif !jref:start qc ,qsfc ,psfc , & !in @@ -1428,7 +1423,6 @@ end subroutine error subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in isnow ,dt ,rhoair ,sfcprs ,qair , & !in sfctmp ,thair ,lwdn ,uu ,vv ,zref , & !in - lheatstrg , & !in co2air ,o2air ,solad ,solai ,cosz ,igs , & !in eair ,tbot ,zsnso ,zsoil , & !in elai ,esai ,fwet ,foln , & !in @@ -1437,16 +1431,16 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in z0wrf , & imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out - tauy ,fira ,fsh ,fshx ,fcev ,fgev ,fctr , & !out + tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out trad ,psn ,apar ,ssoil ,btrani ,btran , & !out ponding,ts ,latheav , latheag , frozen_canopy,frozen_ground, & !out tv ,tg ,stc ,snowh ,eah ,tah , & !inout sneqvo ,sneqv ,sh2o ,smc ,snice ,snliq , & !inout albold ,cm ,ch ,dx ,dz8w ,q2 , & !inout #ifdef CCPP - tauss ,cpfac ,errmsg ,errflg, & !inout + tauss ,errmsg ,errflg, & !inout #else - tauss ,cpfac , & !inout + tauss , & !inout #endif !jref:start qc ,qsfc ,psfc , & !in @@ -1528,7 +1522,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real , intent(in) :: igs !growing season index (0=off, 1=on) real , intent(in) :: zref !reference height (m) - logical , intent(in) :: lheatstrg ! flag for canopy heat storage parameterization real , intent(in) :: tbot !bottom condition for soil temp. (k) real , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] real , dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf [m] @@ -1563,7 +1556,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real , intent(out) :: tauy !wind stress: n-s (n/m2) real , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(out) :: fshx !total sensible heat (w/m2) [+ to atm] real , intent(out) :: fcev !canopy evaporation (w/m2) [+ to atm] real , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] real , intent(out) :: fctr !transpiration (w/m2) [+ to atm] @@ -1610,7 +1602,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real , intent(inout) :: tah !canopy air temperature (k) real , intent(inout) :: albold !snow albedo at last time step(class type) real , intent(inout) :: tauss !non-dimensional snow age - real , intent(inout) :: cpfac !heat capacity enhancement factor due to heat storage real , intent(inout) :: cm !momentum drag coefficient real , intent(inout) :: ch !sensible heat exchange coefficient real , intent(inout) :: q1 @@ -1712,11 +1703,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real, parameter :: mpe = 1.e-6 real, parameter :: psiwlt = -150. !metric potential for wilting point (m) real, parameter :: z0 = 0.01 ! bare-soil roughness length (m) (i.e., under the canopy) -! -! parameters for heat storage parametrization -! - real, parameter :: z0min = 0.2 !minimum roughness length for heat storage - real, parameter :: z0max = 1.0 !maximum roughness length for heat storage ! --------------------------------------------------------------------------------------------------- ! initialize fluxes from veg. fraction @@ -1782,13 +1768,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in z0m = z0mg zpd = zpdg end if -! -! compute heat capacity enhancement factor as a function of z0m to mimic heat storage -! - if (lheatstrg .and. (.not. parameters%urban_flag) ) then - cpfac = (z0m - z0min) / (z0max - z0min) - cpfac = 1. + min(max(cpfac, 0.0), 1.0) - endif zlvl = max(zpd,parameters%hvt) + zref if(zpdg >= zlvl) zlvl = zpdg + zref @@ -1893,7 +1872,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in latheav = hsub frozen_canopy = .true. end if - gammav = cpair*cpfac*sfcprs/(0.622*latheav) + gammav = cpair*sfcprs/(0.622*latheav) if (tg .gt. tfrz) then latheag = hvap @@ -1902,14 +1881,14 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in latheag = hsub frozen_ground = .true. end if - gammag = cpair*cpfac*sfcprs/(0.622*latheag) + gammag = cpair*sfcprs/(0.622*latheag) ! if (sfctmp .gt. tfrz) then ! lathea = hvap ! else ! lathea = hsub ! end if -! gamma = cpair*cpfac*sfcprs/(0.622*lathea) +! gamma = cpair*sfcprs/(0.622*lathea) ! surface temperatures of the ground and canopy and energy fluxes @@ -1924,7 +1903,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in uu ,vv ,sfctmp ,thair ,qair , & !in eair ,rhoair ,snowh ,vai ,gammav ,gammag , & !in fwet ,laisun ,laisha ,cwp ,dzsnso , & !in - zlvl ,cpfac ,zpd ,z0m ,fveg , & !in + zlvl ,zpd ,z0m ,fveg , & !in z0mg ,emv ,emg ,canliq ,fsno, & !in canice ,stc ,df ,rssun ,rssha , & !in rsurf ,latheav ,latheag ,parsun ,parsha ,igs , & !in @@ -1980,7 +1959,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in tauy = fveg * tauyv + (1.0 - fveg) * tauyb fira = fveg * irg + (1.0 - fveg) * irb + irc fsh = fveg * shg + (1.0 - fveg) * shb + shc - fshx = fveg * shg/cpfac + (1.0 - fveg) * shb + shc/cpfac fgev = fveg * evg + (1.0 - fveg) * evb ssoil = fveg * ghv + (1.0 - fveg) * ghb fcev = evc @@ -1999,7 +1977,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in tauy = tauyb fira = irb fsh = shb - fshx = shb fgev = evb ssoil = ghb tg = tgb @@ -3305,8 +3282,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & uu ,vv ,sfctmp ,thair ,qair , & !in eair ,rhoair ,snowh ,vai ,gammav ,gammag, & !in fwet ,laisun ,laisha ,cwp ,dzsnso , & !in - zlvl ,cpfac , & !in - zpd ,z0m ,fveg , & !in + zlvl ,zpd ,z0m ,fveg , & !in z0mg ,emv ,emg ,canliq ,fsno, & !in canice ,stc ,df ,rssun ,rssha , & !in rsurf ,latheav ,latheag ,parsun ,parsha ,igs , & !in @@ -3366,7 +3342,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real, intent(in) :: laisun !sunlit leaf area index, one-sided (m2/m2) real, intent(in) :: laisha !shaded leaf area index, one-sided (m2/m2) real, intent(in) :: zlvl !reference height (m) - real, intent(in) :: cpfac !heat capacity enhancement factor due to heat storage real, intent(in) :: zpd !zero plane displacement (m) real, intent(in) :: z0m !roughness length, momentum (m) @@ -3724,7 +3699,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & cond = cah + cvh + cgh ata = (sfctmp*cah + tg*cgh) / cond bta = cvh/cond - csh = (1.-bta)*rhoair*cpair*cpfac*cvh + csh = (1.-bta)*rhoair*cpair*cvh ! prepare for latent heat flux above veg. @@ -3735,8 +3710,8 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & cond = caw + cew + ctw + cgw aea = (eair*caw + estg*cgw) / cond bea = (cew+ctw)/cond - cev = (1.-bea)*cew*rhoair*cpair*cpfac/gammav ! barlage: change to vegetation v3.6 - ctr = (1.-bea)*ctw*rhoair*cpair*cpfac/gammav + cev = (1.-bea)*cew*rhoair*cpair/gammav ! barlage: change to vegetation v3.6 + ctr = (1.-bea)*ctw*rhoair*cpair/gammav ! evaluate surface fluxes with current temperature and solve for dts @@ -3744,9 +3719,9 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & eah = aea + bea*estv ! canopy air e irc = fveg*(air + cir*tv**4) - shc = fveg*rhoair*cpair*cpfac*cvh * ( tv-tah) - evc = fveg*rhoair*cpair*cpfac*cew * (estv-eah) / gammav ! barlage: change to v in v3.6 - tr = fveg*rhoair*cpair*cpfac*ctw * (estv-eah) / gammav + shc = fveg*rhoair*cpair*cvh * ( tv-tah) + evc = fveg*rhoair*cpair*cew * (estv-eah) / gammav ! barlage: change to v in v3.6 + tr = fveg*rhoair*cpair*ctw * (estv-eah) / gammav if (tv > tfrz) then evc = min(canliq*latheav/dt,evc) ! barlage: add if block for canice in v3.6 else @@ -3786,8 +3761,8 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & air = - emg*(1.-emv)*lwdn - emg*emv*sb*tv**4 cir = emg*sb - csh = rhoair*cpair*cpfac/rahg - cev = rhoair*cpair*cpfac / (gammag*(rawg+rsurf)) ! barlage: change to ground v3.6 + csh = rhoair*cpair/rahg + cev = rhoair*cpair / (gammag*(rawg+rsurf)) ! barlage: change to ground v3.6 cgh = 2.*df(isnow+1)/dzsnso(isnow+1) ! write(*,*)'inside tg=',tg,'stc(1)=',stc(1) @@ -3842,10 +3817,10 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & ! consistent vegetation air temperature and vapor pressure since tg is not consistent with the tah/eah ! calculation. -! tah = sfctmp + (shg+shc)/(rhoair*cpair*cpfac*cah) -! tah = sfctmp + (shg*fveg+shc)/(rhoair*cpair*cpfac*cah) ! ground flux need fveg -! eah = eair + (evc+fveg*(tr+evg))/(rhoair*caw*cpair*cpfac/gammag ) -! qfx = (qsfc-qair)*rhoair*cpfac*caw !*cpair/gammag +! tah = sfctmp + (shg+shc)/(rhoair*cpair*cah) +! tah = sfctmp + (shg*fveg+shc)/(rhoair*cpair*cah) ! ground flux need fveg +! eah = eair + (evc+fveg*(tr+evg))/(rhoair*caw*cpair/gammag ) +! qfx = (qsfc-qair)*rhoair*caw !*cpair/gammag ! 2m temperature over vegetation ( corrected for low cq2v values ) if (opt_sfc == 1 .or. opt_sfc == 2) then @@ -3858,7 +3833,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & ! q2v = (eah*0.622/(sfcprs - 0.378*eah)) q2v = qsfc else - t2mv = tah - (shg+shc/fveg)/(rhoair*cpair*cpfac) * 1./cah2 + t2mv = tah - (shg+shc/fveg)/(rhoair*cpair) * 1./cah2 ! q2v = (eah*0.622/(sfcprs - 0.378*eah))- qfx/(rhoair*fv)* 1./vkc * log((2.+z0h)/z0h) q2v = qsfc - ((evc+tr)/fveg+evg)/(latheav*rhoair) * 1./cq2v endif diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 30e195cde..d465b7c5e 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -212,7 +212,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & 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.,rlmn2=10.) + parameter(rlmn=30.,rlmn1=5.,rlmn2=15.) parameter(rlmx=300.,elmx=300.) parameter(prmin=0.25,prmax=4.0) parameter(pr0=1.0,prtke=1.0,prscu=0.67) @@ -222,7 +222,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & parameter(aphi5=5.,aphi16=16.) parameter(elmfac=1.0,elefac=1.0,cql=100.) parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=5000.) - parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.1) + parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.15) parameter(h1=0.33333333) parameter(ck0=0.4,ck1=0.15,ch0=0.4,ch1=0.15) parameter(ce0=0.4) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 60d5ceeea..3427fbb75 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -220,11 +220,15 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = max(z0max, 1.0e-6) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil - czilc = 0.8 +! czilc = 0.8 - tem1 = 1.0 - sigmaf(i) - ztmax = z0max*exp( - tem1*tem1 - & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) +! tem1 = 1.0 - sigmaf(i) +! ztmax = z0max*exp( - tem1*tem1 +! & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) +! + czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) + ztmax = z0max * exp( - czilc * ca + & * 258.2 * sqrt(ustar(i,1)*z0max) ) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land @@ -261,11 +265,15 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height ! dependance of czil - czilc = 0.8 +! czilc = 0.8 + +! tem1 = 1.0 - sigmaf(i) +! ztmax = z0max*exp( - tem1*tem1 +! & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) + czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) + ztmax = z0max * exp( - czilc * ca + & * 258.2 * sqrt(ustar(i,1)*z0max) ) - 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) ! call stability diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f index 5ddd5aefc..bdba632bf 100644 --- a/physics/sfc_noahmp_drv.f +++ b/physics/sfc_noahmp_drv.f @@ -69,9 +69,6 @@ end subroutine noahmpdrv_finalize !! - 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 ! -! ! !----------------------------------- subroutine noahmpdrv_run & !................................... @@ -80,7 +77,6 @@ subroutine noahmpdrv_run & & sigmaf, sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & & prsl1, prslki, zf, dry, wind, slopetyp, & & shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, & - & lheatstrg, & & idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, & & iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, & & iopt_stc, xlatin, xcoszin, iyrlen, julian, & @@ -169,8 +165,6 @@ subroutine noahmpdrv_run & real (kind=kind_phys), intent(in) :: delt logical, dimension(im), intent(in) :: flag_iter, flag_guess - logical, intent(in) :: lheatstrg - real (kind=kind_phys), intent(in) :: con_hvap, con_cp, con_jcal, & & rhoh2o, con_eps, con_epsm1, con_fvirt, & & con_rd, con_hfus @@ -270,8 +264,6 @@ subroutine noahmpdrv_run & & irb,tr,evc,chleaf,chuc,chv2,chb2, & & fpice,pahv,pahg,pahb,pah,co2pp,o2pp,ch2b - real (kind=kind_phys) :: cpfac - integer :: i, k, ice, stype, vtype ,slope,nroot,couple logical :: flag(im) logical :: snowng,frzgra @@ -660,11 +652,6 @@ subroutine noahmpdrv_run & call 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) -! -! initialize heat capacity enhancement factor for heat storage parameterization -! - cpfac = 1.0 - if ( vtype == isice_table ) then ice = -1 @@ -752,7 +739,6 @@ subroutine noahmpdrv_run & & qc , swdn , lwdn ,& ! in : forcing & pconv , pnonc , pshcv , psnow , pgrpl , phail ,& ! in : forcing & tbot , co2pp , o2pp , foln , ficeold , zlvl ,& ! in : forcing - & lheatstrg ,& ! in : canopy heat storage & alboldx , sneqvox ,& ! in/out : & tsnsox , slsoil , smsoil , tahx , eahx , fwetx ,& ! in/out : & canliqx , canicex , tvx , tgx , qsfc1d , qsnowx ,& ! in/out : @@ -760,7 +746,7 @@ subroutine noahmpdrv_run & & zwtx , wax , wtx , wslakex , lfmassx , rtmassx,& ! in/out : & stmassx , woodx , stblcpx , fastcpx , xlaix ,xsaix ,& ! in/out : & cmx , chx , taussx ,& ! in/out : - & smcwtdx ,deeprechx, rechx , cpfac ,& ! in/out : + & smcwtdx ,deeprechx, rechx ,& ! in/out : & z0wrf ,& ! out & fsa , fsr , fira , fsh , ssoil , fcev ,& ! out : & fgev , fctr , ecan , etran , edir , trad ,& ! out : @@ -901,7 +887,7 @@ subroutine noahmpdrv_run & ! ssoil = -1.0 *ssoil call penman (sfctmp,sfcprs,chx,t2v,th2,prcp,fdown,ssoil, & - & cpfac,q2,q2sat,etp,snowng,frzgra,ffrozp,dqsdt2,emissi,fsno) + & q2,q2sat,etp,snowng,frzgra,ffrozp,dqsdt2,emissi,fsno) ep(i) = etp @@ -1170,7 +1156,7 @@ end subroutine transfer_mp_parameters !! 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, & + & q2,q2sat,etp,snowng,frzgra,ffrozp, & & dqsdt2,emissi_in,sncovr) ! etp is calcuated right after ssoil @@ -1181,12 +1167,11 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & implicit none logical, intent(in) :: snowng, frzgra real, intent(in) :: ch, dqsdt2,fdown,prcp,ffrozp, & - & q2, q2sat,ssoil,cpfac, sfcprs, sfctmp, & + & q2, q2sat,ssoil, sfcprs, sfctmp, & & t2v, th2,emissi_in,sncovr real, intent(out) :: etp real :: epsca,flx2,rch,rr,t24 real :: a, delta, fnet,rad,rho,emissi,elcp1,lvs - real :: elcpx real, parameter :: elcp = 2.4888e+3, lsubc = 2.501000e+6,cp = 1004.6 real, parameter :: lsubs = 2.83e+6, rd = 287.05, cph2o = 4.1855e+3 @@ -1200,12 +1185,11 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & ! prepare partial quantities for penman equation. ! ---------------------------------------------------------------------- emissi=emissi_in - elcpx = elcp / cpfac -! elcp1 = (1.0-sncovr)*elcpx + sncovr*elcpx*lsubs/lsubc +! elcp1 = (1.0-sncovr)*elcp + sncovr*elcp*lsubs/lsubc lvs = (1.0-sncovr)*lsubc + sncovr*lsubs flx2 = 0.0 - delta = elcpx * dqsdt2 + delta = elcp * dqsdt2 ! delta = elcp1 * dqsdt2 t24 = sfctmp * sfctmp * sfctmp * sfctmp rr = t24 * 6.48e-8 / (sfcprs * ch) + 1.0 @@ -1216,7 +1200,7 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & ! adjust the partial sums / products with the latent heat ! effects caused by falling precipitation. ! ---------------------------------------------------------------------- - rch = rho * cp * cpfac * ch + rch = rho * cp * ch if (.not. snowng) then if (prcp > 0.0) rr = rr + cph2o * prcp / rch else @@ -1239,7 +1223,7 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & ! ---------------------------------------------------------------------- end if rad = fnet / rch + th2- sfctmp - a = elcpx * (q2sat - q2) + a = elcp * (q2sat - q2) ! a = elcp1 * (q2sat - q2) epsca = (a * rr + rad * delta) / (delta + rr) etp = epsca * rch / lsubc diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 066bc1e87..1fdee7a4a 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -325,14 +325,6 @@ type = logical intent = in optional = F -[lheatstrg] - standard_name = flag_for_canopy_heat_storage - long_name = flag for canopy heat storage parameterization - units = flag - dimensions = () - type = logical - intent = in - optional = F [idveg] standard_name = flag_for_dynamic_vegetation_option long_name = choice for dynamic vegetation option (see noahmp module for definition) diff --git a/physics/sflx.f b/physics/sflx.f index 6a5914d02..770a9d56e 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -172,7 +172,6 @@ subroutine gfssflx &! --- input ! consolidated constents/parameters by using ! ! module physcons, and added program documentation! ! sep 2009 -- s. moorthi minor fixes ! -! nov 2018 -- j. han add canopy heat storage parameterization ! ! ! ! ==================== defination of variables ==================== ! ! ! @@ -345,12 +344,6 @@ subroutine gfssflx &! --- input integer :: ice, k, kz ! -! --- parameters for heat storage parametrization -! - real (kind=kind_phys) :: cpx, cpx1, cpfac, xx1, xx2 - real (kind=kind_phys), parameter :: z0min=0.2_kind_phys, & - & z0max=1.0_kind_phys -! !===> ... begin here ! ! --- ... initialization @@ -681,7 +674,11 @@ subroutine gfssflx &! --- input !! overlying green canopy, adapted from section 2.1.2 of !! \cite peters-lidard_et_al_1997. !wz only urban for igbp type - if(ivegsrc == 1 .and. vegtyp == 13) then +! +!jhan urban canopy heat storage effect is included in pbl scheme +! + if((.not.lheatstrg) .and. & + & (ivegsrc == 1 .and. vegtyp == 13)) then df1 = 3.24*(1.-shdfac) + shdfac*df1*exp(sbeta*shdfac) else df1 = df1 * exp( sbeta*shdfac ) @@ -811,22 +808,6 @@ subroutine gfssflx &! --- input fdown = swnet + lwdn endif ! end if_couple_block -! -! --- enhance cp as a function of z0 to mimic heat storage -! - cpx = cp - cpx1 = cp1 - cpfac = 1.0 - if (lheatstrg) then - if ((ivegsrc == 1 .and. vegtyp /= 13) - & .or. ivegsrc == 2) then - xx1 = (z0 - z0min) / (z0max - z0min) - xx2 = 1.0 + min(max(xx1, 0.0), 1.0) - cpx = cp * xx2 - cpx1 = cp1 * xx2 - cpfac = cp / cpx - endif - endif !> - Call penman() to calculate potential evaporation (\a etp), !! and other partial products and sums for later @@ -835,7 +816,7 @@ subroutine gfssflx &! --- input call penman ! --- inputs: ! ! ( sfctmp, sfcprs, sfcems, ch, t2v, th2, prcp, fdown, ! -! cpx, cpfac, ssoil, q2, q2sat, dqsdt2, snowng, frzgra, ! +! ssoil, q2, q2sat, dqsdt2, snowng, frzgra, ! ! --- outputs: ! ! t24, etp, rch, epsca, rr, flx2 ) ! @@ -850,7 +831,7 @@ subroutine gfssflx &! --- input call canres ! --- inputs: ! ! ( nsoil, nroot, swdn, ch, q2, q2sat, dqsdt2, sfctmp, ! -! cpx1, sfcprs, sfcems, sh2o, smcwlt, smcref, zsoil, rsmin, ! +! sfcprs, sfcems, sh2o, smcwlt, smcref, zsoil, rsmin, ! ! rsmax, topt, rgl, hs, xlai, ! ! --- outputs: ! ! rc, pc, rcs, rct, rcq, rcsoil ) ! @@ -872,7 +853,7 @@ subroutine gfssflx &! --- input ! smcdry, cmcmax, dt, shdfac, sbeta, sfctmp, sfcems, ! ! t24, th2, fdown, epsca, bexp, pc, rch, rr, cfactr, ! ! slope, kdt, frzx, psisat, zsoil, dksat, dwsat, ! -! zbot, ice, rtdis, quartz, fxexp, csoil, ! +! zbot, ice, rtdis, quartz, fxexp, csoil, lheatstrg, ! ! --- input/outputs: ! ! cmc, t1, stc, sh2o, tbot, ! ! --- outputs: ! @@ -888,7 +869,7 @@ subroutine gfssflx &! --- input ! cmcmax, dt, df1, sfcems, sfctmp, t24, th2, fdown, epsca, ! ! bexp, pc, rch, rr, cfactr, slope, kdt, frzx, psisat, ! ! zsoil, dwsat, dksat, zbot, shdfac, ice, rtdis, quartz, ! -! fxexp, csoil, flx2, snowng, ! +! fxexp, csoil, flx2, snowng, lheatstrg, ! ! --- input/outputs: ! ! prcp1, cmc, t1, stc, sncovr, sneqv, sndens, snowh, ! ! sh2o, tbot, beta, ! @@ -1074,7 +1055,7 @@ end subroutine alcalc subroutine canres ! --- inputs: ! & ( nsoil, nroot, swdn, ch, q2, q2sat, dqsdt2, sfctmp, & -! & cpx1, sfcprs, sfcems, sh2o, smcwlt, smcref, zsoil, rsmin, & +! & sfcprs, sfcems, sh2o, smcwlt, smcref, zsoil, rsmin, & ! & rsmax, topt, rgl, hs, xlai, & ! --- outputs: ! & rc, pc, rcs, rct, rcq, rcsoil & @@ -1107,7 +1088,6 @@ subroutine canres ! q2sat - real, sat. air humidity at 1st level abv ground 1 ! ! dqsdt2 - real, slope of sat. humidity function wrt temp 1 ! ! sfctmp - real, sfc temperature at 1st level above ground 1 ! -! cpx1 - real, enhanced air heat capacity for heat storage 1 ! ! sfcprs - real, sfc pressure 1 ! ! sfcems - real, sfc emissivity for lw radiation 1 ! ! sh2o - real, volumetric soil moisture nsoil ! @@ -1213,8 +1193,8 @@ subroutine canres ! evaporation (containing rc term). rc = rsmin / (xlai*rcs*rct*rcq*rcsoil) - rr = (4.0*sfcems*sigma1*rd1/cpx1) * (sfctmp**4.0)/(sfcprs*ch) + 1.0 - delta = (lsubc/cpx1) * dqsdt2 + rr = (4.0*sfcems*sigma1*rd1/cp1) * (sfctmp**4.0)/(sfcprs*ch) + 1.0 + delta = (lsubc/cp1) * dqsdt2 pc = (rr + delta) / (rr*(1.0 + rc*ch) + delta) ! @@ -1299,7 +1279,7 @@ subroutine nopac ! & smcdry, cmcmax, dt, shdfac, sbeta, sfctmp, sfcems, & ! & t24, th2, fdown, epsca, bexp, pc, rch, rr, cfactr, & ! & slope, kdt, frzx, psisat, zsoil, dksat, dwsat, & -! & zbot, ice, rtdis, quartz, fxexp, csoil, & +! & zbot, ice, rtdis, quartz, fxexp, csoil, lheatstrg, & ! --- input/outputs: ! & cmc, t1, stc, sh2o, tbot, & ! --- outputs: @@ -1356,6 +1336,7 @@ subroutine nopac ! quartz - real, soil quartz content 1 ! ! fxexp - real, bare soil evaporation exponent 1 ! ! csoil - real, soil heat capacity 1 ! +! lheatstrg- logical, flag for canopy heat storage 1 ! ! ! ! input/outputs from and to the calling program: ! ! cmc - real, canopy moisture content 1 ! @@ -1393,6 +1374,8 @@ subroutine nopac ! & zsoil(nsoil), dksat, dwsat, zbot, rtdis(nsoil), & ! & quartz, fxexp, csoil +! logical, intent(in) :: lheatstrg + ! --- input/outputs: ! real (kind=kind_phys), intent(inout) :: cmc, t1, stc(nsoil), & ! & sh2o(nsoil), tbot @@ -1632,7 +1615,7 @@ subroutine penman ! --- ... prepare partial quantities for penman equation. - delta = elcp * cpfac * dqsdt2 + delta = elcp * dqsdt2 t24 = sfctmp * sfctmp * sfctmp * sfctmp rr = t24 * 6.48e-8 / (sfcprs*ch) + 1.0 rho = sfcprs / (rd1*t2v) @@ -1662,7 +1645,7 @@ subroutine penman ! --- ... finish penman equation calculations. rad = fnet/rch + th2 - sfctmp - a = elcp * cpfac * (q2sat - q2) + a = elcp * (q2sat - q2) epsca = (a*rr + rad*delta) / (delta + rr) etp = epsca * rch / lsubc ! @@ -2336,7 +2319,7 @@ subroutine snopac ! & cmcmax, dt, df1, sfcems, sfctmp, t24, th2, fdown, epsca, & ! & bexp, pc, rch, rr, cfactr, slope, kdt, frzx, psisat, & ! & zsoil, dwsat, dksat, zbot, shdfac, ice, rtdis, quartz, & -! & fxexp, csoil, flx2, snowng, & +! & fxexp, csoil, flx2, snowng, lheatstrg, & ! --- input/outputs: ! & prcp1, cmc, t1, stc, sncovr, sneqv, sndens, snowh, & ! & sh2o, tbot, beta, & @@ -2396,6 +2379,7 @@ subroutine snopac ! csoil - real, soil heat capacity 1 ! ! flx2 - real, freezing rain latent heat flux 1 ! ! snowng - logical, snow flag 1 ! +! lheatstrg- logical, flag for canopy heat storage 1 ! ! ! ! input/outputs from and to the calling program: ! ! prcp1 - real, effective precip 1 ! @@ -2442,6 +2426,7 @@ subroutine snopac ! & csoil, fxexp, flx2, zsoil(nsoil), rtdis(nsoil) ! logical, intent(in) :: snowng +! logical, intent(in) :: lheatstrg ! --- input/outputs: ! real (kind=kind_phys), intent(inout) :: prcp1, t1, sncovr, sneqv, & @@ -2758,6 +2743,7 @@ subroutine snopac ! --- inputs: & ( nsoil, smc, smcmax, dt, yy, zz1, zsoil, zbot, & & psisat, bexp, df1, ice, quartz, csoil, vegtyp, & + & shdfac, lheatstrg, & ! --- input/outputs: & stc, t11, tbot, sh2o, & ! --- outputs: @@ -3278,6 +3264,7 @@ subroutine shflx & ! --- inputs: & ( nsoil, smc, smcmax, dt, yy, zz1, zsoil, zbot, & & psisat, bexp, df1, ice, quartz, csoil, vegtyp, & + & shdfac, lheatstrg, & ! --- input/outputs: & stc, t1, tbot, sh2o, & ! --- outputs: @@ -3312,6 +3299,8 @@ subroutine shflx & ! quartz - real, soil quartz content 1 ! ! csoil - real, soil heat capacity 1 ! ! vegtyp - integer, vegtation type 1 ! +! shdfac - real, aeral coverage of green vegetation 1 ! +! lheatstrg- logical, flag for canopy heat storage 1 ! ! ! ! input/outputs: ! ! stc - real, soil temp nsoil ! @@ -3332,7 +3321,10 @@ subroutine shflx & integer, intent(in) :: nsoil, ice, vegtyp real (kind=kind_phys), intent(in) :: smc(nsoil), smcmax, dt, yy, & - & zz1, zsoil(nsoil), zbot, psisat, bexp, df1, quartz, csoil + & zz1, zsoil(nsoil), zbot, psisat, bexp, df1, quartz, csoil, & + & shdfac + + logical, intent(in) :: lheatstrg ! --- input/outputs: real (kind=kind_phys), intent(inout) :: stc(nsoil), t1, tbot, & @@ -3387,7 +3379,7 @@ subroutine shflx & ! --- inputs: & ( nsoil, stc, smc, smcmax, zsoil, yy, zz1, tbot, & & zbot, psisat, dt, bexp, df1, quartz, csoil,vegtyp, & - & shdfac, & + & shdfac, lheatstrg, & ! --- input/outputs: & sh2o, & ! --- outputs: @@ -4054,7 +4046,7 @@ subroutine hrt & ! --- inputs: & ( nsoil, stc, smc, smcmax, zsoil, yy, zz1, tbot, & & zbot, psisat, dt, bexp, df1, quartz, csoil, vegtyp, & - & shdfac, & + & shdfac, lheatstrg, & ! --- input/outputs: & sh2o, & ! --- outputs: @@ -4091,6 +4083,8 @@ subroutine hrt & ! quartz - real, soil quartz content 1 ! ! csoil - real, soil heat capacity 1 ! ! vegtyp - integer, vegetation type 1 ! +! shdfac - real, aeral coverage of green vegetation 1 ! +! lheatstrg- logical, flag for canopy heat storage 1 ! ! ! ! input/outputs: ! ! sh2o - real, unfrozen soil moisture nsoil ! @@ -4110,6 +4104,8 @@ subroutine hrt & & smcmax, zsoil(nsoil), yy, zz1, tbot, zbot, psisat, dt, & & bexp, df1, quartz, csoil, shdfac + logical, intent(in) :: lheatstrg + ! --- input/outputs: real (kind=kind_phys), intent(inout) :: sh2o(nsoil) @@ -4131,8 +4127,11 @@ subroutine hrt & ! csoil_loc=csoil - if (ivegsrc == 1)then + if (.not.lheatstrg .and. ivegsrc == 1)then !urban +! +!jhan urban canopy heat storage effect is included in pbl scheme +! if( vegtyp == 13 ) then ! csoil_loc=3.0e6 csoil_loc=3.0e6*(1.-shdfac)+csoil*shdfac ! gvf @@ -4225,7 +4224,7 @@ subroutine hrt & call snksrc & ! --- inputs: & ( nsoil, 1, tavg, smc(1), smcmax, psisat, bexp, dt, & - & qtot, zsoil, shdfac, & + & qtot, zsoil, & ! --- input/outputs: & sh2o(1), & ! --- outputs: @@ -4271,7 +4270,11 @@ subroutine hrt & ! if ( vegtyp == 13 ) df1n = 3.24 ! endif !wz only urban for igbp type - if(ivegsrc == 1 .and. vegtyp == 13) then +! +!jhan urban canopy heat storage effect is included in pbl scheme +! + if((.not.lheatstrg) .and. + & (ivegsrc == 1 .and. vegtyp == 13)) then df1n = 3.24*(1.-shdfac) + shdfac*df1n endif @@ -4315,7 +4318,11 @@ subroutine hrt & ! if ( vegtyp == 13 ) df1n = 3.24 ! endif !wz only urban for igbp type - if(ivegsrc == 1 .and. vegtyp == 13) then +! +!jhan urban canopy heat storage effect is included in pbl scheme +! + if((.not.lheatstrg) .and. + & (ivegsrc == 1 .and. vegtyp == 13)) then df1n = 3.24*(1.-shdfac) + shdfac*df1n endif @@ -4371,7 +4378,7 @@ subroutine hrt & call snksrc & ! --- inputs: & ( nsoil, k, tavg, smc(k), smcmax, psisat, bexp, dt, & - & qtot, zsoil, shdfac, & + & qtot, zsoil, & ! --- input/outputs: & sh2o(k), & ! --- outputs: @@ -4786,7 +4793,7 @@ end subroutine rosr12 subroutine snksrc & ! --- inputs: & ( nsoil, k, tavg, smc, smcmax, psisat, bexp, dt, & - & qtot, zsoil, shdfac, & + & qtot, zsoil, & ! --- input/outputs: & sh2o, & ! --- outputs: @@ -4831,7 +4838,7 @@ subroutine snksrc & integer, intent(in) :: nsoil, k real (kind=kind_phys), intent(in) :: tavg, smc, smcmax, psisat, & - & bexp, dt, qtot, zsoil(nsoil), shdfac + & bexp, dt, qtot, zsoil(nsoil) ! --- input/outputs: real (kind=kind_phys), intent(inout) :: sh2o @@ -4844,15 +4851,6 @@ subroutine snksrc & ! --- external functions: ! real (kind=kind_phys) :: frh2o - -!urban -! if (ivegsrc == 1)then -! if ( vegtyp == 13 ) df1=3.24 -! endif -!wz only urban for igbp type - if(ivegsrc == 1 .and. vegtyp == 13) then - df1 = 3.24*(1.-shdfac) + shdfac*df1 - endif ! !===> ... begin here ! From 0e0c20ef41b0308189a92ca5832a8441b2e2659a Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Mon, 20 Apr 2020 02:49:57 +0000 Subject: [PATCH 081/141] fix ustar --- physics/sfc_diff.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 3427fbb75..4312796e9 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -228,7 +228,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) ztmax = z0max * exp( - czilc * ca - & * 258.2 * sqrt(ustar(i,1)*z0max) ) + & * 258.2 * sqrt(ustar_lnd(i,1)*z0max) ) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land @@ -272,7 +272,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) ztmax = z0max * exp( - czilc * ca - & * 258.2 * sqrt(ustar(i,1)*z0max) ) + & * 258.2 * sqrt(ustar_ice(i,1)*z0max) ) ztmax = max(ztmax, 1.0e-6) ! From 69d3298764a4089028835475a7bcf8bcdcfcca56 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Mon, 20 Apr 2020 03:48:34 +0000 Subject: [PATCH 082/141] fix syntax error in ccpp --- physics/sfc_diff.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 4312796e9..c2ebf8257 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -228,7 +228,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) ztmax = z0max * exp( - czilc * ca - & * 258.2 * sqrt(ustar_lnd(i,1)*z0max) ) + & * 258.2 * sqrt(ustar_lnd(i)*z0max) ) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land @@ -272,7 +272,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) ztmax = z0max * exp( - czilc * ca - & * 258.2 * sqrt(ustar_ice(i,1)*z0max) ) + & * 258.2 * sqrt(ustar_ice(i)*z0max) ) ztmax = max(ztmax, 1.0e-6) ! From 0ef2dbac3fcbffc0d5d05d1b0a9b3d0439054f91 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Mon, 20 Apr 2020 18:26:22 +0000 Subject: [PATCH 083/141] tweak update: (1) slightly reduce high RH bias at 700 mb, (2) allow subsidence to impact momentum whenever bl_mynn_edmf_mom > 0 --- physics/module_bl_mynn.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 4c1468797..2922ee807 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -6016,7 +6016,7 @@ SUBROUTINE DMP_mf( & !Reminder: w is limited to be non-negative (above) aratio = MIN(UPA(K-1,I)/(1.-UPA(K-1,I)), 0.5) !limit should never get hit detturb = 0.00008 - oow = -0.064/MAX(1.0,(0.5*(Wn+UPW(K-1,I)))) !coef for dynamical detrainment rate + oow = -0.060/MAX(1.0,(0.5*(Wn+UPW(K-1,I)))) !coef for dynamical detrainment rate detrate = MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0004) ! dynamical detrainment rate (m^-1) detrateUV= MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0001) ! dynamical detrainment rate (m^-1) envm_thl(k)=envm_thl(k) + (0.5*(thl_ent + UPTHL(K-1,I)) - thl(k))*detrate*aratio*dzp @@ -6276,7 +6276,7 @@ SUBROUTINE DMP_mf( & det_sqv(k)=Cdet*(envm_sqv(k)-qv(k))*envi_a(k)*Psig_w det_sqc(k)=Cdet*(envm_sqc(k)-qc(k))*envi_a(k)*Psig_w ENDDO - IF (momentum_opt > 1) THEN + IF (momentum_opt > 0) THEN sub_u(kts)=0.5*envi_w(kts)*envi_a(kts)*(u(kts+1)-u(kts))/dzi(kts) sub_v(kts)=0.5*envi_w(kts)*envi_a(kts)*(v(kts+1)-v(kts))/dzi(kts) DO k=KTS+1,KTE-1 From a66d980301d4e62dd9c92f31a3bd92b8ed0939ea Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 20 Apr 2020 09:53:54 -0600 Subject: [PATCH 084/141] Remove CCPP dynamic build from physics --- CMakeLists.txt | 53 ++++++---------------------- pgifix.py | 93 -------------------------------------------------- 2 files changed, 11 insertions(+), 135 deletions(-) delete mode 100755 pgifix.py diff --git a/CMakeLists.txt b/CMakeLists.txt index 9765fa25e..7bd357d46 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -19,7 +19,7 @@ endif(POLICY CMP0042) #------------------------------------------------------------------------------ set(PACKAGE "ccpp-physics") -set(AUTHORS "Grant J. Firl" "Dom Heinzeller") +set(AUTHORS "Grant Firl" "Dom Heinzeller" "Man Zhang" "Laurie Carson") #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran @@ -58,12 +58,8 @@ if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) endif() #------------------------------------------------------------------------------ -# By default we want a shared library (unless a static build is requested) -if(STATIC) - option(BUILD_SHARED_LIBS "Build a static library" OFF) -else(STATIC) - option(BUILD_SHARED_LIBS "Build a shared library" ON) -endif(STATIC) +# Request a static build +option(BUILD_SHARED_LIBS "Build a shared library" OFF) #------------------------------------------------------------------------------ # Set the sources: physics type definitions @@ -327,45 +323,18 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") endif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") #------------------------------------------------------------------------------ -if(STATIC) - add_library(ccppphys STATIC ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) - # Generate list of Fortran modules from defined sources - foreach(source_f90 ${CAPS}) - 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() -else(STATIC) - add_library(ccppphys SHARED ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) -endif(STATIC) - -if (NOT STATIC) - target_link_libraries(ccppphys LINK_PUBLIC ${LIBS} ${BACIO_LIB4} ${SP_LIBd} ${W3NCO_LIBd}) -endif (NOT STATIC) +add_library(ccppphys STATIC ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) +# Generate list of Fortran modules from defined sources +foreach(source_f90 ${CAPS}) + 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() set_target_properties(ccppphys PROPERTIES VERSION ${PROJECT_VERSION} SOVERSION ${PROJECT_VERSION_MAJOR}) -# DH* Hack for PGI compiler: rename objects in scheme cap object files for ISO_C compliancy, -# this is only needed for dynamics builds - static build generates plain Fortran code. -if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") - if (NOT STATIC) - set(CAPOBJS) - foreach(cap ${CAPS}) - string(REPLACE "_cap.F90" "_cap.F90.o" capobj "./${CMAKE_FILES_DIRECTORY}/ccppphys.dir/${cap}") - list(APPEND CAPOBJS ${capobj}) - endforeach(cap) - - add_custom_command(TARGET ccppphys - PRE_LINK - COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/pgifix.py --cmake ${CAPOBJS} - WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} - COMMENT "Running pgifix_wrapper.py over all scheme caps") - endif (NOT STATIC) -endif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") -# *DH end hack for PGI compiler - if (PROJECT STREQUAL "CCPP-FV3") # Define where to install the library install(TARGETS ccppphys diff --git a/pgifix.py b/pgifix.py deleted file mode 100755 index cc6af76d2..000000000 --- a/pgifix.py +++ /dev/null @@ -1,93 +0,0 @@ -#!/usr/bin/env python - -import argparse -import os -import subprocess -import sys - -parser = argparse.ArgumentParser(description='Fix cap objects produced by PGI compiler') -parser.add_argument("--cmake", default=False, action='store_true') -parser.add_argument("caps", nargs='+') - -FIXCMD_TEMPLATE = 'objcopy ' - -def parse_args(): - args = parser.parse_args() - cmake = args.cmake - caps = args.caps - return (cmake, caps) - -def execute(cmd, debug = True, abort = True): - """Runs a local command in a shell. Waits for completion and - returns status, stdout and stderr. If abort = True, abort in - case an error occurs during the execution of the command.""" - - if debug: - print 'Executing "{0}"'.format(cmd) - p = subprocess.Popen(cmd, stdout = subprocess.PIPE, - stderr = subprocess.PIPE, shell = True) - (stdout, stderr) = p.communicate() - status = p.returncode - if debug: - message = 'Execution of "{0}" returned with exit code {1}\n'.format(cmd, status) - message += ' stdout: "{0}"\n'.format(stdout.rstrip('\n')) - message += ' stderr: "{0}"'.format(stderr.rstrip('\n')) - print message - if not status == 0: - message = 'Execution of command {0} failed, exit code {1}\n'.format(cmd, status) - message += ' stdout: "{0}"\n'.format(stdout.rstrip('\n')) - message += ' stderr: "{0}"'.format(stderr.rstrip('\n')) - if abort: - raise Exception(message) - else: - print message - return (status, stdout.rstrip('\n'), stderr.rstrip('\n')) - -def correct_cap_object_names(fixcmd, cmake, cap): - (cappath, capname) = os.path.split(cap) - # Determine pgi-prepended prefix to remove, different - # for cmake builds and make builds (object filename) - if cmake: - pgiprefix = capname.rstrip('.F90.o').lower() + '_' - else: - pgiprefix = capname.rstrip('.o').lower() + '_' - # Get list of all symbols in cap object - nmcmd = 'nm {0}'.format(cap) - (status, stdout, stderr) = execute(nmcmd) - del nmcmd - # Parse all symbols and generate objcopy command - found = False - for line in stdout.split('\n'): - try: - (address, symboltype, objectname) = line.split() - except ValueError: - continue - if not symboltype == 'T': - continue - if objectname.startswith(pgiprefix): - newname = objectname[len(pgiprefix):] - else: - continue - if newname.endswith('_cap'): - fixcmd += '--redefine-sym {0}={1} '.format(objectname, newname) - found = True - if not found: - raise Exception('Unable to rename CCPP scheme caps in cap "{0}"'.format(cap)) - return fixcmd - -def correct_object_names(fixcmd, cap): - tmp = cap + '.tmp' - fixcmd += '{0} {1}'.format(cap, tmp) - execute(fixcmd) - mvcmd = 'mv -v {0} {1}'.format(tmp, cap) - execute(mvcmd) - -def main(): - (cmake, caps) = parse_args() - for cap in caps: - fixcmd = FIXCMD_TEMPLATE - fixcmd = correct_cap_object_names(fixcmd, cmake, cap) - correct_object_names(fixcmd, cap) - -if __name__ == '__main__': - main() From fc840f4f0fa9d7c37ee88dc1c8940121d93cd5e6 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Tue, 21 Apr 2020 02:49:55 +0000 Subject: [PATCH 085/141] update sflx.f --- physics/sflx.f | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/physics/sflx.f b/physics/sflx.f index 770a9d56e..a0127d844 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -677,7 +677,7 @@ subroutine gfssflx &! --- input ! !jhan urban canopy heat storage effect is included in pbl scheme ! - if((.not.lheatstrg) .and. & + if((.not.lheatstrg) .and. & & (ivegsrc == 1 .and. vegtyp == 13)) then df1 = 3.24*(1.-shdfac) + shdfac*df1*exp(sbeta*shdfac) else @@ -1337,6 +1337,7 @@ subroutine nopac ! fxexp - real, bare soil evaporation exponent 1 ! ! csoil - real, soil heat capacity 1 ! ! lheatstrg- logical, flag for canopy heat storage 1 ! +! parameterization ! ! ! ! input/outputs from and to the calling program: ! ! cmc - real, canopy moisture content 1 ! @@ -1505,7 +1506,11 @@ subroutine nopac ! sub sfc heat flux (see additional comments on veg effect ! sub-sfc heat flx in routine sflx) !wz only urban for igbp type - if(ivegsrc == 1 .and. vegtyp == 13) then +! +!jhan urban canopy heat storage effect is included in pbl scheme +! + if((.not.lheatstrg) .and. & + & (ivegsrc == 1 .and. vegtyp == 13)) then df1 = 3.24*(1.-shdfac) + shdfac*df1*exp(sbeta*shdfac) else df1 = df1 * exp( sbeta*shdfac ) @@ -1522,6 +1527,7 @@ subroutine nopac ! --- inputs: & ( nsoil, smc, smcmax, dt, yy, zz1, zsoil, zbot, & & psisat, bexp, df1, ice, quartz, csoil, vegtyp, & + & shdfac, lheatstrg, & ! --- input/outputs: & stc, t1, tbot, sh2o, & ! --- outputs: @@ -1550,7 +1556,7 @@ subroutine penman !................................... ! --- inputs: ! & ( sfctmp, sfcprs, sfcems, ch, t2v, th2, prcp, fdown, & -! & cpx, cpfac, ssoil, q2, q2sat, dqsdt2, snowng, frzgra, & +! & ssoil, q2, q2sat, dqsdt2, snowng, frzgra, & ! --- outputs: ! & t24, etp, rch, epsca, rr, flx2 & ! & ) @@ -1576,8 +1582,6 @@ subroutine penman ! th2 - real, air potential temp at zlvl abv grnd 1 ! ! prcp - real, precip rate 1 ! ! fdown - real, net solar + downward lw flux at sfc 1 ! -! cpx - real, enhanced air heat capacity for heat storage 1 ! -! cpfac - real, ratio air heat capacity to enhanced one 1 ! ! ssoil - real, upward soil heat flux 1 ! ! q2 - real, mixing ratio at hght zlvl abv ground 1 ! ! q2sat - real, sat mixing ratio at zlvl abv ground 1 ! @@ -1619,7 +1623,7 @@ subroutine penman t24 = sfctmp * sfctmp * sfctmp * sfctmp rr = t24 * 6.48e-8 / (sfcprs*ch) + 1.0 rho = sfcprs / (rd1*t2v) - rch = rho * cpx * ch + rch = rho * cp * ch ! --- ... adjust the partial sums / products with the latent heat ! effects caused by falling precipitation. @@ -2379,7 +2383,8 @@ subroutine snopac ! csoil - real, soil heat capacity 1 ! ! flx2 - real, freezing rain latent heat flux 1 ! ! snowng - logical, snow flag 1 ! -! lheatstrg- logical, flag for canopy heat storage 1 ! +! lheatstrg- logical, flag for canopy heat storage 1 ! +! parameterization ! ! ! ! input/outputs from and to the calling program: ! ! prcp1 - real, effective precip 1 ! @@ -3301,6 +3306,7 @@ subroutine shflx & ! vegtyp - integer, vegtation type 1 ! ! shdfac - real, aeral coverage of green vegetation 1 ! ! lheatstrg- logical, flag for canopy heat storage 1 ! +! parameterization ! ! ! ! input/outputs: ! ! stc - real, soil temp nsoil ! @@ -4085,6 +4091,7 @@ subroutine hrt & ! vegtyp - integer, vegetation type 1 ! ! shdfac - real, aeral coverage of green vegetation 1 ! ! lheatstrg- logical, flag for canopy heat storage 1 ! +! parameterization ! ! ! ! input/outputs: ! ! sh2o - real, unfrozen soil moisture nsoil ! From 8056b688022d6cf1fb2b607722561c31976ebd2f Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Tue, 21 Apr 2020 14:28:01 +0000 Subject: [PATCH 086/141] Bug fix: (1) ambiguous conditional for defining Fng, (2) alleviate excessive detrainment problem for coarse vertical resolution. --- physics/module_bl_mynn.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 2922ee807..20a169c3a 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -2770,9 +2770,9 @@ SUBROUTINE mym_condensation (kts,kte, & Q1(k)=MAX(Q1(k),-5.0) IF (Q1(k) .GE. 1.0) THEN Fng = 1.0 - ELSEIF (Q1(k) .GE. -1.7 .AND. Q1(k) < 1.0) THEN + ELSEIF (Q1(k) .GE. -1.7 .AND. Q1(k) .LT. 1.0) THEN Fng = EXP(-0.4*(Q1(k)-1.0)) - ELSEIF (Q1(k) .GE. -2.5 .AND. Q1(k) .LE. -1.7) THEN + ELSEIF (Q1(k) .GE. -2.5 .AND. Q1(k) .LT. -1.7) THEN Fng = 3.0 + EXP(-3.8*(Q1(k)+1.7)) ELSE Fng = MIN(23.9 + EXP(-1.6*(Q1(k)+2.5)), 60.) @@ -6017,21 +6017,21 @@ SUBROUTINE DMP_mf( & aratio = MIN(UPA(K-1,I)/(1.-UPA(K-1,I)), 0.5) !limit should never get hit detturb = 0.00008 oow = -0.060/MAX(1.0,(0.5*(Wn+UPW(K-1,I)))) !coef for dynamical detrainment rate - detrate = MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0004) ! dynamical detrainment rate (m^-1) + detrate = MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0003) ! dynamical detrainment rate (m^-1) detrateUV= MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0001) ! dynamical detrainment rate (m^-1) - envm_thl(k)=envm_thl(k) + (0.5*(thl_ent + UPTHL(K-1,I)) - thl(k))*detrate*aratio*dzp + envm_thl(k)=envm_thl(k) + (0.5*(thl_ent + UPTHL(K-1,I)) - thl(k))*detrate*aratio*MIN(dzp,300.) qv_ent = 0.5*(MAX(qt_ent-qc_ent,0.) + MAX(UPQT(K-1,I)-UPQC(K-1,I),0.)) - envm_sqv(k)=envm_sqv(k) + (qv_ent-QV(K))*detrate*aratio*dzp + envm_sqv(k)=envm_sqv(k) + (qv_ent-QV(K))*detrate*aratio*MIN(dzp,300.) IF (UPQC(K-1,I) > 1E-8) THEN IF (QC(K) > 1E-6) THEN qc_grid = QC(K) ELSE qc_grid = cldfra_bl1d(k)*qc_bl1d(K) ENDIF - envm_sqc(k)=envm_sqc(k) + MAX(UPA(K-1,I)*0.5*(QCn + UPQC(K-1,I)) - qc_grid, 0.0)*detrate*aratio*dzp + envm_sqc(k)=envm_sqc(k) + MAX(UPA(K-1,I)*0.5*(QCn + UPQC(K-1,I)) - qc_grid, 0.0)*detrate*aratio*MIN(dzp,300.) ENDIF - envm_u(k) =envm_u(k) + (0.5*(Un + UPU(K-1,I)) - U(K))*detrateUV*aratio*dzp - envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*dzp + envm_u(k) =envm_u(k) + (0.5*(Un + UPU(K-1,I)) - U(K))*detrateUV*aratio*MIN(dzp,300.) + envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*MIN(dzp,300.) IF (Wn > 0.) THEN !Update plume variables at current k index @@ -6419,9 +6419,9 @@ SUBROUTINE DMP_mf( & Q1=MAX(Q1,-5.0) IF (Q1 .GE. 1.0) THEN Fng = 1.0 - ELSEIF (Q1 .GE. -1.7 .AND. Q1 < 1.0) THEN + ELSEIF (Q1 .GE. -1.7 .AND. Q1 .LT. 1.0) THEN Fng = EXP(-0.4*(Q1-1.0)) - ELSEIF (Q1 .GE. -2.5 .AND. Q1 .LE. -1.7) THEN + ELSEIF (Q1 .GE. -2.5 .AND. Q1 .LT. -1.7) THEN Fng = 3.0 + EXP(-3.8*(Q1+1.7)) ELSE Fng = MIN(23.9 + EXP(-1.6*(Q1+2.5)), 60.) From 8c47bbf44964df570d0f999f670d8d5dd424a741 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 21 Apr 2020 16:41:05 -0600 Subject: [PATCH 087/141] Add missing code updates from IPD GFS_physics_driver.F90 to CCPP --- physics/GFS_PBL_generic.F90 | 66 +++++++++++++-- physics/GFS_PBL_generic.meta | 125 ++++++++++++++++++++++++++++ physics/gcm_shoc.meta | 4 +- physics/module_MYJPBL_wrapper.meta | 4 +- physics/module_MYNNPBL_wrapper.meta | 4 +- physics/moninedmf.meta | 4 +- physics/moninedmf_hafs.meta | 4 +- physics/moninshoc.meta | 4 +- physics/satmedmfvdif.meta | 4 +- physics/satmedmfvdifq.meta | 4 +- physics/sflx.f | 2 + physics/shalcnv.meta | 4 +- physics/shinhongvdif.meta | 4 +- physics/ysuvdif.meta | 4 +- 14 files changed, 206 insertions(+), 31 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index ff59aa465..c99908014 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -84,7 +84,8 @@ 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, errmsg, errflg) + hybedmf, do_shoc, satmedmf, qgrs, vdftra, lheatstrg, z0fac, e0fac, zorl, & + u10m, v10m, hflx, evap, hflxq, evapq, hffac, hefac, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -102,11 +103,25 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra + ! For canopy heat storage + logical, intent(in) :: lheatstrg + real(kind=kind_phys), intent(in) :: z0fac, e0fac + real(kind=kind_phys), dimension(im), intent(in) :: zorl, u10m, v10m + real(kind=kind_phys), dimension(im), intent(in) :: hflx, evap + real(kind=kind_phys), dimension(im), intent(out) :: hflxq, evapq + real(kind=kind_phys), dimension(im), intent(out) :: hffac, hefac + + ! CCPP error handling variables character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - !local variables + ! Parameters for canopy heat storage parametrization + real (kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 + real (kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 + + ! Local variables integer :: i, k, kk, k1, n + real(kind=kind_phys) :: tem, tem1, tem2 ! Initialize CCPP error handling variables errmsg = '' @@ -258,6 +273,35 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ! endif +! --- ... Boundary Layer and Free atmospheic turbulence parameterization +! +! in order to achieve heat storage within canopy layer, in the canopy heat +! storage parameterization the kinematic sensible and latent heat fluxes +! (hflx & evap) as surface boundary forcings to the pbl scheme are +! reduced as a function of surface roughness +! + do i=1,im + hflxq(i) = hflx(i) + evapq(i) = evap(i) + hffac(i) = 1.0 + hefac(i) = 1.0 + enddo + if (lheatstrg) then + do i=1,im + tem = 0.01 * zorl(i) ! change unit from cm to m + tem1 = (tem - z0min) / (z0max - z0min) + hffac(i) = z0fac * min(max(tem1, 0.0), 1.0) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem1 = (tem - u10min) / (u10max - u10min) + tem2 = 1.0 - min(max(tem1, 0.0), 1.0) + hffac(i) = tem2 * hffac(i) + hefac(i) = 1. + e0fac * hffac(i) + hffac(i) = 1. + hffac(i) + hflxq(i) = hflx(i) / hffac(i) + evapq(i) = evap(i) / hefac(i) + enddo + endif + end subroutine GFS_PBL_generic_pre_run end module GFS_PBL_generic_pre @@ -287,7 +331,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, hffac, hefac, & + errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -328,6 +373,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), dimension(:,:), intent(inout) :: dkt_cpl real(kind=kind_phys), dimension(:,:), intent(in) :: dkt + ! From canopy heat storage - reduction factors in latent/sensible heat flux due to surface roughness + real(kind=kind_phys), dimension(im), intent(in) :: hffac, hefac + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -523,8 +571,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, 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) + dtsfci_cpl(i) = dtsfc1(i)*hffac(i) + dqsfci_cpl(i) = dqsfc1(i)*hefac(i) endif ! dusfc_cpl (i) = dusfc_cpl(i) + dusfci_cpl(i) * dtf @@ -547,12 +595,12 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, do i=1,im dusfc_diag (i) = dusfc_diag(i) + dusfc1(i)*dtf dvsfc_diag (i) = dvsfc_diag(i) + dvsfc1(i)*dtf - dtsfc_diag (i) = dtsfc_diag(i) + dtsfc1(i)*dtf - dqsfc_diag (i) = dqsfc_diag(i) + dqsfc1(i)*dtf + dtsfc_diag (i) = dtsfc_diag(i) + dtsfc1(i)*hffac(i)*dtf + dqsfc_diag (i) = dqsfc_diag(i) + dqsfc1(i)*hefac(i)*dtf dusfci_diag(i) = dusfc1(i) dvsfci_diag(i) = dvsfc1(i) - dtsfci_diag(i) = dtsfc1(i) - dqsfci_diag(i) = dqsfc1(i) + dtsfci_diag(i) = dtsfc1(i)*hffac(i) + dqsfci_diag(i) = dqsfc1(i)*hefac(i) enddo if (ldiag3d) then diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 5f4362103..61429eec9 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -307,6 +307,113 @@ kind = kind_phys intent = inout optional = F +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical + intent = in + optional = F +[z0fac] + standard_name = surface_roughness_fraction_factor + long_name = surface roughness fraction factor for canopy heat storage parameterization + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[e0fac] + standard_name = latent_heat_flux_fraction_factor_relative_to_sensible_heat_flux + long_name = latent heat flux fraction factor relative to sensible heat flux for canopy heat storage parameterization + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + 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 = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx] + 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 +[hflxq] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[evapq] + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hefac] + standard_name = surface_upward_latent_heat_flux_reduction_factor + long_name = surface upward latent heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hffac] + standard_name = surface_upward_sensible_heat_flux_reduction_factor + long_name = surface upward sensible heat flux reduction factor from canopy heat storage + units = none + 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 @@ -1220,6 +1327,24 @@ kind = kind_phys intent = in optional = F +[hefac] + standard_name = surface_upward_latent_heat_flux_reduction_factor + long_name = surface upward latent heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hffac] + standard_name = surface_upward_sensible_heat_flux_reduction_factor + long_name = surface upward sensible heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index 07f014356..f4d2f3ae9 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -251,7 +251,7 @@ intent = in optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -260,7 +260,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index a70203def..dd2560e06 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -446,7 +446,7 @@ intent = inout optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -455,7 +455,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 27b186bd3..eb8fcb0fd 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -291,7 +291,7 @@ intent = out optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -300,7 +300,7 @@ intent = in optional = F [qflx] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 25fddea02..09abe71a0 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -244,7 +244,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -253,7 +253,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta index 13bf39396..d600c8eac 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -244,7 +244,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -253,7 +253,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 80d8f71fc..d5fd594ab 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -220,7 +220,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -229,7 +229,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index e127f14e5..c33e4b85f 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -357,7 +357,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -366,7 +366,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 4e9b05239..26667a627 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -357,7 +357,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -366,7 +366,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/sflx.f b/physics/sflx.f index a0127d844..2740a70ff 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -2431,7 +2431,9 @@ subroutine snopac ! & csoil, fxexp, flx2, zsoil(nsoil), rtdis(nsoil) ! logical, intent(in) :: snowng +! ! logical, intent(in) :: lheatstrg +! ! --- input/outputs: ! real (kind=kind_phys), intent(inout) :: prcp1, t1, sncovr, sneqv, & diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta index 533b9cd0e..e0d806a5c 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -358,7 +358,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -367,7 +367,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index e859fca4d..4ce047aa2 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -237,7 +237,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -246,7 +246,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index 12819dee5..fe18e6f45 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -264,7 +264,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -273,7 +273,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) From d7bcc47963c3bb4fa7483ad29345b5a5208d4ab2 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Wed, 22 Apr 2020 18:45:33 +0000 Subject: [PATCH 088/141] Bug fixes for uninitialized variables... --- physics/module_bl_mynn.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 20a169c3a..73a101a3f 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -6017,7 +6017,7 @@ SUBROUTINE DMP_mf( & aratio = MIN(UPA(K-1,I)/(1.-UPA(K-1,I)), 0.5) !limit should never get hit detturb = 0.00008 oow = -0.060/MAX(1.0,(0.5*(Wn+UPW(K-1,I)))) !coef for dynamical detrainment rate - detrate = MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0003) ! dynamical detrainment rate (m^-1) + detrate = MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0002) ! dynamical detrainment rate (m^-1) detrateUV= MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0001) ! dynamical detrainment rate (m^-1) envm_thl(k)=envm_thl(k) + (0.5*(thl_ent + UPTHL(K-1,I)) - thl(k))*detrate*aratio*MIN(dzp,300.) qv_ent = 0.5*(MAX(qt_ent-qc_ent,0.) + MAX(UPQT(K-1,I)-UPQC(K-1,I),0.)) @@ -6403,10 +6403,13 @@ SUBROUTINE DMP_mf( & Ac_mf = 0.5*(edmf_a(k)+edmf_a(k-1)) Ac_strat = cldfra_bl1d(k)*(1.0-Ac_mf) cldfra_bl1d(k)=Ac_mf + Ac_strat + qc_mf = QCp !Ensure stratus clouds have mixing ratio similar to cumulus QCs = MIN(MAX(qc_bl1d(k), 0.5*qc_mf), 5E-4) qc_bl1d(k) = (QCp*Ac_mf + QCs*Ac_strat)/cldfra_bl1d(k) ENDIF + ELSE + Ac_mf = mf_cf ENDIF !Now recalculate the terms for the buoyancy flux for mass-flux clouds: From f57b5c340aac31ab51bd746656e7fca28a950bb1 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Fri, 24 Apr 2020 20:43:22 +0000 Subject: [PATCH 089/141] add tsfcl change for CCPP --- physics/GFS_surface_composites.F90 | 2 ++ physics/ugwp_driver_v0.F | 21 +++++++++++---------- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 7cd552e69..30067976e 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -441,6 +441,7 @@ subroutine GFS_surface_composites_post_run ( fh2(i) = fh2_ocn(i) !tsurf(i) = tsurf_ocn(i) tsfco(i) = tsfc_ocn(i) ! over lake (and ocean when uncoupled) + if( cplflx ) tsfcl(i) = tsfc_ocn(i) ! for restart repro comparisons cmm(i) = cmm_ocn(i) chh(i) = chh_ocn(i) gflx(i) = gflx_ocn(i) @@ -482,6 +483,7 @@ subroutine GFS_surface_composites_post_run ( hflx(i) = hflx_ice(i) qss(i) = qss_ice(i) tsfc(i) = tsfc_ice(i) + if( cplflx ) tsfcl(i) = tsfc_ice(i) endif zorll(i) = zorl_lnd(i) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 4edd84a7a..866689f03 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -8,6 +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 + logical debugprint = .false. end module sso_coorde ! ! @@ -91,7 +92,7 @@ subroutine cires_ugwp_driver_v0(me, master, ! ! switches for GW-effects: pogw=1 (OGWs) pngw=1 (NGWs) pked=1 (eddy mixing) ! - if (me == master .and. kdt < 2) then + if (me == master .and. kdt < 2 .and. debugprint) then print * write(6,*) 'FV3GFS execute ugwp_driver_v0 ' ! write(6,*) 'FV3GFS execute ugwp_driver_v0 nmtvr=', nmtvr @@ -120,7 +121,7 @@ subroutine cires_ugwp_driver_v0(me, master, & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & du3dt_mtb, du3dt_ogw, du3dt_tms) ! - if (me == master .and. kdt < 2) then + if (me == master .and. kdt < 2 .and. debugprint) then print * write(6,*) 'FV3GFS finished gwdps_v0 in ugwp_driver_v0 ' print * @@ -192,7 +193,7 @@ subroutine cires_ugwp_driver_v0(me, master, & gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, & tau_ngw, me, master, kdt) - if (me == master .and. kdt < 2) then + if (me == master .and. kdt < 2 .and. debugprint) then print * write(6,*)'FV3GFS finished fv3_ugwp_v0 in ugwp_driver_v0 ' write(6,*) ' non-stationary GWs with GMAO/MERRA GW-forcing ' @@ -439,7 +440,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, kxridge = float(IMX)/arad * cdmbgwd(2) - if (me == master .and. kdt == 1) then + if (me == master .and. kdt == 1 .and. debugprint) then print *, ' gwdps_v0 kxridge ', kxridge print *, ' gwdps_v0 scale2 ', cdmbgwd(2) print *, ' gwdps_v0 IMX ', imx @@ -521,7 +522,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, endif enddo - IF (npt == 0) then + IF (npt == 0 .and. debugprint) then ! print *, 'oro-npt = 0 elvmax ', maxval(elvmaxd), hminmt ! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin RETURN ! No gwd/mb calculation done @@ -1060,7 +1061,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! --------------------------- IF( do_tofd ) then axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 - if ( kdt == 1 .and. me == 0) then + if ( kdt == 1 .and. me == 0 .and. debugprint) then print *, 'VAY do_tofd from surface to ', ztop_tofd endif DO I = 1,npt @@ -1164,7 +1165,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, !============ debug ------------------------------------------------ - if (kdt <= 2 .and. me == 0) then + if (kdt <= 2 .and. me == 0 .and. debugprint) then print *, 'vgw-oro done gwdps_v0 in ugwp-v0 step-proc ', kdt, me ! print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw_axoro' @@ -1411,7 +1412,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! rcpd = 1.0/(grav/cpd) ! 1/[g/cp] ! grav2cpd = grav*grav/cpd ! g*(g/cp)= g^2/cp - if (kdt ==1 .and. mpi_id == master) then + if (kdt ==1 .and. mpi_id == master .and. debugprint) then print *, maxval(tm1), minval(tm1), 'vgw: temp-res ' print *, 'ugwp-v0: zcimin=' , zcimin print *, 'ugwp-v0: zcimax=' , zcimax @@ -1839,7 +1840,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! !--------------------------------------------------------------------------- ! - if (kdt == 1 .and. mpi_id == master) then + if (kdt == 1 .and. mpi_id == master .and. debugprint) then print *, 'vgw done ' ! print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' @@ -1972,7 +1973,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ! 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 +! print *,' UGWP-V0 unstab PT(z) via gwdTdt ', bn2(k), k rineg = bn2(k)/shr2(k) bn2(k) = max(bn2(k), bnv2min) From 366404d1b3f10e3f7df4defd8b5e5e97634335ef Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Sat, 25 Apr 2020 19:58:26 +0000 Subject: [PATCH 090/141] fix synrax error --- physics/ugwp_driver_v0.F | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 866689f03..6dd03534a 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 - logical debugprint = .false. + logical,parameter :: debugprint = .false. end module sso_coorde ! ! @@ -34,7 +34,7 @@ subroutine cires_ugwp_driver_v0(me, master, 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 + use sso_coorde, only : pgwd, pgwd4, debugprint implicit none !input @@ -298,7 +298,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, &, n_tofd, ze_tofd, ztop_tofd use cires_ugwp_module, only : kxw, max_kdis, max_axyz - use sso_coorde, only : pgwd, pgwd4 + use sso_coorde, only : pgwd, pgwd4, debugprint !---------------------------------------- implicit none character(len=8) :: strsolver='PSS-1986' ! current operational solver or 'WAM-2017' @@ -1287,6 +1287,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, &, zci, zdci, zci4, zci3, zci2 &, zaz_fct, zcosang, zsinang &, nwav, nazd, zcimin, zcimax + + use sso_coorde, only : debugprint ! implicit none !23456 From d0c9248747a48f4634f8af5e0fba7993b2e124e5 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Tue, 28 Apr 2020 16:31:11 +0000 Subject: [PATCH 091/141] bug fix for restart applications --- physics/module_bl_mynn.F90 | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 73a101a3f..6be141d9c 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -4265,7 +4265,7 @@ SUBROUTINE mynn_bl_driver( & !! If true, a three-dimensional initialization loop is entered. Within this loop, !! several arrays are initialized and k-oriented (vertical) subroutines are called !! at every i and j point, corresponding to the x- and y- directions, respectively. - IF (initflag > 0) THEN + IF (initflag > 0 .and. .not.restart) THEN !Test to see if we want to initialize qke IF ( (restart .or. cycling)) THEN @@ -4290,6 +4290,10 @@ SUBROUTINE mynn_bl_driver( & cldfra_bl(its:ite,kts:kte,jts:jte)=0. qc_bl(its:ite,kts:kte,jts:jte)=0. qke(its:ite,kts:kte,jts:jte)=0. + else + qc_bl1D(kts:kte)=0.0 + qi_bl1D(kts:kte)=0.0 + cldfra_bl1D(kts:kte)=0.0 end if dqc1(kts:kte)=0.0 dqi1(kts:kte)=0.0 @@ -4298,9 +4302,6 @@ SUBROUTINE mynn_bl_driver( & dqnwfa1(kts:kte)=0.0 dqnifa1(kts:kte)=0.0 dozone1(kts:kte)=0.0 - qc_bl1D(kts:kte)=0.0 - qi_bl1D(kts:kte)=0.0 - cldfra_bl1D(kts:kte)=0.0 qc_bl1D_old(kts:kte)=0.0 cldfra_bl1D_old(kts:kte)=0.0 edmf_a1(kts:kte)=0.0 @@ -5575,6 +5576,7 @@ SUBROUTINE DMP_mf( & REAL :: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & detrateUV,oow,exc_fac,aratio,detturb,qc_grid REAL, PARAMETER :: Cdet = 1./45. + REAL, PARAMETER :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers !parameter "Csub" determines the propotion of upward vertical velocity that contributes to !environmenatal subsidence. Some portion is expected to be compensated by downdrafts instead of !gentle environmental subsidence. 1.0 assumes all upward vertical velocity in the mass-flux scheme @@ -6019,19 +6021,19 @@ SUBROUTINE DMP_mf( & oow = -0.060/MAX(1.0,(0.5*(Wn+UPW(K-1,I)))) !coef for dynamical detrainment rate detrate = MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0002) ! dynamical detrainment rate (m^-1) detrateUV= MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0001) ! dynamical detrainment rate (m^-1) - envm_thl(k)=envm_thl(k) + (0.5*(thl_ent + UPTHL(K-1,I)) - thl(k))*detrate*aratio*MIN(dzp,300.) + envm_thl(k)=envm_thl(k) + (0.5*(thl_ent + UPTHL(K-1,I)) - thl(k))*detrate*aratio*MIN(dzp,dzpmax) qv_ent = 0.5*(MAX(qt_ent-qc_ent,0.) + MAX(UPQT(K-1,I)-UPQC(K-1,I),0.)) - envm_sqv(k)=envm_sqv(k) + (qv_ent-QV(K))*detrate*aratio*MIN(dzp,300.) + envm_sqv(k)=envm_sqv(k) + (qv_ent-QV(K))*detrate*aratio*MIN(dzp,dzpmax) IF (UPQC(K-1,I) > 1E-8) THEN IF (QC(K) > 1E-6) THEN qc_grid = QC(K) ELSE qc_grid = cldfra_bl1d(k)*qc_bl1d(K) ENDIF - envm_sqc(k)=envm_sqc(k) + MAX(UPA(K-1,I)*0.5*(QCn + UPQC(K-1,I)) - qc_grid, 0.0)*detrate*aratio*MIN(dzp,300.) + envm_sqc(k)=envm_sqc(k) + MAX(UPA(K-1,I)*0.5*(QCn + UPQC(K-1,I)) - qc_grid, 0.0)*detrate*aratio*MIN(dzp,dzpmax) ENDIF - envm_u(k) =envm_u(k) + (0.5*(Un + UPU(K-1,I)) - U(K))*detrateUV*aratio*MIN(dzp,300.) - envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*MIN(dzp,300.) + envm_u(k) =envm_u(k) + (0.5*(Un + UPU(K-1,I)) - U(K))*detrateUV*aratio*MIN(dzp,dzpmax) + envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*MIN(dzp,dzpmax) IF (Wn > 0.) THEN !Update plume variables at current k index @@ -6362,6 +6364,7 @@ SUBROUTINE DMP_mf( & else f = 1.0 endif + sigq = 9.E-3 * 0.5*(edmf_a(k)+edmf_a(k-1)) * & & 0.5*(edmf_w(k)+edmf_w(k-1)) * f ! convective component of sigma (CB2005) !sigq = MAX(sigq, 1.0E-4) @@ -6373,7 +6376,7 @@ SUBROUTINE DMP_mf( & IF ( debug_code ) THEN print*,"In MYNN, StEM edmf" print*," CB: env qt=",qt(k)," qsat=",qsat_tl - print*," satdef=",QTp - qsat_tl + print*," k=",k," satdef=",QTp - qsat_tl," sgm=",sgm(k) print*," CB: sigq=",sigq," qmq=",qmq," tlk=",tlk print*," CB: mf_cf=",mf_cf," cldfra_bl=",cldfra_bl1d(k)," edmf_a=",edmf_a(k) ENDIF From 3826fd9ea16756ee768ed3a8809cd3ad3e82c507 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Fri, 1 May 2020 22:13:16 +0000 Subject: [PATCH 092/141] Updated GSL orographic drag suite to enable use of custom orographic statistics static files --- physics/GFS_GWD_generic.F90 | 27 +++++++++++++++-- physics/GFS_GWD_generic.meta | 45 ++++++++++++++++++++++++++++ physics/drag_suite.F90 | 57 +++++++++++++++++++++--------------- physics/drag_suite.meta | 36 +++++++++++++++++++++++ 4 files changed, 139 insertions(+), 26 deletions(-) diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 963269329..7d3f86b00 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -17,7 +17,8 @@ end subroutine GFS_GWD_generic_pre_init !! @{ subroutine GFS_GWD_generic_pre_run( & & im, levs, nmtvr, mntvar, & - & oc, oa4, clx, theta, & + & var, oc, oa4, clx, theta, & + & varss, ocss, oa4ss, clxss, & & sigma, gamma, elvmax, lssav, ldiag3d, & & dudt, dvdt, dtdt, du3dt, dv3dt, dt3dt, dtf, & & flag_for_gwd_generic_tend, errmsg, errflg) @@ -29,7 +30,8 @@ subroutine GFS_GWD_generic_pre_run( & real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr) real(kind=kind_phys), intent(out) :: & - & oc(im), oa4(im,4), clx(im,4), & + & var(im), oc(im), oa4(im,4), clx(im,4), & + & varss(im), ocss(im), oa4ss(im,4), clxss(im,4), & & theta(im), sigma(im), gamma(im), elvmax(im) logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend @@ -81,6 +83,27 @@ subroutine GFS_GWD_generic_pre_run( & clx(:,2) = 0.0 clx(:,3) = 0.0 clx(:,4) = 0.0 + elseif (nmtvr == 24) then ! GSD_drag_suite + var(:) = 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) + varss(:) = mntvar(:,15) + ocss(:) = mntvar(:,16) + oa4ss(:,1) = mntvar(:,17) + oa4ss(:,2) = mntvar(:,18) + oa4ss(:,3) = mntvar(:,19) + oa4ss(:,4) = mntvar(:,20) + clxss(:,1) = mntvar(:,21) + clxss(:,2) = mntvar(:,22) + clxss(:,3) = mntvar(:,23) + clxss(:,4) = mntvar(:,24) else oc = 0 oa4 = 0 diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index b31393546..78f2e742d 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -39,6 +39,15 @@ kind = kind_phys intent = in optional = F +[var] + 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 = in + optional = F [oc] standard_name = convexity_of_subgrid_orography long_name = convexity of subgrid orography @@ -66,6 +75,42 @@ kind = kind_phys intent = out optional = F +[varss] + standard_name = standard_deviation_of_subgrid_orography_small_scale + long_name = standard deviation of subgrid orography small scale + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ocss] + standard_name = convexity_of_subgrid_orography_small_scale + long_name = convexity of subgrid orography small scale + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[oa4ss] + standard_name = asymmetry_of_subgrid_orography_small_scale + long_name = asymmetry of subgrid orography small scale + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = out + optional = F +[clxss] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale + 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 diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 080bee156..0eb1f3b5f 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -196,8 +196,8 @@ end subroutine drag_suite_init subroutine drag_suite_run( & & IM,IX,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & & PRSI,DEL,PRSL,PRSLK,PHII,PHIL,DELTIM,KDT, & - & VAR,oc1,oa4,ol4, & -! & varss,oc1ss,oa4ss,ol4ss, & + & var,oc1,oa4,ol4, & + & varss,oc1ss,oa4ss,ol4ss, & & THETA,SIGMA,GAMMA,ELVMAX, & & dtaux2d_ls,dtauy2d_ls,dtaux2d_bl,dtauy2d_bl, & & dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd, & @@ -307,9 +307,10 @@ subroutine drag_suite_run( & real(kind=kind_phys) :: rcl, cdmb real(kind=kind_phys) :: g_inv - real(kind=kind_phys), intent(out) :: & + real(kind=kind_phys), intent(inout) :: & & dudt(im,km),dvdt(im,km), & - & dtdt(im,km), rdxzb(im) + & dtdt(im,km) + real(kind=kind_phys), intent(out) :: rdxzb(im) real(kind=kind_phys), intent(in) :: & & u1(im,km),v1(im,km), & & t1(im,km),q1(im,km), & @@ -320,8 +321,7 @@ subroutine drag_suite_run( & real(kind=kind_phys), intent(in) :: var(im),oc1(im), & & oa4(im,4),ol4(im,4), & & dx(im) - !real(kind=kind_phys), intent(in) :: varss(im),oc1ss(im), & - real(kind=kind_phys) :: varss(im),oc1ss(im), & + real(kind=kind_phys), intent(in) :: varss(im),oc1ss(im), & & oa4ss(im,4),ol4ss(im,4) real(kind=kind_phys), intent(in) :: THETA(im),SIGMA(im), & & GAMMA(im),ELVMAX(im) @@ -474,7 +474,16 @@ subroutine drag_suite_run( & errmsg = '' errflg = 0 -if (me==master) print *,"Running drag suite" + +! Temporary line +!if (me==master) then +! print *, "Ahoj svete!: In drag suite -- cdmbgwd =", cdmbgwd(:) +! print *, "imx =", imx, " dx =", dx(1) +! print * +!end if + + +! if (me==master) print *,"Running drag suite" !-------------------------------------------------------------------- ! SCALE-ADPTIVE PARAMETER FROM GFS GWD SCHEME !-------------------------------------------------------------------- @@ -527,14 +536,14 @@ subroutine drag_suite_run( & enddo !temporary use of large-scale data: - do i=1,im - varss(i)=var(i) - oc1ss(i)=oc1(i) - do j=1,4 - oa4ss(i,j)=oa4(i,j) - ol4ss(i,j)=ol4(i,j) - enddo - enddo +! do i=1,im +! varss(i)=var(i) +! oc1ss(i)=oc1(i) +! do j=1,4 +! oa4ss(i,j)=oa4(i,j) +! ol4ss(i,j)=ol4(i,j) +! enddo +! enddo ! !--- calculate scale-aware tapering factors !NOTE: if dx(1) is not representative of most/all dx, this needs to change... @@ -548,7 +557,7 @@ subroutine drag_suite_run( & (dxmax_ls-dxmin_ls)) + 1. ) end if end if -if (me==master) print *,"in Drag Suite, dx(1:2):",dx(1),dx(2) +! if (me==master) print *,"in Drag Suite, dx(1:2):",dx(1),dx(2) if ( dx(1) .ge. dxmax_ss ) then ss_taper = 1. else @@ -558,7 +567,7 @@ subroutine drag_suite_run( & ss_taper = dxmax_ss * (1. - dxmin_ss/dx(1))/(dxmax_ss-dxmin_ss) end if end if -if (me==master) print *,"in Drag Suite, ss_taper:",ss_taper +! if (me==master) print *,"in Drag Suite, ss_taper:",ss_taper !--- calculate length of grid for flow-blocking drag ! @@ -907,7 +916,7 @@ subroutine drag_suite_run( & vtendwave=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" + ! if (me==master) print *,"in Drag Suite: Running small-scale gravity wave drag" ! ! declaring potential temperature ! @@ -943,11 +952,11 @@ subroutine drag_suite_run( & enddo if((xland(i)-1.5).le.0. .and. 2.*varss(i).le.hpbl(i))then if(br1(i).gt.0. .and. thvx(i,kpbl2)-thvx(i,kts) > 0.)then -!WRF cleff_ss = sqrt(dxy(i)**2 + dxyp(i)**2) + cleff_ss = sqrt(dxy(i)**2 + dxyp(i)**2) ! WRF ! cleff_ss = 3. * max(dx(i),cleff_ss) ! cleff_ss = 10. * max(dxmax_ss,cleff_ss) -!WRF cleff_ss = 0.1 * max(dxmax_ss,cleff_ss) - cleff_ss = 0.1 * 12000. + cleff_ss = 0.1 * max(dxmax_ss,cleff_ss) ! WRF +! cleff_ss = 0.1 * 12000. coefm_ss(i) = (1. + olss(i)) ** (oass(i)+1.) xlinv(i) = coefm_ss(i) / cleff_ss !govrth(i)=g/(0.5*(thvx(i,kpbl(i))+thvx(i,kts))) @@ -1024,7 +1033,7 @@ subroutine drag_suite_run( & ! Topographic Form Drag from Beljaars et al. (2004, QJRMS, equ. 16): !================================================================ IF ( (gwd_opt_fd .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN - if (me==master) print *,"in Drag Suite: Running form drag" + ! if (me==master) print *,"in Drag Suite: Running form drag" utendform=0. vtendform=0. @@ -1080,7 +1089,7 @@ subroutine drag_suite_run( & !======================================================= ! More for the large-scale gwd component IF ( (gwd_opt_ls .EQ. 1).and.(ls_taper.GT.1.E-02) ) THEN - if (me==master) print *,"in Drag Suite: Running large-scale gravity wave drag" + ! if (me==master) print *,"in Drag Suite: Running large-scale gravity wave drag" ! ! now compute vertical structure of the stress. do k = kts,kpblmax @@ -1148,7 +1157,7 @@ subroutine drag_suite_run( & !COMPUTE BLOCKING COMPONENT !=============================================================== IF ( (gwd_opt_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN - if (me==master) print *,"in Drag Suite: Running blocking drag" + ! if (me==master) print *,"in Drag Suite: Running blocking drag" do i = its,im if(.not.ldrag(i)) then diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index dfb6f64b8..b174f0fdb 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -208,6 +208,42 @@ kind = kind_phys intent = in optional = F +[varss] + standard_name = standard_deviation_of_subgrid_orography_small_scale + long_name = standard deviation of subgrid orography small scale + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oc1ss] + standard_name = convexity_of_subgrid_orography_small_scale + long_name = convexity of subgrid orography small scale + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oa4ss] + standard_name = asymmetry_of_subgrid_orography_small_scale + long_name = asymmetry of subgrid orography small scale + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[ol4ss] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + 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 From 25a72ecbfdeac3d0fe56f73b2f545ac25628b309 Mon Sep 17 00:00:00 2001 From: lisa-bengtsson <54411948+lisa-bengtsson@users.noreply.github.com> Date: Mon, 4 May 2020 08:59:57 -0600 Subject: [PATCH 093/141] Ca develop (#418) * CA updates in CCPP * make nthresh a namelist variable * nthresh update * Updates to GFS_debug * introducing closure/trigger/entrainment switches for CA applications in CCPP * review comments vfact_ca * pass in kdt * updates to kdt and vfact_ca --- physics/GFS_DCNV_generic.F90 | 46 +++---------- physics/GFS_DCNV_generic.meta | 77 --------------------- physics/GFS_MP_generic.F90 | 6 +- physics/GFS_MP_generic.meta | 8 +++ physics/GFS_debug.F90 | 7 +- physics/GFS_stochastics.F90 | 112 +++++++++++++++++++++---------- physics/GFS_stochastics.meta | 51 ++++++++++++++ physics/GFS_surface_generic.F90 | 6 +- physics/GFS_surface_generic.meta | 8 +++ physics/samfdeepcnv.f | 96 ++++++++++++++++++++++---- physics/samfdeepcnv.meta | 42 ++++++++++++ 11 files changed, 285 insertions(+), 174 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index d7305cbe5..1622f4b52 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -17,8 +17,8 @@ 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, cplchm,& - isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & + subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, cplchm, & + gu0, gv0, gt0, gq0_water_vapor, & save_u, save_v, save_t, save_qv, ca_deep, & dqdti, errmsg, errflg) @@ -27,7 +27,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, cplchm implicit none integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, cplchm, isppt_deep + logical, intent(in) :: ldiag3d, do_cnvgwd, cplchm 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 @@ -49,15 +49,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, cplchm errmsg = '' errflg = 0 - if (do_ca) then - do k=1,levs - do i=1,im - gq0_water_vapor(i,k) = gq0_water_vapor(i,k)*(1.0 + ca_deep(i)/500.) - enddo - enddo - endif - - if (ldiag3d .or. isppt_deep) then + if (ldiag3d) then do k=1,levs do i=1,im save_t(i,k) = gt0(i,k) @@ -73,7 +65,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, cplchm enddo endif - if (ldiag3d .or. cplchm .or. isppt_deep) then + if (ldiag3d .or. cplchm) then do k=1,levs do i=1,im save_qv(i,k) = gq0_water_vapor(i,k) @@ -102,19 +94,19 @@ end subroutine GFS_DCNV_generic_post_finalize !> \section arg_table_GFS_DCNV_generic_post_run Argument Table !! \htmlinclude GFS_DCNV_generic_post_run.html !! - 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, & + subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & + 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, 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) + 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 + logical, intent(in) :: lssav, ldiag3d, ras, cscnv real(kind=kind_phys), intent(in) :: frain, dtf real(kind=kind_phys), dimension(im), intent(in) :: rain1, cld1d @@ -135,9 +127,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c ! as long as these do not get used when not allocated (it is still invalid Fortran code, though). real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d - real(kind=kind_phys), dimension(im), intent(inout) :: cape - real(kind=kind_phys), dimension(im,levs), intent(inout) :: tconvtend, qconvtend, uconvtend, vconvtend - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -148,11 +137,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c errflg = 0 if (.not. ras .and. .not. cscnv) then - if(do_ca) then - do i=1,im - cape(i) = cld1d(i) - enddo - endif if (npdf3d == 3 .and. num_p3d == 4) then do k=1,levs do i=1,im @@ -198,18 +182,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c endif ! if (lssav) - - if (isppt_deep) then - do k=1,levs - do i=1,im - tconvtend(i,k) = gt0(i,k) - save_t(i,k) - qconvtend(i,k) = gq0_water_vapor(i,k) - save_qv(i,k) - uconvtend(i,k) = gu0(i,k) - save_u(i,k) - vconvtend(i,k) = gv0(i,k) - save_v(i,k) - enddo - enddo - endif - end subroutine GFS_DCNV_generic_post_run end module GFS_DCNV_generic_post diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 07c75eafc..f632833f9 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -33,14 +33,6 @@ type = logical intent = in optional = F -[do_ca] - standard_name = flag_for_cellular_automata - long_name = cellular automata main switch - units = flag - dimensions = () - type = logical - intent = in - optional = F [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) @@ -49,14 +41,6 @@ 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. - units = flag - dimensions = () - type = logical - intent = in - optional = F [gu0] standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics @@ -217,22 +201,6 @@ type = logical intent = in optional = F -[do_ca] - standard_name = flag_for_cellular_automata - long_name = cellular automata main switch - 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. - units = flag - dimensions = () - type = logical - intent = in - optional = F [frain] standard_name = dynamics_to_physics_timestep_ratio long_name = ratio of dynamics timestep to physics timestep @@ -518,51 +486,6 @@ kind = kind_phys intent = inout optional = F -[cape] - standard_name = convective_available_potential_energy_for_coupling - long_name = convective available potential energy for coupling - units = m2 s-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[tconvtend] - standard_name = tendency_of_air_temperature_due_to_deep_convection_for_coupling_on_physics_timestep - long_name = tendency of air temperature due to deep convection - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qconvtend] - standard_name = tendency_of_water_vapor_specific_humidity_due_to_deep_convection_for_coupling_on_physics_timestep - long_name = tendency of specific humidity due to deep convection - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[uconvtend] - standard_name = tendency_of_x_wind_due_to_deep_convection_for_coupling_on_physics_timestep - long_name = tendency_of_x_wind_due_to_deep_convection - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[vconvtend] - standard_name = tendency_of_y_wind_due_to_deep_convection_for_coupling_on_physics_timestep - long_name = tendency_of_y_wind_due_to_deep_convection - units = m 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_MP_generic.F90 b/physics/GFS_MP_generic.F90 index ab68e206a..291808fb8 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -85,7 +85,7 @@ 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, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & + do_sppt, ca_global, 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 @@ -114,7 +114,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, dq3dt ! Stochastic physics / surface perturbations - logical, intent(in) :: do_sppt + logical, intent(in) :: do_sppt, ca_global real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdtr real(kind=kind_phys), dimension(im,levs), intent(in) :: dtdtc real(kind=kind_phys), dimension(im), intent(inout) :: drain_cpl @@ -375,7 +375,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt enddo ! Stochastic physics / surface perturbations - if (do_sppt) then + if (do_sppt .or. ca_global) then !--- radiation heating rate dtdtr(1:im,:) = dtdtr(1:im,:) + dtdtc(1:im,:)*dtf endif diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index ddf8cb813..c7082da3a 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -722,6 +722,14 @@ type = logical intent = in optional = F +[ca_global] + standard_name = flag_for_global_cellular_automata + long_name = switch for global ca + units = flag + dimensions = () + type = logical + intent = in + optional = F [dtdtr] standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step long_name = temp. change due to radiative heating per time step diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 6bf39d491..eea4c58da 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -478,17 +478,12 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts' , Coupling%sfc_wts ) end if if (Model%do_ca) then - call print_var(mpirank,omprank, blkno, 'Coupling%tconvtend', Coupling%tconvtend ) - call print_var(mpirank,omprank, blkno, 'Coupling%qconvtend', Coupling%qconvtend ) - call print_var(mpirank,omprank, blkno, 'Coupling%uconvtend', Coupling%uconvtend ) - call print_var(mpirank,omprank, blkno, 'Coupling%vconvtend', Coupling%vconvtend ) - call print_var(mpirank,omprank, blkno, 'Coupling%ca_out ', Coupling%ca_out ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca1 ', Coupling%ca1 ) call print_var(mpirank,omprank, blkno, 'Coupling%ca_deep ', Coupling%ca_deep ) call print_var(mpirank,omprank, blkno, 'Coupling%ca_turb ', Coupling%ca_turb ) call print_var(mpirank,omprank, blkno, 'Coupling%ca_shal ', Coupling%ca_shal ) call print_var(mpirank,omprank, blkno, 'Coupling%ca_rad ', Coupling%ca_rad ) call print_var(mpirank,omprank, blkno, 'Coupling%ca_micro ', Coupling%ca_micro ) - call print_var(mpirank,omprank, blkno, 'Coupling%cape ', Coupling%cape ) end if if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then call print_var(mpirank,omprank, blkno, 'Coupling%nwfa2d', Coupling%nwfa2d) diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index 99f84e3b1..9b4533cf9 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -26,7 +26,8 @@ end subroutine GFS_stochastics_finalize !! -# defines random seed indices for radiation (in a reproducible way) !! -# interpolates coefficients for prognostic ozone calculation !! -# performs surface data cycling via the GFS gcycle routine - subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, & + subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, & + do_skeb, do_ca,ca_global,ca1,si,vfact_ca, & zmtnblck, sppt_wts, skebu_wts, skebv_wts, shum_wts,& sppt_wts_inv, skebu_wts_inv, skebv_wts_inv, & shum_wts_inv, diss_est, & @@ -42,11 +43,13 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, integer, intent(in) :: im integer, intent(in) :: km + integer, intent(in) :: kdt logical, intent(in) :: do_sppt + logical, intent(in) :: do_ca + logical, intent(in) :: ca_global logical, intent(in) :: use_zmtnblck logical, intent(in) :: do_shum logical, intent(in) :: do_skeb - !logical, intent(in) :: isppt_deep real(kind_phys), dimension(1:im), intent(in) :: zmtnblck ! sppt_wts only allocated if do_sppt == .true. real(kind_phys), dimension(:,:), intent(inout) :: sppt_wts @@ -85,17 +88,16 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, ! drain_cpl, dsnow_cpl only allocated if cplflx == .true. or cplchm == .true. real(kind_phys), dimension(:), intent(in) :: drain_cpl real(kind_phys), dimension(:), intent(in) :: dsnow_cpl - ! tconvtend ... vconvtend only allocated if isppt_deep == .true. - !real(kind_phys), dimension(:,:), intent(in) :: tconvtend - !real(kind_phys), dimension(:,:), intent(in) :: qconvtend - !real(kind_phys), dimension(:,:), intent(in) :: uconvtend - !real(kind_phys), dimension(:,:), intent(in) :: vconvtend + real(kind_phys), dimension(1:km), intent(in) :: si + real(kind_phys), dimension(1:km), intent(inout) :: vfact_ca + real(kind_phys), dimension(1:im), intent(in) :: ca1 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg !--- local variables integer :: k, i real(kind=kind_phys) :: upert, vpert, tpert, qpert, qnew, sppt_vwt + real(kind=kind_phys), dimension(1:im,1:km) :: ca ! Initialize CCPP error handling variables errmsg = '' @@ -126,22 +128,11 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, endif sppt_wts_inv(i,k)=sppt_wts(i,k) - !if(isppt_deep)then - - ! upert = (gu0(i,k) - ugrs(i,k) - uconvtend(i,k)) + uconvtend(i,k) * sppt_wts(i,k) - ! vpert = (gv0(i,k) - vgrs(i,k) - vconvtend(i,k)) + vconvtend(i,k) * sppt_wts(i,k) - ! tpert = (gt0(i,k) - tgrs(i,k) - dtdtr(i,k) - tconvtend(i,k)) + tconvtend(i,k) * sppt_wts(i,k) - ! qpert = (gq0(i,k) - qgrs(i,k) - qconvtend(i,k)) + qconvtend(i,k) * sppt_wts(i,k) - - !else - upert = (gu0(i,k) - ugrs(i,k)) * sppt_wts(i,k) vpert = (gv0(i,k) - vgrs(i,k)) * sppt_wts(i,k) tpert = (gt0(i,k) - tgrs(i,k) - dtdtr(i,k)) * sppt_wts(i,k) qpert = (gq0(i,k) - qgrs(i,k)) * sppt_wts(i,k) - !endif - gu0(i,k) = ugrs(i,k)+upert gv0(i,k) = vgrs(i,k)+vpert @@ -154,21 +145,6 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, enddo enddo - !if(isppt_deep)then - ! tprcp(:) = tprcp(:) + (sppt_wts(:,15) - 1 )*rainc(:) - ! totprcp(:) = totprcp(:) + (sppt_wts(:,15) - 1 )*rainc(:) - ! cnvprcp(:) = cnvprcp(:) + (sppt_wts(:,15) - 1 )*rainc(:) - !! ! bucket precipitation adjustment due to sppt - ! totprcpb(:) = totprcpb(:) + (sppt_wts(:,15) - 1 )*rainc(:) - ! cnvprcpb(:) = cnvprcpb(:) + (sppt_wts(:,15) - 1 )*rainc(:) - - ! if (cplflx) then !Need to make proper adjustments for deep convection only perturbations - ! rain_cpl(:) = rain_cpl(:) + (sppt_wts(:,15) - 1.0)*drain_cpl(:) - ! snow_cpl(:) = snow_cpl(:) + (sppt_wts(:,15) - 1.0)*dsnow_cpl(:) - ! endif - - !else - ! instantaneous precip rate going into land model at the next time step tprcp(:) = sppt_wts(:,15)*tprcp(:) totprcp(:) = totprcp(:) + (sppt_wts(:,15) - 1 )*rain(:) @@ -183,7 +159,75 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, snow_cpl(:) = snow_cpl(:) + (sppt_wts(:,15) - 1.0)*dsnow_cpl(:) endif - !endif + endif + + if (do_ca .and. ca_global) then + + if(kdt == 1)then + do k=1,km + if (si(k) .lt. 0.1 .and. si(k) .gt. 0.025) then + vfact_ca(k) = (si(k)-0.025)/(0.1-0.025) + else if (si(k) .lt. 0.025) then + vfact_ca(k) = 0.0 + else + vfact_ca(k) = 1.0 + endif + enddo + vfact_ca(2)=vfact_ca(3)*0.5 + vfact_ca(1)=0.0 + endif + + do k = 1,km + do i = 1,im + sppt_vwt=1.0 + if (zmtnblck(i).EQ.0.0) then + sppt_vwt=1.0 + else + if (k.GT.zmtnblck(i)+2) then + sppt_vwt=1.0 + endif + if (k.LE.zmtnblck(i)) then + sppt_vwt=0.0 + endif + if (k.EQ.zmtnblck(i)+1) then + sppt_vwt=0.333333 + endif + if (k.EQ.zmtnblck(i)+2) then + sppt_vwt=0.666667 + endif + endif + + ca(i,k)=((ca1(i)-1.)*sppt_vwt*vfact_ca(k))+1.0 + + upert = (gu0(i,k) - ugrs(i,k)) * ca(i,k) + vpert = (gv0(i,k) - vgrs(i,k)) * ca(i,k) + tpert = (gt0(i,k) - tgrs(i,k) - dtdtr(i,k)) * ca(i,k) + qpert = (gq0(i,k) - qgrs(i,k)) * ca(i,k) + gu0(i,k) = ugrs(i,k)+upert + gv0(i,k) = vgrs(i,k)+vpert + !negative humidity check + qnew = qgrs(i,k)+qpert + if (qnew >= 1.0e-10) then + gq0(i,k) = qnew + gt0(i,k) = tgrs(i,k) + tpert + dtdtr(i,k) + endif + enddo + enddo + + ! instantaneous precip rate going into land model at the next time step + tprcp(:) = ca(:,15)*tprcp(:) + totprcp(:) = totprcp(:) + (ca(:,15) - 1 )*rain(:) + ! acccumulated total and convective preciptiation + cnvprcp(:) = cnvprcp(:) + (ca(:,15) - 1 )*rainc(:) + ! bucket precipitation adjustment due to sppt + totprcpb(:) = totprcpb(:) + (ca(:,15) - 1 )*rain(:) + cnvprcpb(:) = cnvprcpb(:) + (ca(:,15) - 1 )*rainc(:) + + if (cplflx) then + rain_cpl(:) = rain_cpl(:) + (ca(:,15) - 1.0)*drain_cpl(:) + snow_cpl(:) = snow_cpl(:) + (ca(:,15) - 1.0)*dsnow_cpl(:) + endif + endif diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index 9232c8d6a..c4fad912e 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -17,6 +17,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 [do_sppt] standard_name = flag_for_stochastic_surface_physics_perturbations long_name = flag for stochastic surface physics perturbations @@ -67,6 +75,49 @@ kind = kind_phys intent = inout optional = F +[do_ca] + standard_name = flag_for_cellular_automata + long_name = cellular automata main switch + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ca_global] + standard_name = flag_for_global_cellular_automata + long_name = switch for global ca + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ca1] + standard_name = cellular_automata_global_pattern + long_name = cellular automata global pattern + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vfact_ca] + standard_name = vertical_weight_for_ca + long_name = vertical weight for ca + units = frac + dimensions = (vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[si] + standard_name = vertical_sigma_coordinate_for_radiation_initialization + long_name = vertical sigma coordinate for radiation initialization + units = none + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F [skebu_wts] standard_name = weights_for_stochastic_skeb_perturbation_of_x_wind long_name = weights for stochastic skeb perturbation of x wind diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index ac366ae54..dbcdec24b 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -27,7 +27,7 @@ end subroutine GFS_surface_generic_pre_finalize !! subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, stype, vtype, slope, & prsik_1, prslk_1, tsfc, phil, con_g, & - sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, dtdtr, & + sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, ca_global,dtdtr,& drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, do_sfcperts, nsfcpert, sfc_wts, & pertz0, pertzt, pertshc, pertlai, pertvegf, z01d, zt1d, bexp1d, xlai1d, vegf1d, & cplflx, flag_cice, islmsk_cice, slimskin_cpl, tisfc, tsfco, fice, hice, & @@ -51,7 +51,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(inout) :: sigmaf, work3, tsurf, zlvl ! Stochastic physics / surface perturbations - logical, intent(in) :: do_sppt + logical, intent(in) :: do_sppt, ca_global real(kind=kind_phys), dimension(im,levs), intent(out) :: dtdtr real(kind=kind_phys), dimension(im), intent(out) :: drain_cpl real(kind=kind_phys), dimension(im), intent(out) :: dsnow_cpl @@ -102,7 +102,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, errflg = 0 ! Set initial quantities for stochastic physics deltas - if (do_sppt) then + if (do_sppt .or. ca_global) then dtdtr = 0.0 endif diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 250f7a2bd..81ca18f94 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -190,6 +190,14 @@ type = logical intent = in optional = F +[ca_global] + standard_name = flag_for_global_cellular_automata + long_name = switch for global ca + units = flag + dimensions = () + type = logical + intent = in + optional = F [dtdtr] standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step long_name = temp. change due to radiative heating per time step diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 83e1efb80..8bffd0a42 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -72,11 +72,13 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp, & & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav, & - & do_ca,ca_deep,cldwrk,rn,kbot,ktop,kcnv,islimsk,garea, & + & cldwrk,rn,kbot,ktop,kcnv,islimsk,garea, & & 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,c0s,c1,betal,betas,evfact,evfactl,pgcon,asolfac, & + & do_ca, ca_closure, ca_entr, ca_trigger, nthresh, ca_deep, & + & rainevap, & & errmsg,errflg) ! use machine , only : kind_phys @@ -92,8 +94,10 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & real(kind=kind_phys), intent(in) :: psp(im), delp(ix,km), & & prslp(ix,km), garea(im), dot(ix,km), phil(ix,km) real(kind=kind_phys), dimension(:), intent(in) :: fscav + real(kind=kind_phys), intent(in) :: nthresh real(kind=kind_phys), intent(in) :: ca_deep(ix) - logical, intent(in) :: do_ca + real(kind=kind_phys), intent(out) :: rainevap(ix) + logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger integer, intent(inout) :: kcnv(im) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH @@ -222,6 +226,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & parameter(cinacrmx=-120.,cinacrmn=-80.) parameter(bet1=1.875,cd1=.506,f1=2.0,gam1=.5) parameter(betaw=.03,dxcrtas=8.e3,dxcrtuf=15.e3) + ! ! local variables and arrays real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), @@ -327,6 +332,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & xpwav(i)= 0. xpwev(i)= 0. vshear(i) = 0. + rainevap(i) = 0. gdx(i) = sqrt(garea(i)) enddo ! @@ -655,6 +661,14 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & do i=1,im if(kbcon(i) == kmax(i)) cnvflg(i) = .false. enddo +!! + if(do_ca .and. ca_trigger)then + do i=1,im + if(ca_deep(i) > nthresh) then + cnvflg(i) = .true. + endif + enddo + endif !! totflg = .true. do i=1,im @@ -706,6 +720,14 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & endif endif enddo +!! + if(do_ca .and. ca_trigger)then + do i=1,im + if(ca_deep(i) > nthresh) then + cnvflg(i) = .true. + endif + enddo + endif !! totflg = .true. do i=1,im @@ -755,11 +777,23 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & ! else ! - do i= 1, im - if(cnvflg(i)) then - clamt(i) = clam - endif - enddo + if(do_ca .and. ca_entr)then + do i=1,im + if(cnvflg(i)) then + if(ca_deep(i) > nthresh)then + clamt(i) = clam - clamd + else + clamt(i) = clam + endif + endif + enddo + else + do i=1,im + if(cnvflg(i))then + clamt(i) = clam + endif + enddo + endif ! endif ! @@ -986,6 +1020,14 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & endif endif enddo +!! + if(do_ca .and. ca_trigger)then + do i=1,im + if(ca_deep(i) > nthresh) then + cnvflg(i) = .true. + endif + enddo + endif !! totflg = .true. do i = 1, im @@ -1054,6 +1096,14 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & if(cina(i) < cinacr) cnvflg(i) = .false. endif enddo +!! + if(do_ca .and. ca_trigger)then + do i=1,im + if(ca_deep(i) > nthresh) then + cnvflg(i) = .true. + endif + enddo + endif !! totflg = .true. do i=1,im @@ -1089,6 +1139,14 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & if(tem < cthk) cnvflg(i) = .false. endif enddo +!! + if(do_ca .and. ca_trigger)then + do i=1,im + if(ca_deep(i) > nthresh) then + cnvflg(i) = .true. + endif + enddo + endif !! totflg = .true. do i = 1, im @@ -2370,6 +2428,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & 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 @@ -2403,13 +2462,15 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & xmb(i) = min(xmb(i),xmbmax(i)) endif enddo - -!> - If stochastic physics using cellular automata is .true. then perturb the mass-flux here: - - if(do_ca)then - do i=1,im - xmb(i) = xmb(i)*(1.0 + ca_deep(i)*5.) - enddo +! + if (do_ca .and. ca_closure)then + do i = 1, im + if(cnvflg(i)) then + if (ca_deep(i) > nthresh) then + xmb(i) = xmb(i)*1.25 + endif + endif + enddo endif !> - Transport aerosols if present @@ -2589,6 +2650,13 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + +!LB: + if(do_ca)then + do i = 1,im + rainevap(i)=delqev(i) + enddo + endif cj ! do i = 1, im ! if(me == 31 .and. cnvflg(i)) then diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index 3b54998fc..215026eb2 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -265,6 +265,15 @@ kind = kind_phys intent = in optional = F +[nthresh] + standard_name = threshold_for_perturbed_vertical_velocity + long_name = threshold used for perturbed vertical velocity + units = m s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [do_ca] standard_name = flag_for_cellular_automata long_name = cellular automata main switch @@ -273,6 +282,30 @@ type = logical intent = in optional = F +[ca_closure] + standard_name = flag_for_global_cellular_automata_closure + long_name = switch for ca on closure + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ca_entr] + standard_name = flag_for_global_cellular_automata_entr + long_name = switch for ca on entr + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ca_trigger] + standard_name = flag_for_global_cellular_automata_trigger + long_name = switch for ca on trigger + units = flag + dimensions = () + type = logical + intent = in + optional = F [ca_deep] standard_name = fraction_of_cellular_automata_for_deep_convection long_name = fraction of cellular automata for deep convection @@ -282,6 +315,15 @@ kind = kind_phys intent = in optional = F +[rainevap] + standard_name = physics_field_for_coupling + long_name = physics_field_for_coupling + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [cldwrk] standard_name = cloud_work_function long_name = cloud work function From 379c2f35bbb8e8b92b60beaaa54798cd3650dc64 Mon Sep 17 00:00:00 2001 From: Man Zhang Date: Thu, 27 Feb 2020 11:27:38 -0700 Subject: [PATCH 094/141] scientific documentation update for UFS public release, add two additional xml files for GFSv15p2 and GFSv16beta --- physics/cires_ugwp.F90 | 2 +- physics/docs/library.bib | 501 ++++++++++-------- physics/docs/pdftxt/GFS_UGWPv0.txt | 117 ++++ physics/docs/pdftxt/GFSv15p2_suite.txt | 133 +++++ physics/docs/pdftxt/GFSv16beta_suite.txt | 176 ++++++ .../docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt | 101 ++++ .../suite_FV3_GFS_v15p2_no_nsst.xml.txt | 100 ++++ .../docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt | 101 ++++ .../suite_FV3_GFS_v16beta_no_nsst.xml.txt | 98 ++++ physics/docs/pdftxt/suite_input.nml.txt | 107 +++- physics/docs/ufs_doxyfile | 464 ++++++++++++++++ physics/sfc_nst.f | 9 +- physics/sfc_ocean.F | 16 +- 13 files changed, 1667 insertions(+), 258 deletions(-) create mode 100644 physics/docs/pdftxt/GFS_UGWPv0.txt create mode 100644 physics/docs/pdftxt/GFSv15p2_suite.txt create mode 100644 physics/docs/pdftxt/GFSv16beta_suite.txt create mode 100644 physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt create mode 100644 physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt create mode 100644 physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt create mode 100644 physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt create mode 100644 physics/docs/ufs_doxyfile diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index e0abc58ff..ac12764cc 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -146,7 +146,7 @@ end subroutine cires_ugwp_finalize !! \htmlinclude cires_ugwp_run.html !! -! subroutines original +!>\section gen_cires_ugwp CIRES UGWP General Algorithm subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr, & oro, oro_uf, hprime, nmtvr, oc, theta, sigma, gamma, elvmax, clx, oa4, & do_tofd, ldiag_ugwp, cdmbgwd, xlat, xlat_d, sinlat, coslat, area, & diff --git a/physics/docs/library.bib b/physics/docs/library.bib index 7384e08a0..cfc3e3304 100644 --- a/physics/docs/library.bib +++ b/physics/docs/library.bib @@ -1,7 +1,7 @@ %% This BibTeX bibliography file was created using BibDesk. -%% https://bibdesk.sourceforge.io/ +%% http://bibdesk.sourceforge.net/ -%% Created for Grant Firl at 2019-10-25 16:36:06 -0600 +%% Created for Man Zhang at 2020-02-24 10:07:00 -0700 %% Saved with string encoding Unicode (UTF-8) @@ -2016,11 +2016,11 @@ @url{Li_2015 Url = {http://cpo.noaa.gov/sites/cpo/MAPP/workshops/rtf_technical_ws/presentations/21_Xu_Li.pdf}, Bdsk-Url-1 = {http://cpo.noaa.gov/sites/cpo/MAPP/workshops/rtf_technical_ws/presentations/21_Xu_Li.pdf}} -@url{li_and_derber_2009, +@webpage{li_and_derber_2009, Author = {Xu Li and John Derber}, - Date-Modified = {2018-07-17 20:46:44 +0000}, + Date-Modified = {2020-02-24 17:06:35 +0000}, Title = {Near Sea Surface Temperatures (NSST) Analysis in NCEP GFS}, - Url = {https://www.jcsda.noaa.gov/documents/meetings/wkshp2008/4/JCSDA_2008_Li.pdf}, + Url = {http://data.jcsda.org/Workshops/6th-workshop-onDA/Session-4/JCSDA_2008_Li.pdf}, Bdsk-Url-1 = {https://www.jcsda.noaa.gov/documents/meetings/wkshp2008/4/JCSDA_2008_Li.pdf}} @article{Fairall_et_al_1996, @@ -2892,273 +2892,308 @@ @article{hu_and_stamnes_1993 Year = {1993}} @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}} + 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.}, + Doi = {10.1002/qj.637}, + Eprint = {https://rmets.onlinelibrary.wiley.com/doi/pdf/10.1002/qj.637}, + Journal = {Quarterly Journal of the Royal Meteorological Society}, + Keywords = {atmosphere, gravity wave, momentum flux, drag, force, wind tendency, climate, global model}, + Number = {650}, + Pages = {1103-1124}, + Title = {Recent developments in gravity-wave effects in climate models and the global distribution of gravity-wave momentum flux from observations and models}, + Url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.637}, + Volume = {136}, + Year = {2010}, + Bdsk-Url-1 = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.637}, + Bdsk-Url-2 = {http://dx.doi.org/10.1002/qj.637}} @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}} + Author = {Plougonven, R. and Zhang, F.}, + Doi = {10.1002/2012RG000419}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2012RG000419}, + Journal = {Reviews of Geophysics}, + Keywords = {gravity waves, stratosphere, atmosphere, jets, fronts, weather}, + Number = {1}, + Pages = {33-76}, + Title = {Internal gravity waves from atmospheric jets and fronts}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2012RG000419}, + Volume = {52}, + Year = {2014}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2012RG000419}, + Bdsk-Url-2 = {http://dx.doi.org/10.1002/2012RG000419}} @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}} + Author = {Weinstock, J.}, + Doi = {10.1029/JA089iA01p00345}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/JA089iA01p00345}, + Journal = {Journal of Geophysical Research: Space Physics}, + Number = {A1}, + Pages = {345-350}, + Title = {Simplified derivation of an algorithm for nonlinear gravity waves}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/JA089iA01p00345}, + Volume = {89}, + Year = {1984}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/JA089iA01p00345}, + Bdsk-Url-2 = {http://dx.doi.org/10.1029/JA089iA01p00345}} @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}} + Author = {Holton, James R.}, + Doi = {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}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {10}, + Pages = {2497-2507}, + Title = {The Influence of Gravity Wave Breaking on the General Circulation of the Middle Atmosphere}, + Url = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + Volume = {40}, + Year = {1983}, + Bdsk-Url-1 = {https://doi.org/10.1175/1520-0469(1983)040%3C2497:TIOGWB%3E2.0.CO;2}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/1520-0469(1983)040%3C2497:TIOGWB%3E2.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}} + 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.}, + Doi = {10.1175/JCLI-D-12-00545.1}, + Eprint = {https://doi.org/10.1175/JCLI-D-12-00545.1}, + Journal = {Journal of Climate}, + Number = {17}, + Pages = {6383-6405}, + Title = {A Comparison between Gravity Wave Momentum Fluxes in Observations and Climate Models}, + Url = {https://doi.org/10.1175/JCLI-D-12-00545.1}, + Volume = {26}, + Year = {2013}, + Bdsk-Url-1 = {https://doi.org/10.1175/JCLI-D-12-00545.1}, + Bdsk-Url-2 = {http://dx.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}} + Author = {Garcia, R. R. and Smith, A. K. and Kinnison, D. E. and C{\'a}mara, {\'A}. and Murphy, D. J.}, + Doi = {10.1175/JAS-D-16-0104.1}, + Eprint = {https://doi.org/10.1175/JAS-D-16-0104.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {1}, + Pages = {275-291}, + Title = {Modification of the Gravity Wave Parameterization in the Whole Atmosphere Community Climate Model: Motivation and Results}, + Url = {https://doi.org/10.1175/JAS-D-16-0104.1}, + Volume = {74}, + Year = {2017}, + Bdsk-Url-1 = {https://doi.org/10.1175/JAS-D-16-0104.1}, + Bdsk-Url-2 = {http://dx.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={}} + Author = {Yudin, V.A. and Akmaev, R.A. and Fuller-Rowell, T.J. and Alpert, J.C.}, + Booktitle = {International SPARC Gravity Wave Symposium}, + Number = {1}, + Pages = {012024}, + Title = {Gravity wave physics in the NOAA Environmental Modeling System}, + Volume = {48}, + Year = {2016}} @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}} + Author = {Alpert, Jordan C and Yudin, Valery and Fuller-Rowell, Tim and Akmaev, Rashid A}, + Booktitle = {98th American Meteorological Society Annual Meeting}, + Organization = {AMS}, + Title = {Integrating Unified Gravity Wave Physics Research into the Next Generation Global Prediction System for NCEP Research to Operations}, + Year = {2018}} @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}} + Author = {Eckermann, Stephen D.}, + Doi = {10.1175/2011JAS3684.1}, + Eprint = {https://doi.org/10.1175/2011JAS3684.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {8}, + Pages = {1749-1765}, + Title = {Explicitly Stochastic Parameterization of Nonorographic Gravity Wave Drag}, + Url = {https://doi.org/10.1175/2011JAS3684.1}, + Volume = {68}, + Year = {2011}, + Bdsk-Url-1 = {https://doi.org/10.1175/2011JAS3684.1}, + Bdsk-Url-2 = {http://dx.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}} + Author = {Lott, F. and Guez, L. and Maury, P.}, + Doi = {10.1029/2012GL051001}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2012GL051001}, + Journal = {Geophysical Research Letters}, + Keywords = {Quasi-Biennial Oscillation, Rossby-gravity waves, gravity waves, stochastic parameterization, stratospheric dynamics}, + Number = {6}, + Title = {A stochastic parameterization of non-orographic gravity waves: Formalism and impact on the equatorial stratosphere}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2012GL051001}, + Volume = {39}, + Year = {2012}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2012GL051001}, + Bdsk-Url-2 = {http://dx.doi.org/10.1029/2012GL051001}} @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}} + 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"} + Author = {Colin O. Hines}, + Doi = {https://doi.org/10.1016/S1364-6826(96)00080-6}, + Issn = {1364-6826}, + Journal = {Journal of Atmospheric and Solar-Terrestrial Physics}, + Number = {4}, + Pages = {387 - 400}, + Title = {Doppler-spread parameterization of gravity-wave momentum deposition in the middle atmosphere. Part 2: Broad and quasi monochromatic spectra, and implementation}, + Url = {http://www.sciencedirect.com/science/article/pii/S1364682696000806}, + Volume = {59}, + Year = {1997}, + Bdsk-Url-1 = {http://www.sciencedirect.com/science/article/pii/S1364682696000806}, + Bdsk-Url-2 = {https://doi.org/10.1016/S1364-6826(96)00080-6}} @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}} + Author = {Alexander, M. J. and Dunkerton, T. J.}, + Doi = {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}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {24}, + Pages = {4167-4182}, + Title = {A Spectral Parameterization of Mean-Flow Forcing due to Breaking Gravity Waves}, + Url = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + Volume = {56}, + Year = {1999}, + Bdsk-Url-1 = {https://doi.org/10.1175/1520-0469(1999)056%3C4167:ASPOMF%3E2.0.CO;2}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/1520-0469(1999)056%3C4167:ASPOMF%3E2.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}} + Author = {Scinocca, John F.}, + Doi = {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}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {4}, + Pages = {667-682}, + Title = {An Accurate Spectral Nonorographic Gravity Wave Drag Parameterization for General Circulation Models}, + Url = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + Volume = {60}, + Year = {2003}, + Bdsk-Url-1 = {https://doi.org/10.1175/1520-0469(2003)060%3C0667:AASNGW%3E2.0.CO;2}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/1520-0469(2003)060%3C0667:AASNGW%3E2.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}} + Author = {Shaw, Tiffany A. and Shepherd, Theodore G.}, + Doi = {10.1175/2009JAS3051.1}, + Eprint = {https://doi.org/10.1175/2009JAS3051.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {10}, + Pages = {3095-3114}, + Title = {A Theoretical Framework for Energy and Momentum Consistency in Subgrid-Scale Parameterization for Climate Models}, + Url = {https://doi.org/10.1175/2009JAS3051.1}, + Volume = {66}, + Year = {2009}, + Bdsk-Url-1 = {https://doi.org/10.1175/2009JAS3051.1}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/2009JAS3051.1}} + +@article{molod_et_al_2015, + Author = {Molod, A. and Takacs, L. and Suarez, M. and Bacmeister, J.}, + Doi = {10.5194/gmd-8-1339-2015}, + Journal = {Geoscientific Model Development}, + Number = {5}, + Pages = {1339--1356}, + Title = {Development of the GEOS-5 atmospheric general circulation model: evolution from MERRA to MERRA2}, + Url = {https://www.geosci-model-dev.net/8/1339/2015/}, + Volume = {8}, + Year = {2015}, + Bdsk-Url-1 = {https://www.geosci-model-dev.net/8/1339/2015/}, + Bdsk-Url-2 = {http://dx.doi.org/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}} + Author = {Richter, Jadwiga H. and Sassi, Fabrizio and Garcia, Rolando R.}, + Doi = {10.1175/2009JAS3112.1}, + Eprint = {https://doi.org/10.1175/2009JAS3112.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {1}, + Pages = {136-156}, + Title = {Toward a Physically Based Gravity Wave Source Parameterization in a General Circulation Model}, + Url = {https://doi.org/10.1175/2009JAS3112.1}, + Volume = {67}, + Year = {2010}, + Bdsk-Url-1 = {https://doi.org/10.1175/2009JAS3112.1}, + Bdsk-Url-2 = {http://dx.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}} + Author = {Richter, Jadwiga H. and Solomon, Abraham and Bacmeister, Julio T.}, + Doi = {10.1002/2013MS000303}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2013MS000303}, + Journal = {Journal of Advances in Modeling Earth Systems}, + Keywords = {climate modeling, vertical resolution, modeling, climate, global circulation model, general circulation model}, + Number = {2}, + Pages = {357-383}, + Title = {Effects of vertical resolution and nonorographic gravity wave drag on the simulated climate in the Community Atmosphere Model, version 5}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2013MS000303}, + Volume = {6}, + Year = {2014}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2013MS000303}, + Bdsk-Url-2 = {http://dx.doi.org/10.1002/2013MS000303}} @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}} + Author = {Gelaro, et al.}, + Doi = {10.1175/JCLI-D-16-0758.1}, + Eprint = {https://doi.org/10.1175/JCLI-D-16-0758.1}, + Journal = {Journal of Climate}, + Number = {14}, + Pages = {5419-5454}, + Title = {The Modern-Era Retrospective Analysis for Research and Applications, Version 2 (MERRA-2)}, + Url = {https://doi.org/10.1175/JCLI-D-16-0758.1}, + Volume = {30}, + Year = {2017}, + Bdsk-Url-1 = {https://doi.org/10.1175/JCLI-D-16-0758.1}, + Bdsk-Url-2 = {http://dx.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}} + Author = {Garcia, R. R. and Marsh, D. R. and Kinnison, D. E. and Boville, B. A. and Sassi, F.}, + Doi = {10.1029/2006JD007485}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2006JD007485}, + Journal = {Journal of Geophysical Research: Atmospheres}, + Keywords = {global change, ozone depletion, water vapor trends, temperature trends}, + Number = {D9}, + Title = {Simulation of secular trends in the middle atmosphere, 1950--2003}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007485}, + Volume = {112}, + Year = {2007}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007485}, + Bdsk-Url-2 = {http://dx.doi.org/10.1029/2006JD007485}} @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",} + 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}, + Doi = {https://doi.org/10.1016/j.jastp.2008.09.036}, + Issn = {1364-6826}, + Journal = {Journal of Atmospheric and Solar-Terrestrial Physics}, + Keywords = {Data assimilation, Polar mesospheric cloud, Tide, Planetary wave, Mesosphere}, + Note = {Global Perspectives on the Aeronomy of the Summer Mesopause Region}, + Number = {3}, + Pages = {531 - 551}, + Title = {High-altitude data assimilation system experiments for the northern summer mesosphere season of 2007}, + Url = {http://www.sciencedirect.com/science/article/pii/S1364682608002575}, + Volume = {71}, + Year = {2009}, + Bdsk-Url-1 = {http://www.sciencedirect.com/science/article/pii/S1364682608002575}, + Bdsk-Url-2 = {https://doi.org/10.1016/j.jastp.2008.09.036}} @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}} + Author = {Alpert, Jordan C and Yudin, Valery A and Strobach, Edward}, + Booktitle = {AGU Fall Meeting 2019}, + Organization = {AGU}, + Title = {Atmospheric Gravity Wave Sources Correlated with Resolved-scale GW Activity and Sub-grid Scale Parameterization in the FV3gfs Model}, + Year = {2019}} + +@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.}, + Doi = {10.5194/essd-10-857-2018}, + Journal = {Earth System Science Data}, + Number = {2}, + Pages = {857--892}, + Title = {GRACILE: a comprehensive climatology of atmospheric gravity wave parameters based on satellite limb soundings}, + Url = {https://www.earth-syst-sci-data.net/10/857/2018/}, + Volume = {10}, + Year = {2018}, + Bdsk-Url-1 = {https://www.earth-syst-sci-data.net/10/857/2018/}, + Bdsk-Url-2 = {http://dx.doi.org/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},} + Author = {Yudin V.A. , S. I. Karol, R.A. Akmaev, T. Fuller-Rowell, D. Kleist, A. Kubaryk, and C. Thompson}, + Booktitle = {Space Weather Workshop}, + Title = {Longitudinal Variability of Wave Dynamics in Weather Models Extended into the Mesosphere and Thermosphere}, + Year = {2019}} diff --git a/physics/docs/pdftxt/GFS_UGWPv0.txt b/physics/docs/pdftxt/GFS_UGWPv0.txt new file mode 100644 index 000000000..e6ea3b6f4 --- /dev/null +++ b/physics/docs/pdftxt/GFS_UGWPv0.txt @@ -0,0 +1,117 @@ +/** +\page GFS_UGWP_v0 CIRES Unified Gravity Wave Physics Scheme - 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). When the Version 0 of the Unified +Gravity Wave Physics (UGWP v0) is invoked, the subgrid OGWs and NGWs are +parameterized. For the subgrid-scale parameterization of OGWs, the UGWP +invokes a separate scheme, the \subpage GFS_GWDPS, which is used in the operational +Global Forecast System (GFS) version 15. + +The NGW physics scheme parameterizes the effects of non-stationary waves +unresolved by dynamical cores. 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 climate and weather models have been discussted in Alexander +et al. 2010 \cite alexander_et_al_2010, Geller et al. +2013 \cite geller_et_al_2013, and 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). + +Several studies have demonstrated the importance of NGW physics to improve +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 in global forecast models, the representation of +subgrid OGWs and NGWs has been implemented in the self-consistent manner using the +UGWP framework. + +The concept of UGWP was first proposed and implemented in the Unified +Forecast System (UFS)with model top at different levels by scientists from +the University of Colorado Cooperative Institute for Research in the +Environmental Sciences (CIRES) at NOAA's Space Weather Prediction Center (SWPC) +and from NOAA's Environmental Modeling Center (EMC) (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). 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 paramters for UGWP version 0 (UGWP v0) enables options for GW +effects, including momentum deposition (also called GW drag), heat +deposition, and mixing by eddy viscosity, conductivity and diffusion; +however, note that the eddy mixing effects induced by instability of GWs +are not activated in this version. + +Namelist paramters control the number of directional azimuths in which +waves can propagate, number of waves in a single direction, and the level +above the surface at which NGWs can be launched. Among the input parameters, +the GW efficiency factors reflect intermittency of wave excitation. +They should vary with horizontal resolution, reflecting the capability of +the dynamical core to resolve mesoscale wave activity with the enhancement +of model resolution. + +Prescribed distributions for vertical momentum flux (VMF) of NGWs have been employed +in global numerical weather prediction and reanalysis models 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). Subgrid GW sources can also be +parameterized to respond to 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 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 a configuration of the UFS weather model +using 127 levels with model top at approximately 80 km. + +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 impact of eddy mixing effects in the middle and upper atmosphere, +which is not included in this version, need to be tested, evaluated, and +orchestrated with the representation of the subgrid turbulent diffusion and +the numerical dissipation. + +The representation of subgrid GWs is particularly important for WAMs that +extend 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 gen_cires_ugwp + +*/ diff --git a/physics/docs/pdftxt/GFSv15p2_suite.txt b/physics/docs/pdftxt/GFSv15p2_suite.txt new file mode 100644 index 000000000..7d9f9d348 --- /dev/null +++ b/physics/docs/pdftxt/GFSv15p2_suite.txt @@ -0,0 +1,133 @@ +/** +\page GFS_v15p2_page GFS_v15p2 Suite + +\section gfs1_suite_overview Overview + +Suite GFS_v15p2 has the parameterizations used in the GFS v15 implemented operationally +in June 2019. + +The GFS_v15p2 physics suite uses the parameterizations in the following order: + - \ref GFS_RRTMG + - \ref GFS_SFCLYR + - \ref GFS_NSST + - \ref GFS_NOAH + - \ref GFS_SFCSICE + - \ref GFS_HEDMF + - \ref GFS_UGWP_v0 + - \ref GFS_RAYLEIGH + - \ref GFS_OZPHYS + - \ref GFS_H2OPHYS + - \ref GFS_SAMFdeep + - \ref GFS_SAMFshal + - \ref GFDL_cloud + - \ref GFS_CALPRECIPTYPE + +\section sdf_gfsv15p2 Suite Definition File +- For NEMSIO initialization data: \ref suite_FV3_GFS_v15p2_xml +- For GRIB2 initialization data: \ref suite_FV3_GFS_v15p2_no_nsst_xml + +\section gfs15p2_nml_opt_des Namelist + +- \b &gfs_physics_nml +\n \c fhzero = 6 +\n \c h2o_phys = .true. +\n \c ldiag3d = .false. +\n \c fhcyc = 24 +\n \c use_ufo = .true. +\n \c pre_rad = .false. +\n \c ncld = 5 +\n \c imp_physics = 11 +\n \c pdfcld = .false. +\n \c fhswr = 3600. +\n \c fhlwr = 3600. +\n \c ialb = 1 +\n \c iems = 1 +\n \c iaer = 111 +\n \c ico2 = 2 +\n \c isubc_sw = 2 +\n \c isubc_lw = 2 +\n \c isol = 2 +\n \c lwhtr = .true. +\n \c swhtr = .true. +\n \c cnvgwd = .true. +\n \c shal_cnv = .true. +\n \c cal_pre = .false. +\n \c redrag = .true. +\n \c dspheat = .true. +\n \c hybedmf = .true. +\n \c random_clds = .false. +\n \c trans_trac = .true. +\n \c cnvcld = .true. +\n \c imfshalcnv = 2 +\n \c imfdeepcnv = 2 +\n \c cdmbgwd = 3.5,0.25 [1.0,1.2] [0.2,2.5] [0.125,3.0] ! [C768] [C384] [C192] [C96]L64 +\n \c prslrd0 = 0. +\n \c ivegsrc = 1 +\n \c isot = 1 +\n \c debug = .false. +\n \c oz_phys = .F. +\n \c oz_phys_2015 = .T. +\n \c nstf_name = @[NSTF_NAME] +\n \c nst_anl = .true. +\n \c psautco = 0.0008,0.0005 +\n \c prautco = 0.00015,0.00015 +\n \c lgfdlmprad = .true. +\n \c effr_in = .true. +\n \c do_sppt = .false. +\n \c do_shum = .false. +\n \c do_skeb = .false. +\n \c do_sfcperts = .false. + +- \b &gfdl_cloud_microphysics_nml +\n \c sedi_transport = .true. +\n \c do_sedi_heat = .false. +\n \c rad_snow = .true. +\n \c rad_graupel = .true. +\n \c rad_rain = .true. +\n \c const_vi = .F. +\n \c const_vs = .F. +\n \c const_vg = .F. +\n \c const_vr = .F. +\n \c vi_max = 1. +\n \c vs_max = 2. +\n \c vg_max = 12. +\n \c vr_max = 12. +\n \c qi_lim = 1. +\n \c prog_ccn = .false. +\n \c do_qa = .true. +\n \c fast_sat_adj = .true. +\n \c tau_l2v = 225. +\n \c tau_v2l = 150. +\n \c tau_g2v = 900. +\n \c rthresh = 10.e-6 +\n \c dw_land = 0.16 +\n \c dw_ocean = 0.10 +\n \c ql_gen = 1.0e-3 +\n \c ql_mlt = 1.0e-3 +\n \c qi0_crt = 8.0E-5 +\n \c qs0_crt = 1.0e-3 +\n \c tau_i2s = 1000. +\n \c c_psaci = 0.05 +\n \c c_pgacs = 0.01 +\n \c rh_inc = 0.30 +\n \c rh_inr = 0.30 +\n \c rh_ins = 0.30 +\n \c ccn_l = 300. +\n \c ccn_o = 100. +\n \c c_paut = 0.5 +\n \c c_cracw = 0.8 +\n \c use_ppm = .false. +\n \c use_ccn = .true. +\n \c mono_prof = .true. +\n \c z_slope_liq = .true. +\n \c z_slope_ice = .true. +\n \c de_ice = .false. +\n \c fix_negative = .true. +\n \c icloud_f = 1 +\n \c mp_time = 150. + +\note nstf_name = \f$2,0,0,0,0[2,1,0,0,0]^1 [0,0,0,0,0]^2\f$ +- \f$^1\f$ This should be used when spinning up NSST fields in the absence of NSST data in initial conditions (see documentation for CHGRES) +- \f$^2\f$ This should be used when not using NSST at all (paired with \ref suite_FV3_GFS_v15p2_no_nsst_xml to turned off NSST option) + +*/ diff --git a/physics/docs/pdftxt/GFSv16beta_suite.txt b/physics/docs/pdftxt/GFSv16beta_suite.txt new file mode 100644 index 000000000..abba846f1 --- /dev/null +++ b/physics/docs/pdftxt/GFSv16beta_suite.txt @@ -0,0 +1,176 @@ +/** +\page GFS_v16beta_page GFS_v16beta Suite + +\section gfsv16beta_suite_overview Overview + +Version 16 of the Global Forecast System (GFS) will be implemented operationally by the NOAA +National Centers for Environmental Prediction (NCEP) in 2021. GFS_v16beta is a prototype of +the GFS_v16 suite. The main difference between the GFS_v15p2 and GFS_v16beta suites is the +replacement of the K-based EDMF PBL scheme with a moist TKE based one. + + +The GFS_v16beta physics suite uses the parameterizations in the following order: + - \ref GFS_RRTMG + - \ref GFS_SFCLYR + - \ref GFS_NSST + - \ref GFS_NOAH + - \ref GFS_SFCSICE + - \ref GFS_SATMEDMFVDIFQ + - \ref GFS_UGWP_v0 + - \ref GFS_RAYLEIGH + - \ref GFS_OZPHYS + - \ref GFS_H2OPHYS + - \ref GFS_SAMFdeep + - \ref GFS_SAMFshal + - \ref GFDL_cloud + - \ref GFS_CALPRECIPTYPE + +\section sdf_gfsv16b Suite Definition File +- For NEMSIO initialization data: \ref suite_FV3_GFS_v16beta_xml +- For GRIB2 initialization data: \ref suite_FV3_GFS_v16beta_no_nsst_xml + +\section gfs16beta_nml_opt_des Namelist + +- \b &gfs_physics_nml +\n \c fhzero = 6 +\n \c h2o_phys = .true. +\n \c ldiag3d = .false. +\n \c fhcyc = 24 +\n \c use_ufo = .true. +\n \c pre_rad = .false. +\n \c ncld = 5 +\n \c imp_physics = 11 +\n \c pdfcld = .false. +\n \c fhswr = 3600. +\n \c fhlwr = 3600. +\n \c ialb = 1 +\n \c iems = 1 +\n \c iaer = 5111 +\n \c icliq_sw = 2 +\n \c iovr_lw = 3 +\n \c iovr_sw = 3 +\n \c ico2 = 2 +\n \c isubc_sw = 2 +\n \c isubc_lw = 2 +\n \c isol = 2 +\n \c lwhtr = .true. +\n \c swhtr = .true. +\n \c cnvgwd = .true. +\n \c shal_cnv = .true. +\n \c cal_pre = .false. +\n \c redrag = .true. +\n \c dspheat = .true. +\n \c hybedmf = .false. +\n \c satmedmf = .true. +\n \c isatmedmf = 1 +\n \c lheatstrg = .true. +\n \c random_clds = .false. +\n \c trans_trac = .true. +\n \c cnvcld = .true. +\n \c imfshalcnv = 2 +\n \c imfdeepcnv = 2 +\n \c cdmbgwd = 4.0,0.15,1.0,1.0 [1.1,0.72,1.0,1.0] [0.23,1.5,1.0,1.0] [0.14,1.8,1.0,1.0] ! [C768] [C384] [C192] [C96]L64 +\n \c prslrd0 = 0. +\n \c ivegsrc = 1 +\n \c isot = 1 +\n \c lsoil = 4 +\n \c lsm = 1 +\n \c iopt_dveg = 1 +\n \c iopt_crs = 1 +\n \c iopt_btr = 1 +\n \c iopt_run = 1 +\n \c iopt_sfc = 1 +\n \c iopt_frz = 1 +\n \c iopt_inf = 1 +\n \c iopt_rad = 1 +\n \c iopt_alb = 2 +\n \c iopt_snf = 4 +\n \c iopt_tbot = 2 +\n \c iopt_stc = 1 +\n \c debug = .false. +\n \c oz_phys = .F. +\n \c oz_phys_2015 = .T. +\n \c nstf_name = @[NSTF_NAME] +\n \c nst_anl = .true. +\n \c psautco = 0.0008,0.0005 +\n \c prautco = 0.00015,0.00015 +\n \c lgfdlmprad = .true. +\n \c effr_in = .true. +\n \c ldiag_ugwp = .false. +\n \c do_ugwp = .false. +\n \c do_tofd = .true. +\n \c do_sppt = .false. +\n \c do_shum = .false. +\n \c do_skeb = .false. +\n \c do_sfcperts = .false. + + +- \b &gfdl_cloud_microphysics_nml +\n \c sedi_transport = .true. +\n \c do_sedi_heat = .false. +\n \c rad_snow = .true. +\n \c rad_graupel = .true. +\n \c rad_rain = .true. +\n \c const_vi = .F. +\n \c const_vs = .F. +\n \c const_vg = .F. +\n \c const_vr = .F. +\n \c vi_max = 1. +\n \c vs_max = 2. +\n \c vg_max = 12. +\n \c vr_max = 12. +\n \c qi_lim = 1. +\n \c prog_ccn = .false. +\n \c do_qa = .true. +\n \c fast_sat_adj = .true. +\n \c tau_l2v = 225. +\n \c tau_v2l = 150. +\n \c tau_g2v = 900. +\n \c rthresh = 10.e-6 +\n \c dw_land = 0.16 +\n \c dw_ocean = 0.10 +\n \c ql_gen = 1.0e-3 +\n \c ql_mlt = 1.0e-3 +\n \c qi0_crt = 8.0E-5 +\n \c qs0_crt = 1.0e-3 +\n \c tau_i2s = 1000. +\n \c c_psaci = 0.05 +\n \c c_pgacs = 0.01 +\n \c rh_inc = 0.30 +\n \c rh_inr = 0.30 +\n \c rh_ins = 0.30 +\n \c ccn_l = 300. +\n \c ccn_o = 100. +\n \c c_paut = 0.5 +\n \c c_cracw = 0.8 +\n \c use_ppm = .false. +\n \c use_ccn = .true. +\n \c mono_prof = .true. +\n \c z_slope_liq = .true. +\n \c z_slope_ice = .true. +\n \c de_ice = .false. +\n \c fix_negative = .true. +\n \c icloud_f = 1 +\n \c mp_time = 150. +\n \c reiflag = 2 + + +- \b &cires_ugwp_nml +\n \c knob_ugwp_solver = 2 +\n \c knob_ugwp_source = 1,1,0,0 +\n \c knob_ugwp_wvspec = 1,25,25,25 +\n \c knob_ugwp_azdir = 2,4,4,4 +\n \c knob_ugwp_stoch = 0,0,0,0 +\n \c knob_ugwp_effac = 1,1,1,1 +\n \c knob_ugwp_doaxyz = 1 +\n \c knob_ugwp_doheat = 1 +\n \c knob_ugwp_dokdis = 1 +\n \c knob_ugwp_ndx4lh = 1 +\n \c knob_ugwp_version = 0 +\n \c launch_level = 27 + +\note nstf_name = \f$2,0,0,0,0[2,1,0,0,0]^1 [0,0,0,0,0]^2\f$ +- \f$^1\f$ This should be used when spinning up NSST fields in the absence of NSST data in initial conditions (see documentation for CHGRES) +- \f$^2\f$ This should be used when not using NSST at all (paired with \ref suite_FV3_GFS_v16beta_no_nsst_xml to turned off NSST option) + +*/ diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt new file mode 100644 index 000000000..f12b0c366 --- /dev/null +++ b/physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt @@ -0,0 +1,101 @@ +/** +\page suite_FV3_GFS_v15p2_xml suite_FV3_GFS_v15p2.xml + +\code + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + dcyc2t3_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + hedmf + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + GFS_DCNV_generic_pre + get_phi_fv3 + GFS_suite_interstitial_3 + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + +\endcode + +*/ diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt new file mode 100644 index 000000000..cd29eecdb --- /dev/null +++ b/physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt @@ -0,0 +1,100 @@ +/** +\page suite_FV3_GFS_v15p2_no_nsst_xml suite_FV3_GFS_v15p2_no_nsst.xml + +\code + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_ocean + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + dcyc2t3_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + hedmf + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + +\endcode + +*/ + diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt new file mode 100644 index 000000000..722224988 --- /dev/null +++ b/physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt @@ -0,0 +1,101 @@ +/** +\page suite_FV3_GFS_v16beta_xml suite_FV3_GFS_v16beta.xml + +\code + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + dcyc2t3_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + GFS_DCNV_generic_pre + get_phi_fv3 + GFS_suite_interstitial_3 + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + +\endcode + +*/ diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt new file mode 100644 index 000000000..adeb4352a --- /dev/null +++ b/physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt @@ -0,0 +1,98 @@ +/** +\page suite_FV3_GFS_v16beta_no_nsst_xml suite_FV3_GFS_v16beta_no_nsst.xml + +\code + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_ocean + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + dcyc2t3_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + +\endcode +*/ diff --git a/physics/docs/pdftxt/suite_input.nml.txt b/physics/docs/pdftxt/suite_input.nml.txt index fcb55d84f..688eb5d07 100644 --- a/physics/docs/pdftxt/suite_input.nml.txt +++ b/physics/docs/pdftxt/suite_input.nml.txt @@ -389,42 +389,61 @@ and how stochastic perturbations are used in the Noah Land Surface Model. skebint compns_stochy_mod 0 \b &gfdl_cloud_microphysics_nml sedi_transport gfdl_cloud_microphys_mod logical flag for turning on horizontal momentum transport during sedimentation .true. +do_sedi_w gfdl_cloud_microphys_mod \a .true. to turn on vertical motion transport during sedimentation. (not supported in GFS physics) .false. do_sedi_heat gfdl_cloud_microphys_mod logical flag for turning on horizontal heat transport during sedimentation .true. rad_snow gfdl_cloud_microphys_mod logical flag for considering snow in cloud fraction calculation .true. rad_graupel gfdl_cloud_microphys_mod logical flag for considering graupel in cloud fraction calculation .true. rad_rain gfdl_cloud_microphys_mod logical flag for considering rain in cloud fraction calculation .true. +cld_min gfdl_cloud_microphys_mod minimum cloud fraction. If total cloud condensate exceeds 1.0e-6 kg/kg, cloud fraction cannot be less than \p cld_min 0.05 const_vi gfdl_cloud_microphys_mod logical flag for using constant cloud ice fall speed .false. const_vs gfdl_cloud_microphys_mod logical flag for using constant snow fall speed .false. const_vg gfdl_cloud_microphys_mod logical flag for using constant graupel fall speed .false. const_vr gfdl_cloud_microphys_mod logical flag for using constant rain fall speed .false. +vi_fac gfdl_cloud_microphys_mod tunable factor for cloud ice fall or the constant cloud ice fall speed when \p const_vi is .true. 1. +vr_fac gfdl_cloud_microphys_mod tunable factor for rain fall or the constant rain fall speed when \p const_vr is .true. 1. +vs_fac gfdl_cloud_microphys_mod tunable factor for snow fall or the constant snow fall speed when \p const_vs is .true. 1. +vg_fac gfdl_cloud_microphys_mod tunable factor for graupel fall or the constant graupel fall speed when \p const_vg is .true. 1. vi_max gfdl_cloud_microphys_mod maximum fall speed for cloud ice 0.5 vs_max gfdl_cloud_microphys_mod maximum fall speed for snow 5.0 vg_max gfdl_cloud_microphys_mod maximum fall speed for graupel 8.0 vr_max gfdl_cloud_microphys_mod maximum fall speed for rain 12.0 qi_lim gfdl_cloud_microphys_mod cloud ice limiter to prevent large ice built up in cloud ice freezing and deposition 1. prog_ccn gfdl_cloud_microphys_mod logical flag for activating prognostic CCN (not supported in GFS Physics) .false. -do_qa gfdl_cloud_microphys_mod logical flag for activating inline cloud fraction diagnosis in fast saturation adjustment .true. -fast_sat_adj gfdl_cloud_microphys_mod logical flag for adjusting cloud water evaporation/freezing, cloud ice deposition when fast saturation adjustment is activated .true. +do_qa gfdl_cloud_microphys_mod \a .true. to activate inline cloud fraction diagnosis in fast saturation adjustment. \a .false. to activate inline cloud fraction diagnosis in major cloud microphysics .true. +fast_sat_adj gfdl_cloud_microphys_mod logical flag for adjusting cloud water evaporation (cloud water -> water vapor), cloud water freezing (cloud water -> cloud ice), cloud ice deposition (water vapor -> cloud ice) when fast saturation adjustment is activated (\b do_sat_adj = .true. in \b fv_core_nml block) .true. tau_l2v gfdl_cloud_microphys_mod time scale for evaporation of cloud water to water vapor. Increasing(decreasing) \p tau_l2v can decrease(boost) deposition of cloud water to water vapor 300. tau_v2l gfdl_cloud_microphys_mod time scale for condensation of water vapor to cloud water. Increasing(decreasing) \p tau_v2l can decrease(boost) condensation of water vapor to cloud water 150. tau_g2v gfdl_cloud_microphys_mod time scale for sublimation of graupel to water vapor. Increasing(decreasing) \p tau_g2v can decrease(boost) sublimation of graupel to water vapor 900. +tau_g2r gfdl_cloud_microphys_mod time scale for graupel melting. Increasing(decreasing) \p tau_g2r can decrease(boost) melting of graupel to rain (graupel-> rain) 600. +tau_v2g gfdl_cloud_microphys_mod time scale for deposition of water vapor to graupel. Increasing(decreasing) \p tau_v2g can decrease(boost) deposition of water vapor to graupel (water vapor -> graupel) 21600. +tau_l2r gfdl_cloud_microphys_mod time scale for autoconversion of cloud water to rain. Increasing(decreasing) \p tau_l2r can decrese(boost) autoconversion of cloud water to rain (cloud water -> rain) 900. +tau_r2g gfdl_cloud_microphys_mod time scale for freezing of rain to graupel. Increasing(decreasing) \p tau_r2g can decrease(boost) freezing of rain to graupel (rain->graupel) 900. +tau_i2s gfdl_cloud_microphys_mod time scale for autoconversion of cloud ice to snow. Increasing(decreasing) \p tau_i2s can decrease(boost) autoconversion of cloud ice to snow (cloud ice -> snow) 1000. +tau_imlt gfdl_cloud_microphys_mod time scale for cloud ice melting. Increasing(decreasing) \p tau_imlt can decrease(boost) melting of cloud ice to cloud water or rain (cloud ice -> cloud water or rain) 600. +tau_smlt gfdl_cloud_microphys_mod time scale for snow melting. Increasing(decreasing) \p tau_smlt can decrease(boost) melting of snow to cloud water or rain (snow-> cloud water or rain) 900. rthresh gfdl_cloud_microphys_mod critical cloud water radius for autoconversion (cloud water -> rain). Increasing(decreasing) of \p rthresh makes the autoconversion harder(easier) 10.0e-6 dw_land gfdl_cloud_microphys_mod base value for subgrid deviation/variability over land 0.20 dw_ocean gfdl_cloud_microphys_mod base value for subgrid deviation/variability over ocean 0.10 ql_gen gfdl_cloud_microphys_mod maximum value for cloud water generated from condensation of water vapor (water vapor-> cloud water) 1.0e-3 -ql_mlt gfdl_cloud_microphys_mod maximum value of cloud water allowed from melted cloud ice (cloud ice -> cloud water or rain) 2.0e-3 -qi0_crt gfdl_cloud_microphys_mod threshold of cloud ice to snow autoconversion (cloud ice -> snow) 1.0e-4 -qs0_crt gfdl_cloud_microphys_mod threshold of snow to graupel autoconversion (snow -> graupel) 1.0e-3 -tau_i2s gfdl_cloud_microphys_mod time scale for autoconversion of cloud ice to snow 1000. -c_psaci gfdl_cloud_microphys_mod accretion efficiency of cloud ice to snow 0.02 -c_pgacs gfdl_cloud_microphys_mod accretion efficiency of snow to graupel 2.0e-3 +qi_gen gfdl_cloud_microphys_mod maximum value of cloud ice generated from deposition of water vapor (water vapor->cloud ice) or freezing(cloud water -> cloud ice). Increasing(decreasing) \p qi_gen can increas(decrease) cloud ice 1.82e-6 +ql_mlt gfdl_cloud_microphys_mod maximum value of cloud water allowed from melted cloud ice (cloud ice -> cloud water or rain). Exceedance of which will become rain. Increasing(decreasing) \p ql_mlt can increase(decrease) cloud water and decrease(increase) rain 2.0e-3 +qs_mlt gfdl_cloud_microphys_mod maximum value of cloud water allowed from melted snow (snow -> cloud water or rain). Exceedance of which will become rain. Increasing(decreasing) \p qs_mlt can increas(decrease) cloud water and decrease (increase) rain 1.0e-6 +ql0_max gfdl_cloud_microphys_mod threshold of cloud water to rain autoconversion (cloud water -> rain). Increasing(decreasing) \p ql0_max can increase(decrease) rain and decrease(increase) cloud water 2.0e-3 +qi0_max gfdl_cloud_microphys_mod maximum value of cloud ice generated from other sources like convection. Exceedance of which will become snow. Increasing(decreasing) \p qi0_max can increase(decrease) cloud ice and decrease(increase) snow 1.0e-4 +qi0_crt gfdl_cloud_microphys_mod threshold of cloud ice to snow autoconversion (cloud ice -> snow). Increasing(decreasing) \p qi0_crt can increase(decrease) cloud ice and decrease(increase) snow 1.0e-4 +qs0_crt gfdl_cloud_microphys_mod threshold of snow to graupel autoconversion (snow -> graupel). Increasing(decreasing) \p qs0_crt can increase(decrease) snow and decrease(increase) graupel 1.0e-3 +qc_crt gfdl_cloud_microphys_mod minimum value of cloud condensate to allow partial cloudiness. Partial cloud can only exist when total cloud condensate exceeds \p qc_crt 5.0e-8 +c_psaci gfdl_cloud_microphys_mod accretion efficiency of cloud ice to snow (cloud ice -> snow). Increasing(decreasing) of \p c_psaci can boost(decrease) the accretion of cloud ice to snow 0.02 +c_pgacs gfdl_cloud_microphys_mod accretion efficiency of snow to graupel (snow -> graupel). Increasing(decreasing) of \p c_pgacs can boost(decrease) the accretion of snow to graupel 2.0e-3 rh_inc gfdl_cloud_microphys_mod relative humidity increment for complete evaporation of cloud water and cloud ice 0.25 rh_inr gfdl_cloud_microphys_mod relative humidity increment for sublimation of snow 0.25 rh_ins gfdl_cloud_microphys_mod relative humidity increment for minimum evaporation of rain 0.25 -ccn_l gfdl_cloud_microphys_mod base CCN over land \f$cm^{-3}\f$ 270. -ccn_o gfdl_cloud_microphys_mod base CCN over ocean \f$cm^{-3}\f$ 90. -c_paut gfdl_cloud_microphys_mod autoconversion efficiency of cloud water to rain 0.55 -c_cracw gfdl_cloud_microphys_mod accretion efficiency of cloud water to rain 0.9 +rthresh gfdl_cloud_microphys_mod critical cloud water radius for autoconversion(cloud water->rain). Increasing(decreasing) of \p rthresh makes the autoconversion harder(easier) 1.0e-5 +ccn_l gfdl_cloud_microphys_mod base CCN over land. Increasing(decreasing) \p ccn_l can on the one hand boost(decrease) the autoconversion of cloud water to rain, on the other hand make the autoconversion harder(easier). The unit is \f$cm^{-3}\f$ 270. +ccn_o gfdl_cloud_microphys_mod base CCN over ocean. Increasing(decreasing) \p ccn_o can on the one hand boost(decrease) the autoconversion of cloud water to rain, on the other hand make the autoconversion harder(easier). The unit is \f$cm^{-3}\f$ 90. +c_paut gfdl_cloud_microphys_mod autoconversion efficiency of cloud water to rain (cloud water -> rain). Increasing(decreasing) of \p c_paut can boost(decrease) the autoconversion of cloud water to rain 0.55 +c_cracw gfdl_cloud_microphys_mod accretion efficiency of cloud water to rain (cloud water -> rain). Increasing(decreasing) of \p c_cracw can boost(decrease) the accretion of cloud water to rain 0.9 +sat_adj0 gfdl_cloud_microphys_mod adjust factor for condensation of water vapor to cloud water (water vapor->cloud water) and deposition of water vapor to cloud ice 0.9 use_ppm gfdl_cloud_microphys_mod \e true to use PPM fall scheme; \e false to use time-implicit monotonic fall scheme .false. use_ccn gfdl_cloud_microphys_mod \e true to compute prescribed CCN. It should be .true. when \p prog_ccn = .false. .false. mono_prof gfdl_cloud_microphys_mod \e true to turn on terminal fall with monotonic PPM scheme. This is used together with \p use_ppm=.true. .true. @@ -433,6 +452,68 @@ and how stochastic perturbations are used in the Noah Land Surface Model. de_ice gfdl_cloud_microphys_mod \e true to convert excessive cloud ice to snow to prevent ice over-built from other sources like convection scheme (not supported in GFS physics) .false. fix_negative gfdl_cloud_microphys_mod \e true to fix negative water species using nearby points .false. icloud_f gfdl_cloud_microphys_mod flag (0,1,or 2) for cloud fraction diagnostic scheme 0 -mp_time gfdl_cloud_microphys_mod time step of GFDL cloud microphysics 150. +irain_f gfdl_cloud_microphys_mod flag (0 or 1) for cloud water autoconversion to rain scheme. 0: with subgrid variability; 1: no subgrid variability 0 +mp_time gfdl_cloud_microphys_mod time step of GFDL cloud microphysics (MP). If \p mp_time isn't divisible by physics time step or is larger than physics time step, the actual MP time step becomes \p dt/NINT[dt/MIN(dt,mp_time)] 150. +alin gfdl_cloud_microphys_mod parameter \a a in Lin et al.(1983). Constant in empirical formula for \f$U_R\f$. Increasing(decreasing) \p alin can boost(decrease) accretion of cloud water by rain and rain evaporation 842. +clin gfdl_cloud_microphys_mod parameter \a c in Lin et al.(1983). Constant in empirical formula for \f$U_S\f$. Increasing(decreasing) \p clin can boost(decrease) accretion of cloud water by snow, accretion of cloud ice by snow, snow sublimation and deposition, and snow melting 4.8 +t_min gfdl_cloud_microphys_mod temperature threshold for instant deposition. Deposit all water vapor to cloud ice when temperature is lower than \p t_min 178. +t_sub gfdl_cloud_microphys_mod temperature threshold for sublimation. Cloud ice, snow or graupel stops(starts) sublimation when temperature is lower(higher) then \p t_sub 184. +mp_print gfdl_cloud_microphys_mod \a .true. to turn on GFDL cloud microphysics debugging print out. (not supported in GFS physics) .false. +\b &cires_ugwp_nml +knob_ugwp_version cires_ugwp_module parameter selects a version of the UGWP implementation in FV3GFS-127L \n +
    +
  • 0: default version delivered to EMC in Jan 2019 for implementation +
  • 1: version of UGWP under development that plans to consider the physics-based sources of NGWs (\b knob_ugwp_wvspec [2:4]), options for stochastic and deterministic excitation of waves (\b knob_ugwp_stoch), and switches between different UGWP schemes (\b knob_ugwp_solver) +
+ 0 +knob_ugwp_doaxyz cires_ugwp_module parameter controls application of the momentum deposition for NGW-schemes \n +
    +
  • 0: the momentum tendencies due to NGWs are calculated, but tendencies do not change the horizontal winds +
  • 1: default value; it changes the horizontal momentum tendencies and horizontal winds +
+ 1 +knob_ugwp_doheat cires_ugwp_module parameter controls application of the heat deposition for NGW-schemes \n +
    +
  • 0: the temperature tendencies due to NGWs are calculated but tendencies do not change the temperature state +
  • 1: default value; it changes the temperature tendencies and kinetic temperature +
+ 1 +knob_ugwp_dokdis cires_ugwp_module parameter controls application of the eddy diffusion due to instability of NGWs \n +
    +
  • 0: the eddy diffusion tendencies due to NGWs are calculated but tendencies do not change the model state vector +
  • 1: it computes eddy diffusion coefficient due to instability of NGWs; in UGWP v0, eddy viscosity, heat conductivity and tracer diffusion are not activated +
+ 0 +knob_ugwp_solver cires_ugwp_module parameter controls the selection of UGWP-solvers(wave propagation, dissipation and wave breaking) for NGWs \n +
    +
  • 1: represents the discrete multi-wave solver with background dissipation and linear wave saturation +
  • 2: represents the spectral deterministic solver with background dissipation and spectral saturation +
  • 3: represents the discrete multi-wave solver with the background dissipation, extension of Alexander sand Dunkerton (1999) +
  • 4: represents the spectral solver with background dissipation, extension of Doppler Spread Theory of Hines (1997) +
+ 1 +knob_ugwp_ndx4lh cires_ugwp_module parameter controls the selection of the horizontal wavenumber(wavelength) for NGW schemes \n +
    +
  • 1: selects the \f$4xdx\f$ sub-grid wavelength, where dx is the horizontal resolution of the model configuration (C96-400km; C768-52km) +
+ 2 +knob_ugwp_wvspec cires_ugwp_module four-dimensional array defines number of waves in each arimuthal propagation (as defined by knob_ugwp_azdir) for GWs excited due to the following four sources: \n + (1) sub-grid orography (\b knob_ugwp_wvspec[1]=1), \n + (2) convective (\b knob_ugwp_wvspec[2]=25), \n + (3) frontal (\b knob_ugwp_wvspec[3]=25) activity, \n + (4) \b knob_ugwp_wvspec[4] represents number of wave excited by dynamical imbalances that may mimic both convective and front-jet mechanisms of GW triggering. \n + In UGWP v0, first two elements of the array, \b knob_ugwp_wvspec(1:2), control number of waves for stationary (OGW) and nonstationary waves (NGWs). + 1,32,32,32 +knob_ugwp_azdir cires_ugwp_module four-dimensional array that defines number of azimuths for propagation of GWs triggered by four types of physics-based sources (orography, convection, front-jets, and dynamical imbalance). In UGWP v0, first two elements of the array, \b knob_ugwp_azdir(1:2), control number of azimuths for OGW and NGWs respectively. + 2,4,4,4 +knob_ugwp_stoch cires_ugwp_module four-dimensional array that control stochastic selection of GWs triggered by four types of physics-based sources. \n + Default values:0,0,0,0 - reflect determinstic selection of GW parameters without stochastic selection + 0,0,0,0 +knob_ugwp_effac cires_ugwp_module four-dimensional array that control efficiency of GWs triggerd by four types of physics-based sources. \n + Default values: 1.,1.,1.,1. - reflect that calculated GW-tendencies will be applied for the model state. + 1.,1.,1.,1. +launch_level cires_ugwp_module parameter has been introduced by EMC during implementation. It defines the interface model level from the surface at which NGWs are launched. \n + Default value for FV3GFS-64L, launch_level=25 and for FV3GFS-128L, launch_level=52. + 55 */ diff --git a/physics/docs/ufs_doxyfile b/physics/docs/ufs_doxyfile new file mode 100644 index 000000000..1b77aafb6 --- /dev/null +++ b/physics/docs/ufs_doxyfile @@ -0,0 +1,464 @@ +# Doxyfile 1.8.11 +DOXYFILE_ENCODING = UTF-8 +PROJECT_NAME = "CCPP Scientific Documentation" +PROJECT_NUMBER = "" +PROJECT_BRIEF = "v4.0" +PROJECT_LOGO = img/dtc_logo.png +OUTPUT_DIRECTORY = doc +CREATE_SUBDIRS = NO +ALLOW_UNICODE_NAMES = NO +OUTPUT_LANGUAGE = English +BRIEF_MEMBER_DESC = YES +REPEAT_BRIEF = NO +ABBREVIATE_BRIEF = +ALWAYS_DETAILED_SEC = NO +INLINE_INHERITED_MEMB = NO +FULL_PATH_NAMES = NO +STRIP_FROM_PATH = +STRIP_FROM_INC_PATH = +SHORT_NAMES = NO +JAVADOC_AUTOBRIEF = NO +QT_AUTOBRIEF = NO +MULTILINE_CPP_IS_BRIEF = NO +INHERIT_DOCS = YES +SEPARATE_MEMBER_PAGES = YES +TAB_SIZE = 4 +ALIASES = +TCL_SUBST = +OPTIMIZE_OUTPUT_FOR_C = NO +OPTIMIZE_OUTPUT_JAVA = NO +OPTIMIZE_FOR_FORTRAN = YES +OPTIMIZE_OUTPUT_VHDL = NO +EXTENSION_MAPPING = .f=FortranFree \ + .F=FortranFree \ + .F90=FortranFree \ + .f90=FortranFree +MARKDOWN_SUPPORT = YES +AUTOLINK_SUPPORT = YES +BUILTIN_STL_SUPPORT = NO +CPP_CLI_SUPPORT = NO +SIP_SUPPORT = NO +IDL_PROPERTY_SUPPORT = YES +DISTRIBUTE_GROUP_DOC = YES +GROUP_NESTED_COMPOUNDS = NO +SUBGROUPING = YES +INLINE_GROUPED_CLASSES = NO +INLINE_SIMPLE_STRUCTS = NO +TYPEDEF_HIDES_STRUCT = YES +LOOKUP_CACHE_SIZE = 0 +EXTRACT_ALL = YES +EXTRACT_PRIVATE = YES +EXTRACT_PACKAGE = YES +EXTRACT_STATIC = YES +EXTRACT_LOCAL_CLASSES = YES +EXTRACT_LOCAL_METHODS = YES +EXTRACT_ANON_NSPACES = YES +HIDE_UNDOC_MEMBERS = NO +HIDE_UNDOC_CLASSES = NO +HIDE_FRIEND_COMPOUNDS = NO +HIDE_IN_BODY_DOCS = NO +INTERNAL_DOCS = YES + +CASE_SENSE_NAMES = NO + +HIDE_SCOPE_NAMES = NO + +HIDE_COMPOUND_REFERENCE= NO + +SHOW_INCLUDE_FILES = NO + +SHOW_GROUPED_MEMB_INC = NO + +FORCE_LOCAL_INCLUDES = NO + +INLINE_INFO = YES + +SORT_MEMBER_DOCS = NO + +SORT_BRIEF_DOCS = NO +SORT_MEMBERS_CTORS_1ST = NO +SORT_GROUP_NAMES = NO +SORT_BY_SCOPE_NAME = NO +STRICT_PROTO_MATCHING = NO +GENERATE_TODOLIST = YES +GENERATE_TESTLIST = YES +GENERATE_BUGLIST = YES +GENERATE_DEPRECATEDLIST= YES +ENABLED_SECTIONS = YES +MAX_INITIALIZER_LINES = 30 +SHOW_USED_FILES = YES +SHOW_FILES = YES +SHOW_NAMESPACES = YES +FILE_VERSION_FILTER = +LAYOUT_FILE = ccpp_dox_layout.xml +CITE_BIB_FILES = library.bib +QUIET = NO +WARNINGS = YES +WARN_IF_UNDOCUMENTED = NO +WARN_IF_DOC_ERROR = YES +WARN_NO_PARAMDOC = NO +WARN_AS_ERROR = NO +WARN_FORMAT = +WARN_LOGFILE = +INPUT = pdftxt/mainpage.txt \ + pdftxt/all_shemes_list.txt \ + pdftxt/GFSv15p2_suite.txt \ + pdftxt/suite_FV3_GFS_v15p2.xml.txt \ + pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt \ + pdftxt/GFSv16beta_suite.txt \ + pdftxt/suite_FV3_GFS_v16beta.xml.txt \ + pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt \ + pdftxt/GSD_adv_suite.txt \ + pdftxt/CPT_adv_suite.txt \ + pdftxt/GFS_RRTMG.txt \ + pdftxt/GFS_SFCLYR.txt \ + pdftxt/GFS_NSST.txt \ + pdftxt/GFS_NOAH.txt \ + pdftxt/GFS_SFCSICE.txt \ + pdftxt/GFS_HEDMF.txt \ + pdftxt/GFS_SATMEDMFVDIFQ.txt \ +## pdftxt/GFS_NoahMP.txt \ + pdftxt/GFS_UGWPv0.txt \ + pdftxt/GFS_GWDPS.txt \ + pdftxt/GFS_OZPHYS.txt \ + pdftxt/GFS_H2OPHYS.txt \ + pdftxt/GFS_RAYLEIGH.txt \ + pdftxt/GFS_SAMF.txt \ + pdftxt/GFS_SAMFdeep.txt \ + pdftxt/GFS_SAMFshal.txt \ + pdftxt/GFDL_cloud.txt \ + pdftxt/GFS_CALPRECIPTYPE.txt \ +### pdftxt/rad_cld.txt \ + pdftxt/CPT_CSAW.txt \ + pdftxt/CPT_MG3.txt \ + pdftxt/GSD_MYNN_EDMF.txt \ + pdftxt/GSD_CU_GF_deep.txt \ + pdftxt/GSD_RUCLSM.txt \ + pdftxt/GSD_THOMPSON.txt \ +### pdftxt/GFSphys_namelist.txt \ +### pdftxt/GFS_STOCHY_PHYS.txt \ + pdftxt/suite_input.nml.txt \ +### in-core MP + ../gfdl_fv_sat_adj.F90 \ +### time_vary + ../GFS_time_vary_pre.fv3.F90 \ + ../GFS_rad_time_vary.fv3.F90 \ + ../GFS_phys_time_vary.fv3.F90 \ + ../ozne_def.f \ + ../ozinterp.f90 \ + ../h2o_def.f \ + ../h2ointerp.f90 \ + ../aerclm_def.F \ + ../aerinterp.F90 \ + ../iccn_def.F \ + ../iccninterp.F90 \ + ../sfcsub.F \ + ../gcycle.F90 \ +### Radiation +### ../GFS_rrtmg_pre.F90 \ +### ../rrtmg_sw_pre.F90 \ + ../radsw_main.f \ +### ../rrtmg_sw_post.F90 \ +### ../rrtmg_lw_pre.F90 \ + ../radlw_main.f \ +### ../rrtmg_lw_post.F90 \ + ../radiation_aerosols.f \ + ../radiation_astronomy.f \ + ../radiation_clouds.f \ + ../radiation_gases.f \ + ../radiation_surface.f \ + ../radlw_param.f \ + ../radlw_datatb.f \ + ../radsw_param.f \ + ../radsw_datatb.f \ + ../dcyc2.f \ +### Land Surface + ../sfc_diff.f \ + ../sfc_nst.f \ + ../sfc_ocean.F \ + ../module_nst_model.f90 \ + ../module_nst_parameters.f90 \ + ../module_nst_water_prop.f90 \ + ../sfc_drv.f \ + ../sflx.f \ + ../namelist_soilveg.f \ + ../set_soilveg.f \ +### Sea Ice Surface + ../sfc_sice.f \ +### PBL + ../moninedmf.f \ + ../mfpbl.f \ + ../tridi.f \ +### satmedmf +## ../satmedmfvdif.F \ + ../satmedmfvdifq.F \ + ../mfpbltq.f \ + ../mfscuq.f \ + ../tridi.f \ +### Orographic Gravity Wave + ../GFS_GWD_generic.F90 \ + ../cires_ugwp.F90 \ + ../gwdps.f \ + ../ugwp_driver_v0.F \ + ../cires_ugwp_triggers.F90 \ + ../cires_ugwp_module.F90 \ + ../cires_ugwp_utils.F90 \ + ../cires_ugwp_solvers.F90 \ +### ../cires_ugwp_post.F90 \ +### ../cires_ugwp_initialize.F90 \ + ../cires_vert_wmsdis.F90 \ + ../cires_vert_orodis.F90 \ + ../cires_vert_lsatdis.F90 \ +### Rayleigh Dampling + ../rayleigh_damp.f \ +### Prognostic Ozone + ../ozphys_2015.f \ +### ../ozphys.f \ +### stratospheric h2o + ../h2ophys.f \ +### Deep Convection + ../samfdeepcnv.f \ +### Convective Gravity Wave +### ../gwdc.f \ +### Shallow Convection + ../samfshalcnv.f \ + ../cnvc90.f \ +### Microphysics +### ../gscond.f \ +### ../precpd.f \ + ../module_bfmicrophysics.f \ +### GFDL cloud MP + ../gfdl_cloud_microphys.F90 \ + ../module_gfdl_cloud_microphys.F90 \ +### + ../GFS_MP_generic.F90 \ + ../calpreciptype.f90 \ +### stochy + ../GFS_stochastics.F90 \ +### ../surface_perturbation.F90 \ +### ../../stochastic_physics/stochastic_physics.F90 \ +### CPT + ../m_micro.F90 \ +### ../micro_mg2_0.F90 \ + ../micro_mg3_0.F90 \ + ../micro_mg_utils.F90 \ + ../cldmacro.F \ + ../aer_cloud.F \ + ../cldwat2m_micro.F \ + ../wv_saturation.F \ + ../cs_conv_aw_adj.F90 \ + ../cs_conv.F90 \ +### GSD + ../cu_gf_driver.F90 \ + ../cu_gf_deep.F90 \ + ../cu_gf_sh.F90 \ + ../module_MYNNrad_pre.F90 \ + ../module_MYNNrad_post.F90 \ + ../module_MYNNPBL_wrapper.F90 \ + ../module_bl_mynn.F90 \ +### ../module_MYNNSFC_wrapper.F90 \ +### ../module_sf_mynn.F90 \ + ../sfc_drv_ruc.F90 \ + ../module_sf_ruclsm.F90 \ + ../namelist_soilveg_ruc.F90 \ + ../set_soilveg_ruc.F90 \ + ../module_soil_pre.F90 \ + ../mp_thompson_pre.F90 \ + ../module_mp_thompson_make_number_concentrations.F90 \ + ../mp_thompson.F90 \ + ../module_mp_thompson.F90 \ + ../module_mp_radar.F90 \ + ../mp_thompson_post.F90 \ +### utils + ../funcphys.f90 \ + ../physparam.f \ + ../physcons.F90 \ + ../radcons.f90 \ + ../mersenne_twister.f +INPUT_ENCODING = UTF-8 +FILE_PATTERNS = *.f \ + *.F \ + *.F90 \ + *.f90 \ + *.nml \ + *.txt +RECURSIVE = YES +EXCLUDE = +EXCLUDE_SYMLINKS = NO +EXCLUDE_PATTERNS = +EXCLUDE_SYMBOLS = +EXAMPLE_PATH = ./ +EXAMPLE_PATTERNS = +EXAMPLE_RECURSIVE = NO +IMAGE_PATH = img +INPUT_FILTER = +FILTER_PATTERNS = +FILTER_SOURCE_FILES = NO +FILTER_SOURCE_PATTERNS = +USE_MDFILE_AS_MAINPAGE = +SOURCE_BROWSER = NO +INLINE_SOURCES = NO +STRIP_CODE_COMMENTS = YES +REFERENCED_BY_RELATION = YES +REFERENCES_RELATION = YES +REFERENCES_LINK_SOURCE = YES +SOURCE_TOOLTIPS = YES +USE_HTAGS = NO +VERBATIM_HEADERS = YES +#CLANG_ASSISTED_PARSING = NO +#CLANG_OPTIONS = +ALPHABETICAL_INDEX = NO +COLS_IN_ALPHA_INDEX = 5 +IGNORE_PREFIX = +GENERATE_HTML = YES +HTML_OUTPUT = html +HTML_FILE_EXTENSION = .html +HTML_HEADER = +HTML_FOOTER = +HTML_STYLESHEET = +HTML_EXTRA_STYLESHEET = ccpp_dox_extra_style.css +HTML_EXTRA_FILES = +HTML_COLORSTYLE_HUE = 220 +HTML_COLORSTYLE_SAT = 100 +HTML_COLORSTYLE_GAMMA = 80 +HTML_TIMESTAMP = NO +HTML_DYNAMIC_SECTIONS = NO +HTML_INDEX_NUM_ENTRIES = 100 +GENERATE_DOCSET = NO +DOCSET_FEEDNAME = "Doxygen generated docs" +DOCSET_BUNDLE_ID = org.doxygen.Project +DOCSET_PUBLISHER_ID = org.doxygen.Publisher +DOCSET_PUBLISHER_NAME = Publisher +GENERATE_HTMLHELP = NO +CHM_FILE = +HHC_LOCATION = +GENERATE_CHI = NO +CHM_INDEX_ENCODING = +BINARY_TOC = NO +TOC_EXPAND = NO +GENERATE_QHP = NO +QCH_FILE = +QHP_NAMESPACE = org.doxygen.Project +QHP_VIRTUAL_FOLDER = doc +QHP_CUST_FILTER_NAME = +QHP_CUST_FILTER_ATTRS = +QHP_SECT_FILTER_ATTRS = +QHG_LOCATION = +GENERATE_ECLIPSEHELP = NO +ECLIPSE_DOC_ID = org.doxygen.Project +DISABLE_INDEX = YES +GENERATE_TREEVIEW = YES +ENUM_VALUES_PER_LINE = 4 +TREEVIEW_WIDTH = 250 +EXT_LINKS_IN_WINDOW = NO +FORMULA_FONTSIZE = 10 +FORMULA_TRANSPARENT = YES +USE_MATHJAX = YES +MATHJAX_FORMAT = HTML-CSS +MATHJAX_RELPATH = https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2 +MATHJAX_EXTENSIONS = +MATHJAX_CODEFILE = +SEARCHENGINE = YES +SERVER_BASED_SEARCH = NO +EXTERNAL_SEARCH = NO +SEARCHENGINE_URL = +SEARCHDATA_FILE = searchdata.xml +EXTERNAL_SEARCH_ID = +EXTRA_SEARCH_MAPPINGS = +GENERATE_LATEX = YES +LATEX_OUTPUT = latex +LATEX_CMD_NAME = latex +MAKEINDEX_CMD_NAME = makeindex +COMPACT_LATEX = YES +PAPER_TYPE = a4 +EXTRA_PACKAGES = amsmath +LATEX_HEADER = +LATEX_FOOTER = +LATEX_EXTRA_STYLESHEET = +LATEX_EXTRA_FILES = +PDF_HYPERLINKS = YES +USE_PDFLATEX = YES +LATEX_BATCHMODE = NO +LATEX_HIDE_INDICES = YES +LATEX_SOURCE_CODE = NO + +LATEX_BIB_STYLE = plainnat + +LATEX_TIMESTAMP = NO + +GENERATE_RTF = NO + +RTF_OUTPUT = rtf +COMPACT_RTF = NO +RTF_HYPERLINKS = NO +RTF_STYLESHEET_FILE = +RTF_EXTENSIONS_FILE = +RTF_SOURCE_CODE = NO +GENERATE_MAN = NO +MAN_OUTPUT = man +MAN_EXTENSION = .3 +MAN_SUBDIR = +MAN_LINKS = NO +GENERATE_XML = NO +XML_OUTPUT = xml +XML_PROGRAMLISTING = YES +GENERATE_DOCBOOK = NO +DOCBOOK_OUTPUT = docbook +DOCBOOK_PROGRAMLISTING = NO +GENERATE_AUTOGEN_DEF = NO +GENERATE_PERLMOD = NO +PERLMOD_LATEX = NO +PERLMOD_PRETTY = YES +PERLMOD_MAKEVAR_PREFIX = +ENABLE_PREPROCESSING = NO +MACRO_EXPANSION = NO +EXPAND_ONLY_PREDEF = NO +SEARCH_INCLUDES = YES +INCLUDE_PATH = +INCLUDE_FILE_PATTERNS = +PREDEFINED = CCPP \ + MULTI_GASES \ + 0 +EXPAND_AS_DEFINED = +SKIP_FUNCTION_MACROS = YES +TAGFILES = +GENERATE_TAGFILE = +ALLEXTERNALS = NO +EXTERNAL_GROUPS = YES +EXTERNAL_PAGES = YES +PERL_PATH = /usr/bin/perl +CLASS_DIAGRAMS = YES +MSCGEN_PATH = +DIA_PATH = +HIDE_UNDOC_RELATIONS = NO +HAVE_DOT = YES +DOT_NUM_THREADS = 0 +DOT_FONTNAME = Helvetica +DOT_FONTSIZE = 10 +DOT_FONTPATH = +CLASS_GRAPH = NO +COLLABORATION_GRAPH = NO +GROUP_GRAPHS = YES +UML_LOOK = YES +UML_LIMIT_NUM_FIELDS = 10 +TEMPLATE_RELATIONS = NO +INCLUDE_GRAPH = YES +INCLUDED_BY_GRAPH = NO +CALL_GRAPH = YES +CALLER_GRAPH = NO +GRAPHICAL_HIERARCHY = YES +DIRECTORY_GRAPH = YES +DOT_IMAGE_FORMAT = svg +INTERACTIVE_SVG = NO +DOT_PATH = +DOTFILE_DIRS = +MSCFILE_DIRS = +DIAFILE_DIRS = +PLANTUML_JAR_PATH = +PLANTUML_INCLUDE_PATH = +DOT_GRAPH_MAX_NODES = 200 +MAX_DOT_GRAPH_DEPTH = 0 +DOT_TRANSPARENT = NO +DOT_MULTI_TARGETS = YES +GENERATE_LEGEND = YES +DOT_CLEANUP = YES diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 3d0507ad9..b2fcb0948 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -29,19 +29,16 @@ end subroutine sfc_nst_finalize !! \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm !> @{ subroutine sfc_nst_run & -! --- inputs: - & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & + & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: & pi, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & & prsl1, prslki, prsik1, prslk1, wet, xlon, sinlat, & & stress, & & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & & wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & & nstf_name5, lprnt, ipr, & -! --- input/output: - & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & + & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & -! --- outputs: - & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & + & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: & ) ! ! ===================================================================== ! diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 9635f30b8..508fb3b67 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -1,3 +1,9 @@ +!>\file sfc_ocean.F +!! This file contains an alternative GFS near-surface sea temperature +!! scheme when the model is initialized from GRIB2 data. + +!> This module contains the CCPP-compliant GFS near-surface sea temperature +!! scheme when the model is initialized from GRIB2 data. module sfc_ocean implicit none private @@ -15,19 +21,19 @@ end subroutine sfc_ocean_init subroutine sfc_ocean_finalize() end subroutine sfc_ocean_finalize +!>\defgroup gfs_ocean_main GFS Ocean scheme Module +!! This subroutine calculates thermodynamical properties over +!! open water. #if 0 !! \section arg_table_sfc_ocean_run Argument Table !! \htmlinclude sfc_ocean_run.html !! #endif subroutine sfc_ocean_run & -!................................... -! --- inputs: - & ( im, cp, rd, eps, epsm1, hvap, rvrdm1, ps, t1, q1, & + & ( im, cp, rd, eps, epsm1, hvap, rvrdm1, ps, t1, q1, & ! --- inputs & tskin, cm, ch, prsl1, prslki, wet, wind, & & flag_iter, & -! --- outputs: - & qsurf, cmm, chh, gflux, evap, hflx, ep, & + & qsurf, cmm, chh, gflux, evap, hflx, ep, & ! --- outputs & errmsg, errflg & & ) From f48b283ebabc42f1ea05d0ec59c51c6b01c24e6c Mon Sep 17 00:00:00 2001 From: Man Zhang Date: Mon, 2 Mar 2020 13:19:54 -0700 Subject: [PATCH 095/141] add two new suites: GFSv15p2_no_nsst and GFSv16beta_no_nsst and GFS ocean scientific documentation --- physics/cires_ugwp.F90 | 5 +- .../docs/{ufs_doxyfile => ccppv4_doxyfile} | 3 + physics/docs/library.bib | 50 +++--- physics/docs/pdftxt/GFS_OCEAN.txt | 16 ++ .../docs/pdftxt/GFSv15p2_no_nsst_suite.txt | 127 +++++++++++++ physics/docs/pdftxt/GFSv15p2_suite.txt | 10 +- .../docs/pdftxt/GFSv16beta_no_nsst_suite.txt | 167 ++++++++++++++++++ physics/docs/pdftxt/GFSv16beta_suite.txt | 10 +- physics/docs/pdftxt/all_shemes_list.txt | 1 + physics/docs/pdftxt/mainpage.txt | 17 +- physics/docs/pdftxt/suite_input.nml.txt | 8 +- physics/sfc_ocean.F | 4 +- 12 files changed, 368 insertions(+), 50 deletions(-) rename physics/docs/{ufs_doxyfile => ccppv4_doxyfile} (98%) create mode 100644 physics/docs/pdftxt/GFS_OCEAN.txt create mode 100644 physics/docs/pdftxt/GFSv15p2_no_nsst_suite.txt create mode 100644 physics/docs/pdftxt/GFSv16beta_no_nsst_suite.txt diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index ac12764cc..89cea0595 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -146,7 +146,8 @@ end subroutine cires_ugwp_finalize !! \htmlinclude cires_ugwp_run.html !! -!>\section gen_cires_ugwp CIRES UGWP General Algorithm +!> \section gen_cires_ugwp CIRES UGWP Scheme General Algorithm +!! @{ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr, & oro, oro_uf, hprime, nmtvr, oc, theta, sigma, gamma, elvmax, clx, oa4, & do_tofd, ldiag_ugwp, cdmbgwd, xlat, xlat_d, sinlat, coslat, area, & @@ -367,4 +368,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr end subroutine cires_ugwp_run +!! @} +!>@} end module cires_ugwp diff --git a/physics/docs/ufs_doxyfile b/physics/docs/ccppv4_doxyfile similarity index 98% rename from physics/docs/ufs_doxyfile rename to physics/docs/ccppv4_doxyfile index 1b77aafb6..e80b27eb9 100644 --- a/physics/docs/ufs_doxyfile +++ b/physics/docs/ccppv4_doxyfile @@ -103,9 +103,11 @@ WARN_LOGFILE = INPUT = pdftxt/mainpage.txt \ pdftxt/all_shemes_list.txt \ pdftxt/GFSv15p2_suite.txt \ + pdftxt/GFSv15p2_no_nsst_suite.txt \ pdftxt/suite_FV3_GFS_v15p2.xml.txt \ pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt \ pdftxt/GFSv16beta_suite.txt \ + pdftxt/GFSv16beta_no_nsst_suite.txt \ pdftxt/suite_FV3_GFS_v16beta.xml.txt \ pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt \ pdftxt/GSD_adv_suite.txt \ @@ -113,6 +115,7 @@ INPUT = pdftxt/mainpage.txt \ pdftxt/GFS_RRTMG.txt \ pdftxt/GFS_SFCLYR.txt \ pdftxt/GFS_NSST.txt \ + pdftxt/GFS_OCEAN.txt \ pdftxt/GFS_NOAH.txt \ pdftxt/GFS_SFCSICE.txt \ pdftxt/GFS_HEDMF.txt \ diff --git a/physics/docs/library.bib b/physics/docs/library.bib index cfc3e3304..dd2b2042e 100644 --- a/physics/docs/library.bib +++ b/physics/docs/library.bib @@ -1,7 +1,7 @@ %% This BibTeX bibliography file was created using BibDesk. %% http://bibdesk.sourceforge.net/ -%% Created for Man Zhang at 2020-02-24 10:07:00 -0700 +%% Created for Man Zhang at 2020-03-02 13:10:25 -0700 %% Saved with string encoding Unicode (UTF-8) @@ -1859,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}} + Year = {2009}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBWLi4vLi4vLi4vLi4vLi4vRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGZPEQIgAAAAAAIgAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADT4djXSCsAAANl5rUfSW1wcm92ZW1lbnRfb2ZfTGFuZCMzNjVGRjBGLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2X/D9aQ780AAAAAAAAAAAAFAAMAAAkgAAAAAAAAAAAAAAAAAAAACE5PQUhfTFNNABAACAAA0+ItNwAAABEACAAA1pFSPQAAAAEAEANl5rUAD8YgAA/GDwAGL94AAgBRTWFjaW50b3NoIEhEOlVzZXJzOgBtYW4uemhhbmc6AERlc2t0b3A6AE5PQUhfTFNNOgBJbXByb3ZlbWVudF9vZl9MYW5kIzM2NUZGMEYucGRmAAAOAG4ANgBJAG0AcAByAG8AdgBlAG0AZQBuAHQAXwBvAGYAXwBMAGEAbgBkAF8AUwB1AHIAZgBhAGMAZQBfAFMAawBpAG4AXwBUAGUAbQBwAGUAcgBhAHQAdQByAGUAXwBpAG4AXwBOAEMALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAFdVc2Vycy9tYW4uemhhbmcvRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGYAABMAAS8AABUAAgAQ//8AAAAIAA0AGgAkAH0AAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACoQ==}} @article{chen_et_al_1997, Author = {F. Chen and Z. Janjic and K. Mitchell}, @@ -2103,7 +2103,6 @@ @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}, @@ -2117,13 +2116,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}, @@ -2142,13 +2141,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}, @@ -2169,12 +2168,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}, @@ -2188,12 +2187,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}, @@ -2214,22 +2213,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}} + Year = {1995}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvUGFuLzE5OTUucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAwtTNCDE5OTUucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADCtU/TGvMJAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANQYW4AABAACAAA0ed4sgAAABEACAAA0xtHaQAAAAEAGADC1M0AKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAUGFuOgAxOTk1LnBkZgAADgASAAgAMQA5ADkANQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9QYW4vMTk5NS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}} @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}, @@ -2250,11 +2249,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}, @@ -2267,6 +2266,7 @@ @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, @@ -2500,7 +2500,6 @@ @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}, @@ -2514,12 +2513,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}, @@ -2533,11 +2532,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}, @@ -2551,13 +2550,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}, @@ -2576,11 +2575,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}, @@ -2593,12 +2592,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}, @@ -2611,13 +2610,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}, @@ -2638,13 +2637,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}, @@ -2663,11 +2662,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}, @@ -2680,6 +2679,7 @@ @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, @@ -2870,18 +2870,17 @@ @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}} + Year = {2002}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAiLi4vLi4vemhhbmctbGliL2hvdV9ldF9hbF8yMDAyLnBkZk8RAdwAAAAAAdwAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAAM/T1mZIKwAAAFKkjRJob3VfZXRfYWxfMjAwMi5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUqai02OGCgAAAAAAAAAAAAIAAgAACSAAAAAAAAAAAAAAAAAAAAAJemhhbmctbGliAAAQAAgAAM/UKsYAAAARAAgAANNj2moAAAABABgAUqSNAE1lSgAj19QACTbFAAk2xAACZvkAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBtYW56aGFuZzoARG9jdW1lbnRzOgBNYW4uWmhhbmc6AGdtdGItZG9jOgB6aGFuZy1saWI6AGhvdV9ldF9hbF8yMDAyLnBkZgAADgAmABIAaABvAHUAXwBlAHQAXwBhAGwAXwAyADAAMAAyAC4AcABkAGYADwAaAAwATQBhAGMAaQBuAHQAbwBzAGgAIABIAEQAEgBIVXNlcnMvbWFuemhhbmcvRG9jdW1lbnRzL01hbi5aaGFuZy9nbXRiLWRvYy96aGFuZy1saWIvaG91X2V0X2FsXzIwMDIucGRmABMAAS8AABUAAgAP//8AAAAIAA0AGgAkAEkAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACKQ==}} @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}, @@ -2889,7 +2888,8 @@ @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}} + 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.}, diff --git a/physics/docs/pdftxt/GFS_OCEAN.txt b/physics/docs/pdftxt/GFS_OCEAN.txt new file mode 100644 index 000000000..813adf71c --- /dev/null +++ b/physics/docs/pdftxt/GFS_OCEAN.txt @@ -0,0 +1,16 @@ +/** +\page GFS_OCEAN GFS Simple Ocean Scheme +\section des_sfcocean Description + +The Sea Surface Temperature (SST) is a required filed in Numerical Weather Prediciton (NWP) systems because it +functions as the lower foundary condition for the calculation of air-sea heat fluxes. When the GFS Simple Ocean +Scheme is evoked, the SST is kept constant throughout the forecast. + +\section intra_sfcocean Intraphysics Communication +\ref arg_table_sfc_ocean_run + + + + + +*/ diff --git a/physics/docs/pdftxt/GFSv15p2_no_nsst_suite.txt b/physics/docs/pdftxt/GFSv15p2_no_nsst_suite.txt new file mode 100644 index 000000000..982afc860 --- /dev/null +++ b/physics/docs/pdftxt/GFSv15p2_no_nsst_suite.txt @@ -0,0 +1,127 @@ +/** +\page GFS_v15p2_no_nsst_page GFS_v15p2_no_nsst Suite + +\section gfsv15_no_nsst_suite_overview Overview + +Suite GFS_v15p2_no_nsst is a companion suite of GFS_v15p2 with GRIB2 data initialization. + +The GFS_v15p2_no_nsst physics suite uses the parameterizations in the following order: + - \ref GFS_RRTMG + - \ref GFS_SFCLYR + - \ref GFS_OCEAN + - \ref GFS_NOAH + - \ref GFS_SFCSICE + - \ref GFS_HEDMF + - \ref GFS_UGWP_v0 + - \ref GFS_RAYLEIGH + - \ref GFS_OZPHYS + - \ref GFS_H2OPHYS + - \ref GFS_SAMFdeep + - \ref GFS_SAMFshal + - \ref GFDL_cloud + - \ref GFS_CALPRECIPTYPE + +\section sdf_gfsv15p2_no_nsst Suite Definition File +- For GRIB2 initialization data: \subpage suite_FV3_GFS_v15p2_no_nsst_xml + +\section gfs15p2nonsst_nml_opt_des Namelist + +- \b &gfs_physics_nml +\n \c fhzero = 6 +\n \c h2o_phys = .true. +\n \c ldiag3d = .false. +\n \c fhcyc = 24 +\n \c use_ufo = .true. +\n \c pre_rad = .false. +\n \c ncld = 5 +\n \c imp_physics = 11 +\n \c pdfcld = .false. +\n \c fhswr = 3600. +\n \c fhlwr = 3600. +\n \c ialb = 1 +\n \c iems = 1 +\n \c iaer = 111 +\n \c ico2 = 2 +\n \c isubc_sw = 2 +\n \c isubc_lw = 2 +\n \c isol = 2 +\n \c lwhtr = .true. +\n \c swhtr = .true. +\n \c cnvgwd = .true. +\n \c shal_cnv = .true. +\n \c cal_pre = .false. +\n \c redrag = .true. +\n \c dspheat = .true. +\n \c hybedmf = .true. +\n \c random_clds = .false. +\n \c trans_trac = .true. +\n \c cnvcld = .true. +\n \c imfshalcnv = 2 +\n \c imfdeepcnv = 2 +\n \c cdmbgwd = 3.5,0.25 [1.0,1.2] [0.2,2.5] [0.125,3.0] ! [C768] [C384] [C192] [C96]L64 +\n \c prslrd0 = 0. +\n \c ivegsrc = 1 +\n \c isot = 1 +\n \c debug = .false. +\n \c oz_phys = .F. +\n \c oz_phys_2015 = .T. +\n \c nstf_name = 0,0,0,0,0 +\n \c nst_anl = .true. +\n \c psautco = 0.0008,0.0005 +\n \c prautco = 0.00015,0.00015 +\n \c lgfdlmprad = .true. +\n \c effr_in = .true. +\n \c do_sppt = .false. +\n \c do_shum = .false. +\n \c do_skeb = .false. +\n \c do_sfcperts = .false. + +- \b &gfdl_cloud_microphysics_nml +\n \c sedi_transport = .true. +\n \c do_sedi_heat = .false. +\n \c rad_snow = .true. +\n \c rad_graupel = .true. +\n \c rad_rain = .true. +\n \c const_vi = .F. +\n \c const_vs = .F. +\n \c const_vg = .F. +\n \c const_vr = .F. +\n \c vi_max = 1. +\n \c vs_max = 2. +\n \c vg_max = 12. +\n \c vr_max = 12. +\n \c qi_lim = 1. +\n \c prog_ccn = .false. +\n \c do_qa = .true. +\n \c fast_sat_adj = .true. +\n \c tau_l2v = 225. +\n \c tau_v2l = 150. +\n \c tau_g2v = 900. +\n \c rthresh = 10.e-6 +\n \c dw_land = 0.16 +\n \c dw_ocean = 0.10 +\n \c ql_gen = 1.0e-3 +\n \c ql_mlt = 1.0e-3 +\n \c qi0_crt = 8.0E-5 +\n \c qs0_crt = 1.0e-3 +\n \c tau_i2s = 1000. +\n \c c_psaci = 0.05 +\n \c c_pgacs = 0.01 +\n \c rh_inc = 0.30 +\n \c rh_inr = 0.30 +\n \c rh_ins = 0.30 +\n \c ccn_l = 300. +\n \c ccn_o = 100. +\n \c c_paut = 0.5 +\n \c c_cracw = 0.8 +\n \c use_ppm = .false. +\n \c use_ccn = .true. +\n \c mono_prof = .true. +\n \c z_slope_liq = .true. +\n \c z_slope_ice = .true. +\n \c de_ice = .false. +\n \c fix_negative = .true. +\n \c icloud_f = 1 +\n \c mp_time = 150. + +*/ diff --git a/physics/docs/pdftxt/GFSv15p2_suite.txt b/physics/docs/pdftxt/GFSv15p2_suite.txt index 7d9f9d348..944fd49f1 100644 --- a/physics/docs/pdftxt/GFSv15p2_suite.txt +++ b/physics/docs/pdftxt/GFSv15p2_suite.txt @@ -10,6 +10,7 @@ The GFS_v15p2 physics suite uses the parameterizations in the following order: - \ref GFS_RRTMG - \ref GFS_SFCLYR - \ref GFS_NSST + - \ref GFS_OCEAN - \ref GFS_NOAH - \ref GFS_SFCSICE - \ref GFS_HEDMF @@ -23,8 +24,7 @@ The GFS_v15p2 physics suite uses the parameterizations in the following order: - \ref GFS_CALPRECIPTYPE \section sdf_gfsv15p2 Suite Definition File -- For NEMSIO initialization data: \ref suite_FV3_GFS_v15p2_xml -- For GRIB2 initialization data: \ref suite_FV3_GFS_v15p2_no_nsst_xml +- For NEMSIO initialization data: \subpage suite_FV3_GFS_v15p2_xml \section gfs15p2_nml_opt_des Namelist @@ -126,8 +126,8 @@ The GFS_v15p2 physics suite uses the parameterizations in the following order: \n \c icloud_f = 1 \n \c mp_time = 150. -\note nstf_name = \f$2,0,0,0,0[2,1,0,0,0]^1 [0,0,0,0,0]^2\f$ -- \f$^1\f$ This should be used when spinning up NSST fields in the absence of NSST data in initial conditions (see documentation for CHGRES) -- \f$^2\f$ This should be used when not using NSST at all (paired with \ref suite_FV3_GFS_v15p2_no_nsst_xml to turned off NSST option) +\note nstf_name = \f$[2,0,0,0,0]^1 [2,1,0,0,0]^2 \f$ +- \f$^1\f$ NSST is on and coupled with spin up off +- \f$^2\f$ NSST is on and coupled with spin up on */ diff --git a/physics/docs/pdftxt/GFSv16beta_no_nsst_suite.txt b/physics/docs/pdftxt/GFSv16beta_no_nsst_suite.txt new file mode 100644 index 000000000..3e5205199 --- /dev/null +++ b/physics/docs/pdftxt/GFSv16beta_no_nsst_suite.txt @@ -0,0 +1,167 @@ +/** +\page GFS_v16beta_no_nsst_page GFS_v16beta_no_nsst Suite + +\section gfsv16beta_no_nsst_suite_overview Overview + +Suite GFS_v16beta_no_nsst is a companion suite of GFS_v16beta with GRIB2 data initialization. + +The GFS_v16beta_no_nsst physics suite uses the parameterizations in the following order: + - \ref GFS_RRTMG + - \ref GFS_SFCLYR + - \ref GFS_OCEAN + - \ref GFS_NOAH + - \ref GFS_SFCSICE + - \ref GFS_SATMEDMFVDIFQ + - \ref GFS_UGWP_v0 + - \ref GFS_RAYLEIGH + - \ref GFS_OZPHYS + - \ref GFS_H2OPHYS + - \ref GFS_SAMFdeep + - \ref GFS_SAMFshal + - \ref GFDL_cloud + - \ref GFS_CALPRECIPTYPE + +\section sdf_gfsv16bnonsst Suite Definition File +- For GRIB2 initialization data: \subpage suite_FV3_GFS_v16beta_no_nsst_xml + +\section gfs16betanonsst_nml_opt_des Namelist + +- \b &gfs_physics_nml +\n \c fhzero = 6 +\n \c h2o_phys = .true. +\n \c ldiag3d = .false. +\n \c fhcyc = 24 +\n \c use_ufo = .true. +\n \c pre_rad = .false. +\n \c ncld = 5 +\n \c imp_physics = 11 +\n \c pdfcld = .false. +\n \c fhswr = 3600. +\n \c fhlwr = 3600. +\n \c ialb = 1 +\n \c iems = 1 +\n \c iaer = 5111 +\n \c icliq_sw = 2 +\n \c iovr_lw = 3 +\n \c iovr_sw = 3 +\n \c ico2 = 2 +\n \c isubc_sw = 2 +\n \c isubc_lw = 2 +\n \c isol = 2 +\n \c lwhtr = .true. +\n \c swhtr = .true. +\n \c cnvgwd = .true. +\n \c shal_cnv = .true. +\n \c cal_pre = .false. +\n \c redrag = .true. +\n \c dspheat = .true. +\n \c hybedmf = .false. +\n \c satmedmf = .true. +\n \c isatmedmf = 1 +\n \c lheatstrg = .true. +\n \c random_clds = .false. +\n \c trans_trac = .true. +\n \c cnvcld = .true. +\n \c imfshalcnv = 2 +\n \c imfdeepcnv = 2 +\n \c cdmbgwd = 4.0,0.15,1.0,1.0 [1.1,0.72,1.0,1.0] [0.23,1.5,1.0,1.0] [0.14,1.8,1.0,1.0] ! [C768] [C384] [C192] [C96]L64 +\n \c prslrd0 = 0. +\n \c ivegsrc = 1 +\n \c isot = 1 +\n \c lsoil = 4 +\n \c lsm = 1 +\n \c iopt_dveg = 1 +\n \c iopt_crs = 1 +\n \c iopt_btr = 1 +\n \c iopt_run = 1 +\n \c iopt_sfc = 1 +\n \c iopt_frz = 1 +\n \c iopt_inf = 1 +\n \c iopt_rad = 1 +\n \c iopt_alb = 2 +\n \c iopt_snf = 4 +\n \c iopt_tbot = 2 +\n \c iopt_stc = 1 +\n \c debug = .false. +\n \c oz_phys = .F. +\n \c oz_phys_2015 = .T. +\n \c nstf_name = 0,0,0,0,0 +\n \c nst_anl = .true. +\n \c psautco = 0.0008,0.0005 +\n \c prautco = 0.00015,0.00015 +\n \c lgfdlmprad = .true. +\n \c effr_in = .true. +\n \c ldiag_ugwp = .false. +\n \c do_ugwp = .false. +\n \c do_tofd = .true. +\n \c do_sppt = .false. +\n \c do_shum = .false. +\n \c do_skeb = .false. +\n \c do_sfcperts = .false. + + +- \b &gfdl_cloud_microphysics_nml +\n \c sedi_transport = .true. +\n \c do_sedi_heat = .false. +\n \c rad_snow = .true. +\n \c rad_graupel = .true. +\n \c rad_rain = .true. +\n \c const_vi = .F. +\n \c const_vs = .F. +\n \c const_vg = .F. +\n \c const_vr = .F. +\n \c vi_max = 1. +\n \c vs_max = 2. +\n \c vg_max = 12. +\n \c vr_max = 12. +\n \c qi_lim = 1. +\n \c prog_ccn = .false. +\n \c do_qa = .true. +\n \c fast_sat_adj = .true. +\n \c tau_l2v = 225. +\n \c tau_v2l = 150. +\n \c tau_g2v = 900. +\n \c rthresh = 10.e-6 +\n \c dw_land = 0.16 +\n \c dw_ocean = 0.10 +\n \c ql_gen = 1.0e-3 +\n \c ql_mlt = 1.0e-3 +\n \c qi0_crt = 8.0E-5 +\n \c qs0_crt = 1.0e-3 +\n \c tau_i2s = 1000. +\n \c c_psaci = 0.05 +\n \c c_pgacs = 0.01 +\n \c rh_inc = 0.30 +\n \c rh_inr = 0.30 +\n \c rh_ins = 0.30 +\n \c ccn_l = 300. +\n \c ccn_o = 100. +\n \c c_paut = 0.5 +\n \c c_cracw = 0.8 +\n \c use_ppm = .false. +\n \c use_ccn = .true. +\n \c mono_prof = .true. +\n \c z_slope_liq = .true. +\n \c z_slope_ice = .true. +\n \c de_ice = .false. +\n \c fix_negative = .true. +\n \c icloud_f = 1 +\n \c mp_time = 150. +\n \c reiflag = 2 + + +- \b &cires_ugwp_nml +\n \c knob_ugwp_solver = 2 +\n \c knob_ugwp_source = 1,1,0,0 +\n \c knob_ugwp_wvspec = 1,25,25,25 +\n \c knob_ugwp_azdir = 2,4,4,4 +\n \c knob_ugwp_stoch = 0,0,0,0 +\n \c knob_ugwp_effac = 1,1,1,1 +\n \c knob_ugwp_doaxyz = 1 +\n \c knob_ugwp_doheat = 1 +\n \c knob_ugwp_dokdis = 1 +\n \c knob_ugwp_ndx4lh = 1 +\n \c knob_ugwp_version = 0 +\n \c launch_level = 27 + +*/ diff --git a/physics/docs/pdftxt/GFSv16beta_suite.txt b/physics/docs/pdftxt/GFSv16beta_suite.txt index abba846f1..8389d0c40 100644 --- a/physics/docs/pdftxt/GFSv16beta_suite.txt +++ b/physics/docs/pdftxt/GFSv16beta_suite.txt @@ -13,6 +13,7 @@ The GFS_v16beta physics suite uses the parameterizations in the following order: - \ref GFS_RRTMG - \ref GFS_SFCLYR - \ref GFS_NSST + - \ref GFS_OCEAN - \ref GFS_NOAH - \ref GFS_SFCSICE - \ref GFS_SATMEDMFVDIFQ @@ -26,8 +27,7 @@ The GFS_v16beta physics suite uses the parameterizations in the following order: - \ref GFS_CALPRECIPTYPE \section sdf_gfsv16b Suite Definition File -- For NEMSIO initialization data: \ref suite_FV3_GFS_v16beta_xml -- For GRIB2 initialization data: \ref suite_FV3_GFS_v16beta_no_nsst_xml +- For NEMSIO initialization data: \subpage suite_FV3_GFS_v16beta_xml \section gfs16beta_nml_opt_des Namelist @@ -169,8 +169,8 @@ The GFS_v16beta physics suite uses the parameterizations in the following order: \n \c knob_ugwp_version = 0 \n \c launch_level = 27 -\note nstf_name = \f$2,0,0,0,0[2,1,0,0,0]^1 [0,0,0,0,0]^2\f$ -- \f$^1\f$ This should be used when spinning up NSST fields in the absence of NSST data in initial conditions (see documentation for CHGRES) -- \f$^2\f$ This should be used when not using NSST at all (paired with \ref suite_FV3_GFS_v16beta_no_nsst_xml to turned off NSST option) +\note nstf_name = \f$[2,0,0,0,0]^1 [2,1,0,0,0]^2\f$ +- \f$^1\f$ NSST is on and coupled with spin up off +- \f$^2\f$ NSST is on and coupled with spin up on */ diff --git a/physics/docs/pdftxt/all_shemes_list.txt b/physics/docs/pdftxt/all_shemes_list.txt index 7e5e3298e..b85acff37 100644 --- a/physics/docs/pdftxt/all_shemes_list.txt +++ b/physics/docs/pdftxt/all_shemes_list.txt @@ -51,6 +51,7 @@ parameterizations in suites. - \b Surface \b Layer \b and \b Simplified \b Ocean \b and \b Sea \b Ice \b Representation - \subpage GFS_SFCLYR - \subpage GFS_NSST + - \subpage GFS_OCEAN - \subpage GFS_SFCSICE - \b Others diff --git a/physics/docs/pdftxt/mainpage.txt b/physics/docs/pdftxt/mainpage.txt index 2ac121f3c..bdac1ef17 100644 --- a/physics/docs/pdftxt/mainpage.txt +++ b/physics/docs/pdftxt/mainpage.txt @@ -7,16 +7,19 @@ Community Physics Package (CCPP) v3.0 public release. The CCPP-Physics is envisioned to contain parameterizations used by NOAA operational models for weather through seasonal prediction timescales, as well as developmental schemes under consideration for upcoming operational implementations. This version contains all parameterizations of the current operational GFS, -plus additional developmental schemes. The CCPP can currently be used with the Single Column Model (SCM) developed -by the Global Model Test Bed (GMTB) of the Developmental Testbed Center, as well as with the atmospheric component -of NOAA's Unified Forecast System (UFS-Atmosphere), which employs the the non-hydrostatic -Finite-Volume Cubed-Sphere (FV3) dynamic core. +plus additional developmental schemes. There are four suites supported for use with the Single Column Model (SCM) +developed by the Development Testbed Center (GFS_v15p2, GFS_v16beta, GSD_v1, and csawmg), and four suites +supported for use with the atmospheric component of the UFS (i.e., GFS_v15p2, GFS_v15p2_no_nsst, GFS_v16beta and +GFS_v16beta_no_nsst). The variants labelled as \a no_nsst are a simplification that uses constant sea surface +temperature (SST). This simplification is needed when the UFS is initialized with files in GRIdded Binary Edition 2 (GRIB2) +format instead of files in NOAA Environmental Modeling System (NEMS) Input/Output (NEMSIO) format because the +fields necessary to predict (SST) are not available in the GRIB2 files. In this website you will find documentation on various aspects of each parameterization, including a high-level overview of its function, the input/output argument list, and a description of the algorithm. -The latest CCPP public release is Version 3.0 (June 2019), and more details on it may be found on the - CCPP website hosted by the Global Model Test -Bed (GMTB) of the Developmental Testbed Center (DTC). +The latest CCPP public release is Version 4.0 (March 2020), and more details on it may be found on the + CCPP website hosted by +the Developmental Testbed Center (DTC). */ diff --git a/physics/docs/pdftxt/suite_input.nml.txt b/physics/docs/pdftxt/suite_input.nml.txt index 688eb5d07..4f7ddaae8 100644 --- a/physics/docs/pdftxt/suite_input.nml.txt +++ b/physics/docs/pdftxt/suite_input.nml.txt @@ -221,14 +221,14 @@ and how stochastic perturbations are used in the Noah Land Surface Model. debug gfs_control_type flag for debug printout .false. nstf_name(5) gfs_control_type NSST related paramters:\n
    -
  • nstf_name(1): 0=NSSTM off, 1= NSSTM on but uncoupled, 2= NSSTM on and coupled -
  • nstf_name(2): 1=NSSTM spin up on, 0=NSSTM spin up off -
  • nstf_name(3): 1=NSST analysis on, 0=NSSTM analysis off +
  • nstf_name(1): 0=NSST off, 1= NSST on but uncoupled, 2= NSST on and coupled +
  • nstf_name(2): 1=NSST spin up on, 0=NSST spin up off +
  • nstf_name(3): 1=NSST analysis on, 0=NSST analysis off
  • nstf_name(4): zsea1 in mm
  • nstf_name(5): zesa2 in mm
/0,0,1,0,5/ -nst_anl gfs_control_type flag for NSSTM analysis in gcycle/sfcsub .false. +nst_anl gfs_control_type flag for NSST analysis in gcycle/sfcsub .false. effr_in gfs_control_type logical flag for using input cloud effective radii calculation .false. aero_in gfs_control_type logical flag for using aerosols in Morrison-Gettelman microphysics .false. iau_delthrs gfs_control_type incremental analysis update (IAU) time interval in hours 6 diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 508fb3b67..e21ddb3a7 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -21,14 +21,12 @@ end subroutine sfc_ocean_init subroutine sfc_ocean_finalize() end subroutine sfc_ocean_finalize -!>\defgroup gfs_ocean_main GFS Ocean scheme Module +!>\defgroup gfs_ocean_main GFS Simple Ocean Scheme Module !! This subroutine calculates thermodynamical properties over !! open water. -#if 0 !! \section arg_table_sfc_ocean_run Argument Table !! \htmlinclude sfc_ocean_run.html !! -#endif subroutine sfc_ocean_run & & ( im, cp, rd, eps, epsm1, hvap, rvrdm1, ps, t1, q1, & ! --- inputs & tskin, cm, ch, prsl1, prslki, wet, wind, & From e63c34fb94ae161a73bd0793aefcc68546f19e38 Mon Sep 17 00:00:00 2001 From: mzhangw Date: Mon, 2 Mar 2020 15:46:27 -0700 Subject: [PATCH 096/141] CCPP V4.0 scidoc update (#402) * scientific documentation update for UFS public release, add two additional xml files for GFSv15p2 and GFSv16beta * add two new suites: GFSv15p2_no_nsst and GFSv16beta_no_nsst and GFS ocean scientific documentation --- physics/cires_ugwp.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 89cea0595..504b24a77 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -145,7 +145,6 @@ end subroutine cires_ugwp_finalize !> \section arg_table_cires_ugwp_run Argument Table !! \htmlinclude cires_ugwp_run.html !! - !> \section gen_cires_ugwp CIRES UGWP Scheme General Algorithm !! @{ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr, & @@ -367,7 +366,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr gw_dudt = gw_dudt*(1.-pked) + ed_dudt*pked end subroutine cires_ugwp_run - !! @} !>@} end module cires_ugwp From ab540e5a532b5a891382e39dc21f1105d8f53e57 Mon Sep 17 00:00:00 2001 From: Man Zhang Date: Mon, 9 Mar 2020 15:04:58 -0600 Subject: [PATCH 097/141] add no_nsst suites in all_schemes page per ligia email --- physics/docs/pdftxt/all_shemes_list.txt | 31 ++++++++++++++++--------- physics/docs/pdftxt/mainpage.txt | 4 ++-- 2 files changed, 22 insertions(+), 13 deletions(-) diff --git a/physics/docs/pdftxt/all_shemes_list.txt b/physics/docs/pdftxt/all_shemes_list.txt index b85acff37..c1f3bf1d8 100644 --- a/physics/docs/pdftxt/all_shemes_list.txt +++ b/physics/docs/pdftxt/all_shemes_list.txt @@ -83,25 +83,34 @@ to the parameterization. \section allsuite_overview Physics Suites -The CCPP v3 includes the suite used in the GFS v15 implemented operationally in June 2019 (suite GFS_v15). Additionally, it includes three -developmental suites which are undergoing testing for possible future implementation in the UFS. Suite GFS_v15plus is identical to suite -GFS_v15 except for a replacement in the PBL parameterization (Han et al. 2019 \cite Han_2019 ). Suite csawmg differs from GFS_v15 as it +The CCPP includes the suite GFS_v15p2, which has the same parameterizations used in the GFS v15 implemented operationally in June 2019, and suite +GFS_v16beta, i.e., the beta version of the suite planned for GFS v16 to be implemented operationally in 2021. Suite GFS_v16beta is identical to +Suite GFS_v15p2 except for an update in the PBL parameterization (Han et al. 2019 \cite Han_2019 ) and RRTMG. Additionally, CCPP v4 includes two +developmental suites which are undergoing testing to inform future implementations of the UFS. Suite csawmg differs from GFS_v15p2 as it contains different convection and microphysics schemes made available through a NOAA Climate Process Team (CPT) with components developed at multiple research centers and universities, including Colorado State, Utah, NASA, NCAR, and EMC. Suite GSD_v0 differs from GFS_v15 as it uses the convection, microphysics, and boundary layer schemes employed in the Rapid Refresh (RAP) and High-Resolution Rapid Refresh (HRRR \cite Benjamin_2016 ) operational models and was assembled by NOAA/GSD. An assessment of an earlier version of these suites can be found in the UFS portal -and in the GMTB website . +and in the DTC website . Two variant suites labelled as \a no_nsst are simplification of GFS_v15p2 and GFS_v16beta. +This simplification is needed when the UFS is initialized with files in GRIdded Binary Edition 2 (GRIB2) format instead of files in NOAA Environmental Modeling +System (NEMS) Input/Output (NEMSIO) format because the fields necesary to predict (SST) are not available in the GRIB2 files. Table 1. Physics suite options included in this documentation. \tableofcontents -| Phys suites | GFS_v15 | GFS_v15plus | csawmg | GSD_v0 | -|------------------|----------------------|----------------------|---------------------|----------------------| -| Deep Cu | \ref GFS_SAMFdeep | \ref GFS_SAMFdeep | \ref CSAW_scheme | \ref GSD_CU_GF | -| Shallow Cu | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GSD_MYNNEDMF and \ref cu_gf_sh_group | -| Microphysics | \ref GFDL_cloud | \ref GFDL_cloud | \ref CPT_MG3 | \ref GSD_THOMPSON | -| PBL/TURB | \ref GFS_HEDMF | \ref GFS_SATMEDMF | \ref GFS_HEDMF | \ref GSD_MYNNEDMF | -| Land | \ref GFS_NOAH | \ref GFS_NOAH | \ref GFS_NOAH | \ref GSD_RUCLSM | +| Physics suites | GFS_v15p2 | GFS_v16beta | csawmg | GSD_v1 | GFS_v15p2_no_nsst | GFS_v16beta_no_nsst | +|------------------|----------------------|--------------------------|---------------------|---------------------------------------------|-------------------------|---------------------------| +| Deep Cu | \ref GFS_SAMFdeep | \ref GFS_SAMFdeep | \ref CSAW_scheme | \ref GSD_CU_GF | \ref GFS_SAMFdeep | \ref GFS_SAMFdeep | +| Shallow Cu | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GSD_MYNNEDMF and \ref cu_gf_sh_group | \ref GFS_SAMFshal | \ref GFS_SAMFshal | +| Microphysics | \ref GFDL_cloud | \ref GFDL_cloud | \ref CPT_MG3 | \ref GSD_THOMPSON | \ref GFDL_cloud | \ref GFDL_cloud | +| PBL/TURB | \ref GFS_HEDMF | \ref GFS_SATMEDMFVDIFQ | \ref GFS_HEDMF | \ref GSD_MYNNEDMF | \ref GFS_HEDMF | \ref GFS_SATMEDMFVDIFQ | +| Radiation | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | +| Surface Layer | \ref GFS_SFCLYR | \ref GFS_SFCLYR | \ref GFS_SFCLYR | \ref GFS_SFCLYR | \ref GFS_SFCLYR | \ref GFS_SFCLYR | +| Land | \ref GFS_NOAH | \ref GFS_NOAH | \ref GFS_NOAH | \ref GSD_RUCLSM | \ref GFS_NOAH | \ref GFS_NOAH | +| Gravity Wave Drag| \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | +| Ocean | \ref GFS_NSST | \ref GFS_NSST | \ref GFS_NSST | \ref GFS_NSST | \ref GFS_OCEAN | \ref GFS_OCEAN | +| Ozone | \ref GFS_OZPHYS | \ref GFS_OZPHYS | \ref GFS_OZPHYS | \ref GFS_OZPHYS | \ref GFS_OZPHYS | \ref GFS_OZPHYS | +| Water Vapor | \ref GFS_H2OPHYS | \ref GFS_H2OPHYS | \ref GFS_H2OPHYS | \ref GFS_H2OPHYS | \ref GFS_H2OPHYS | \ref GFS_H2OPHYS | \tableofcontents diff --git a/physics/docs/pdftxt/mainpage.txt b/physics/docs/pdftxt/mainpage.txt index bdac1ef17..a670441f5 100644 --- a/physics/docs/pdftxt/mainpage.txt +++ b/physics/docs/pdftxt/mainpage.txt @@ -10,8 +10,8 @@ operational implementations. This version contains all parameterizations of the plus additional developmental schemes. There are four suites supported for use with the Single Column Model (SCM) developed by the Development Testbed Center (GFS_v15p2, GFS_v16beta, GSD_v1, and csawmg), and four suites supported for use with the atmospheric component of the UFS (i.e., GFS_v15p2, GFS_v15p2_no_nsst, GFS_v16beta and -GFS_v16beta_no_nsst). The variants labelled as \a no_nsst are a simplification that uses constant sea surface -temperature (SST). This simplification is needed when the UFS is initialized with files in GRIdded Binary Edition 2 (GRIB2) +GFS_v16beta_no_nsst). The variants labelled as \a no_nsst are simplification of GFS_v15p2 and GFS_v16beta +. This simplification is needed when the UFS is initialized with files in GRIdded Binary Edition 2 (GRIB2) format instead of files in NOAA Environmental Modeling System (NEMS) Input/Output (NEMSIO) format because the fields necessary to predict (SST) are not available in the GRIB2 files. From 01a91cba31543aad261f6d75c700cac9a1e3bae9 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Fri, 27 Mar 2020 11:52:29 -0600 Subject: [PATCH 098/141] update ocean scheme description per Ligias request --- physics/docs/pdftxt/GFS_OCEAN.txt | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/physics/docs/pdftxt/GFS_OCEAN.txt b/physics/docs/pdftxt/GFS_OCEAN.txt index 813adf71c..b384aec84 100644 --- a/physics/docs/pdftxt/GFS_OCEAN.txt +++ b/physics/docs/pdftxt/GFS_OCEAN.txt @@ -2,9 +2,10 @@ \page GFS_OCEAN GFS Simple Ocean Scheme \section des_sfcocean Description -The Sea Surface Temperature (SST) is a required filed in Numerical Weather Prediciton (NWP) systems because it -functions as the lower foundary condition for the calculation of air-sea heat fluxes. When the GFS Simple Ocean -Scheme is evoked, the SST is kept constant throughout the forecast. +The Sea Surface Temperature (SST) is a required field in Numerical Weather Prediciton (NWP) systems because it +functions as the lower boundary condition for the calculation of air-sea heat fluxes. The GFS Simple Ocean Scheme +does not change the SST. Therefore, the SST stays constant throughout the forecast unless it is updated by other processes. +In some models, such as the UFS atmosphere, the SST can change if forcing towards the climatology is turned on. \section intra_sfcocean Intraphysics Communication \ref arg_table_sfc_ocean_run From 5a254ffb0aa2fd26df641d3963ee7d1fa38a0379 Mon Sep 17 00:00:00 2001 From: Man Zhang Date: Fri, 27 Mar 2020 14:52:16 -0600 Subject: [PATCH 099/141] fix doxygen compile warnings --- physics/docs/pdftxt/suite_input.nml.txt | 2 +- physics/m_micro.F90 | 9 --------- physics/mp_thompson.F90 | 4 ---- physics/sfc_drv_ruc.F90 | 2 -- 4 files changed, 1 insertion(+), 16 deletions(-) diff --git a/physics/docs/pdftxt/suite_input.nml.txt b/physics/docs/pdftxt/suite_input.nml.txt index 4f7ddaae8..95b77c22f 100644 --- a/physics/docs/pdftxt/suite_input.nml.txt +++ b/physics/docs/pdftxt/suite_input.nml.txt @@ -454,7 +454,7 @@ and how stochastic perturbations are used in the Noah Land Surface Model. icloud_f gfdl_cloud_microphys_mod flag (0,1,or 2) for cloud fraction diagnostic scheme 0 irain_f gfdl_cloud_microphys_mod flag (0 or 1) for cloud water autoconversion to rain scheme. 0: with subgrid variability; 1: no subgrid variability 0 mp_time gfdl_cloud_microphys_mod time step of GFDL cloud microphysics (MP). If \p mp_time isn't divisible by physics time step or is larger than physics time step, the actual MP time step becomes \p dt/NINT[dt/MIN(dt,mp_time)] 150. -alin gfdl_cloud_microphys_mod parameter \a a in Lin et al.(1983). Constant in empirical formula for \f$U_R\f$. Increasing(decreasing) \p alin can boost(decrease) accretion of cloud water by rain and rain evaporation 842. +alin gfdl_cloud_microphys_mod parameter \a a in Lin et al.(1983). Constant in empirical formula for \f$U_R\f$. Increasing(decreasing) \p alin can boost(decrease) accretion of cloud water by rain and rain evaporation 842. clin gfdl_cloud_microphys_mod parameter \a c in Lin et al.(1983). Constant in empirical formula for \f$U_S\f$. Increasing(decreasing) \p clin can boost(decrease) accretion of cloud water by snow, accretion of cloud ice by snow, snow sublimation and deposition, and snow melting 4.8 t_min gfdl_cloud_microphys_mod temperature threshold for instant deposition. Deposit all water vapor to cloud ice when temperature is lower than \p t_min 178. t_sub gfdl_cloud_microphys_mod temperature threshold for sublimation. Cloud ice, snow or graupel stops(starts) sublimation when temperature is lower(higher) then \p t_sub 184. diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 83ff8d554..65adffab5 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -106,17 +106,8 @@ end subroutine m_micro_finalize !> \defgroup mg2mg3 Morrison-Gettelman MP scheme Module !! This module contains the the entity of MG2 and MG3 schemes. !> @{ -!> \defgroup mg_driver Morrison-Gettelman MP Driver Module -!! \brief This subroutine is the Morrison-Gettelman MP driver, which computes -!! grid-scale condensation and evaporation of cloud condensate. - -#if 0 - !> \section arg_table_m_micro_run Argument Table !! \htmlinclude m_micro_run.html -!! -#endif -!>\ingroup mg_driver !>\section detail_m_micro_run MG m_micro_run Detailed Algorithm !> @{ subroutine m_micro_run( im, ix, lm, flipv, dt_i & diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 22b8124c1..e3b760738 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -21,11 +21,9 @@ module mp_thompson contains !> This subroutine is a wrapper around the actual mp_gt_driver(). -#if 0 !! \section arg_table_mp_thompson_init Argument Table !! \htmlinclude mp_thompson_init.html !! -#endif subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & nwfa2d, nifa2d, nwfa, nifa, & mpicomm, mpirank, mpiroot, & @@ -129,11 +127,9 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & end subroutine mp_thompson_init -#if 0 !> \section arg_table_mp_thompson_run Argument Table !! \htmlinclude mp_thompson_run.html !! -#endif !>\ingroup aathompson !>\section gen_thompson_hrrr Thompson MP General Algorithm !>@{ diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 3b4b8a118..a7436cb8f 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -130,11 +130,9 @@ end subroutine lsm_ruc_finalize !> \defgroup lsm_ruc_group GSD RUC LSM Model !! This module contains the RUC Land Surface Model developed by NOAA/GSD !! (Smirnova et al. 2016 \cite Smirnova_2016). -#if 0 !> \section arg_table_lsm_ruc_run Argument Table !! \htmlinclude lsm_ruc_run.html !! -#endif !>\section gen_lsmruc GSD RUC LSM General Algorithm ! DH* TODO - make order of arguments the same as in the metadata table subroutine lsm_ruc_run & ! inputs From e9909192b9a81709562536b7d806b87dacbd23d8 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Fri, 27 Mar 2020 15:15:53 -0600 Subject: [PATCH 100/141] fix m_micro prebuild error --- physics/m_micro.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 65adffab5..fceadce09 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -103,11 +103,13 @@ end subroutine m_micro_init subroutine m_micro_finalize end subroutine m_micro_finalize -!> \defgroup mg2mg3 Morrison-Gettelman MP scheme Module -!! This module contains the the entity of MG2 and MG3 schemes. -!> @{ +!> \defgroup mg_driver Morrison-Gettelman MP Driver Module +!! \brief This subroutine is the Morrison-Gettelman MP driver, which computes +!! grid-scale condensation and evaporation of cloud condensate. +!! !> \section arg_table_m_micro_run Argument Table -!! \htmlinclude m_micro_run.html +!> \htmlinclude m_micro_run.html +!! !>\section detail_m_micro_run MG m_micro_run Detailed Algorithm !> @{ subroutine m_micro_run( im, ix, lm, flipv, dt_i & @@ -2003,6 +2005,5 @@ subroutine find_cldtop(ncol, pver, cf, kcldtop) end subroutine find_cldtop -!> @} end module m_micro From cec1ad95f14f02e4fb6c7da2ab1684e9111024ff Mon Sep 17 00:00:00 2001 From: Man Zhang Date: Fri, 27 Mar 2020 15:28:28 -0600 Subject: [PATCH 101/141] fix doc of m_micro --- physics/m_micro.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index fceadce09..c81348e43 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -14,8 +14,7 @@ module m_micro contains -!>\ingroup mg_driver -!! This subroutine is the MG initialization. +!> This subroutine is the MG initialization. !> \section arg_table_m_micro_init Argument Table !! \htmlinclude m_micro_init.html !! @@ -103,7 +102,7 @@ end subroutine m_micro_init subroutine m_micro_finalize end subroutine m_micro_finalize -!> \defgroup mg_driver Morrison-Gettelman MP Driver Module +!> \defgroup mg2mg3 Morrison-Gettelman MP Driver Module !! \brief This subroutine is the Morrison-Gettelman MP driver, which computes !! grid-scale condensation and evaporation of cloud condensate. !! @@ -1884,7 +1883,7 @@ end subroutine m_micro_run !DONIF Calculate the Brunt_Vaisala frequency !=============================================================================== -!>\ingroup mg_driver +!>\ingroup mg2mg3 !> This subroutine computes profiles of background state quantities for !! the multiple gravity wave drag parameterization. !!\section gw_prof_gen MG gw_prof General Algorithm @@ -1971,7 +1970,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & end subroutine gw_prof !> @} -!>\ingroup mg_driver +!>\ingroup mg2mg3 !! This subroutine is to find cloud top based on cloud fraction. subroutine find_cldtop(ncol, pver, cf, kcldtop) implicit none From 540035a92ba73b6e572acd8c02e98da85283bdaf Mon Sep 17 00:00:00 2001 From: mzhangw Date: Mon, 30 Mar 2020 13:44:06 -0600 Subject: [PATCH 102/141] Update physics/docs/pdftxt/mainpage.txt Co-Authored-By: ligiabernardet --- physics/docs/pdftxt/mainpage.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/docs/pdftxt/mainpage.txt b/physics/docs/pdftxt/mainpage.txt index a670441f5..2abaeca7c 100644 --- a/physics/docs/pdftxt/mainpage.txt +++ b/physics/docs/pdftxt/mainpage.txt @@ -10,7 +10,7 @@ operational implementations. This version contains all parameterizations of the plus additional developmental schemes. There are four suites supported for use with the Single Column Model (SCM) developed by the Development Testbed Center (GFS_v15p2, GFS_v16beta, GSD_v1, and csawmg), and four suites supported for use with the atmospheric component of the UFS (i.e., GFS_v15p2, GFS_v15p2_no_nsst, GFS_v16beta and -GFS_v16beta_no_nsst). The variants labelled as \a no_nsst are simplification of GFS_v15p2 and GFS_v16beta +GFS_v16beta_no_nsst). The variants labelled as \a no_nsst are a simplification of GFS_v15p2 and GFS_v16beta suites . This simplification is needed when the UFS is initialized with files in GRIdded Binary Edition 2 (GRIB2) format instead of files in NOAA Environmental Modeling System (NEMS) Input/Output (NEMSIO) format because the fields necessary to predict (SST) are not available in the GRIB2 files. From 7dea01c47de30b7df77b8396065929dad56ffe7e Mon Sep 17 00:00:00 2001 From: Man Zhang Date: Mon, 30 Mar 2020 13:49:48 -0600 Subject: [PATCH 103/141] minor fix --- physics/docs/pdftxt/all_shemes_list.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/docs/pdftxt/all_shemes_list.txt b/physics/docs/pdftxt/all_shemes_list.txt index c1f3bf1d8..79fd01611 100644 --- a/physics/docs/pdftxt/all_shemes_list.txt +++ b/physics/docs/pdftxt/all_shemes_list.txt @@ -85,7 +85,7 @@ to the parameterization. The CCPP includes the suite GFS_v15p2, which has the same parameterizations used in the GFS v15 implemented operationally in June 2019, and suite GFS_v16beta, i.e., the beta version of the suite planned for GFS v16 to be implemented operationally in 2021. Suite GFS_v16beta is identical to -Suite GFS_v15p2 except for an update in the PBL parameterization (Han et al. 2019 \cite Han_2019 ) and RRTMG. Additionally, CCPP v4 includes two +Suite GFS_v15p2 except for an update in the PBL parameterization (Han et al. 2019 \cite Han_2019 ). Additionally, CCPP v4 includes two developmental suites which are undergoing testing to inform future implementations of the UFS. Suite csawmg differs from GFS_v15p2 as it contains different convection and microphysics schemes made available through a NOAA Climate Process Team (CPT) with components developed at multiple research centers and universities, including Colorado State, Utah, NASA, NCAR, and EMC. Suite GSD_v0 differs from GFS_v15 as it From c494cc728d3fedb157bc46b9907c4f24f560d992 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 6 May 2020 09:47:33 -0600 Subject: [PATCH 104/141] Update version from 3.0.0 to 4.0.0 --- CMakeLists.txt | 2 +- physics/docs/pdftxt/UGWPv0.txt | 21 --------------------- 2 files changed, 1 insertion(+), 22 deletions(-) delete mode 100644 physics/docs/pdftxt/UGWPv0.txt diff --git a/CMakeLists.txt b/CMakeLists.txt index 7bd357d46..cd0d1c6d9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif (NOT PROJECT) cmake_minimum_required(VERSION 3.0) project(ccppphys - VERSION 3.0.0 + VERSION 4.0.0 LANGUAGES C CXX Fortran) # Use rpaths on MacOSX diff --git a/physics/docs/pdftxt/UGWPv0.txt b/physics/docs/pdftxt/UGWPv0.txt deleted file mode 100644 index da7009b79..000000000 --- a/physics/docs/pdftxt/UGWPv0.txt +++ /dev/null @@ -1,21 +0,0 @@ -/** -\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 - -*/ From 5229075e2bb1f2e45818890c7386b923bca7ff42 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 6 May 2020 09:47:51 -0600 Subject: [PATCH 105/141] Fix merge conflicts and apply missing updates for scientific documentation --- physics/docs/pdftxt/CPT_adv_suite.txt | 68 ++++--- physics/docs/pdftxt/GFS_OZPHYS.txt | 2 +- physics/docs/pdftxt/GSD_adv_suite.txt | 231 +++++++++++++++--------- physics/docs/pdftxt/all_shemes_list.txt | 15 +- physics/docs/pdftxt/mainpage.txt | 9 +- physics/docs/pdftxt/suite_input.nml.txt | 60 ++++-- 6 files changed, 253 insertions(+), 132 deletions(-) diff --git a/physics/docs/pdftxt/CPT_adv_suite.txt b/physics/docs/pdftxt/CPT_adv_suite.txt index 132d8bd11..ce51b6a30 100644 --- a/physics/docs/pdftxt/CPT_adv_suite.txt +++ b/physics/docs/pdftxt/CPT_adv_suite.txt @@ -3,31 +3,28 @@ \section csawmg_suite_overview Overview -The advanced csawmg physics suite uses the parameterizations in the following order: +The csawmg physics suite uses the parameterizations in the following order: - \ref GFS_RRTMG - \ref GFS_SFCLYR - \ref GFS_NSST - \ref GFS_NOAH - \ref GFS_SFCSICE - \ref GFS_HEDMF - - \ref GFS_GWDPS + - \ref GFS_UGWP_v0 - \ref GFS_RAYLEIGH - \ref GFS_OZPHYS - \ref GFS_H2OPHYS - \ref CSAW_scheme - - \ref GFS_GWDC - \ref GFS_SAMFshal - \ref CPT_MG3 - \ref mod_cs_conv_aw_adj - \ref GFS_CALPRECIPTYPE \section sdf_cpt_suite Suite Definition File - -The advanced csawmg physics suite uses the parameterizations in the following order, as defined in \c SCM_csawmg : \code - + @@ -56,9 +53,10 @@ The advanced csawmg physics suite uses the parameterizations in the following or GFS_suite_stateout_reset get_prs_fv3 GFS_suite_interstitial_1 - dcyc2t3 GFS_surface_generic_pre GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter GFS_suite_interstitial_2 @@ -83,8 +81,9 @@ The advanced csawmg physics suite uses the parameterizations in the following or hedmf GFS_PBL_generic_post GFS_GWD_generic_pre - gwdps - gwdps_post + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post rayleigh_damp GFS_suite_stateout_update ozphys_2015 @@ -96,12 +95,8 @@ The advanced csawmg physics suite uses the parameterizations in the following or cs_conv cs_conv_post GFS_DCNV_generic_post - gwdc_pre - gwdc - gwdc_post GFS_SCNV_generic_pre samfshalcnv - samfshalcnv_post GFS_SCNV_generic_post GFS_suite_interstitial_4 cnvc90 @@ -111,21 +106,20 @@ The advanced csawmg physics suite uses the parameterizations in the following or m_micro_post cs_conv_aw_adj GFS_MP_generic_post - sfc_sice_post maximum_hourly_diagnostics - \endcode -\section cpt_nml_option Namelist Option +\section cpt_nml_option Namelist \code &gfs_physics_nml fhzero = 6. ldiag3d = .true. fhcyc = 24. + nst_anl = .true. use_ufo = .true. pre_rad = .false. crtrh = 0.93,0.90,0.95 @@ -147,25 +141,40 @@ The advanced csawmg physics suite uses the parameterizations in the following or shal_cnv = .true. cal_pre = .false. redrag = .true. - dspheat = .true. + dspheat = .false. hybedmf = .true. satmedmf = .false. - lheatstrg = .true. + lheatstrg = .false. random_clds = .true. trans_trac = .true. - cnvcld = .true. + cnvcld = .false. imfshalcnv = 2 imfdeepcnv = -1 cdmbgwd = 3.5,0.25 prslrd0 = 0. ivegsrc = 1 isot = 1 + lsm = 1 + iopt_dveg = 2 + iopt_crs = 1 + iopt_btr = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_alb = 2 + iopt_snf = 4 + iopt_tbot = 2 + iopt_stc = 1 oz_phys = .false. oz_phys_2015 = .true. debug = .false. + ras = .false. cscnv = .true. do_shoc = .false. + shoc_parm = 7000.0,1.0,2.0,0.7,-999.0 do_aw = .true. shoc_cld = .false. h2o_phys = .true. @@ -173,8 +182,6 @@ The advanced csawmg physics suite uses the parameterizations in the following or xkzm_h = 0.5 xkzm_m = 0.5 xkzm_s = 1.0 - nstf_name = 2,1,1,0,5 - nst_anl = .true. ccwf = 1.0,1.0 dlqf = 0.25,0.05 mg_dcs = 200.0 @@ -190,12 +197,13 @@ The advanced csawmg physics suite uses the parameterizations in the following or mg_do_ice_gmao = .false. mg_do_liq_liu = .true. cs_parm = 8.0,4.0,1.0e3,3.5e3,20.0,1.0,0.0,1.0,0.6,0.0 - shoc_parm = 7000.0,1.0,2.0,0.7,-999.0 ctei_rm = 0.60,0.23 max_lon = 8000 max_lat = 4000 rhcmax = 0.9999999 effr_in = .true. + + nstf_name = 2,1,1,0,5 ltaerosol = .false. lradar = .false. cplflx = .false. @@ -203,6 +211,22 @@ The advanced csawmg physics suite uses the parameterizations in the following or iaufhrs = 30 iau_inc_files = "''" / + +&cires_ugwp_nml + knob_ugwp_solver = 2 + knob_ugwp_source = 1,1,0,0 + knob_ugwp_wvspec = 1,25,25,25 + knob_ugwp_azdir = 2,4,4,4 + knob_ugwp_stoch = 0,0,0,0 + knob_ugwp_effac = 1,1,1,1 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_version = 0 + launch_level = 25 +/ +/ \endcode diff --git a/physics/docs/pdftxt/GFS_OZPHYS.txt b/physics/docs/pdftxt/GFS_OZPHYS.txt index fadaf95a5..3a2ddc173 100644 --- a/physics/docs/pdftxt/GFS_OZPHYS.txt +++ b/physics/docs/pdftxt/GFS_OZPHYS.txt @@ -1,5 +1,5 @@ /** -\page GFS_OZPHYS GFS Ozone Photochemistry Scheme +\page GFS_OZPHYS GFS Ozone Photochemistry (2015) Scheme \section des_ozone Description In recent years, the leading NWP centers have extended the vertical range of their NWP and DA systems from the surface up through the stratosphere (~10-50 km altitude) and lower mesosphere (~50-65 km). Some diff --git a/physics/docs/pdftxt/GSD_adv_suite.txt b/physics/docs/pdftxt/GSD_adv_suite.txt index fb662bc22..3ee38f32f 100644 --- a/physics/docs/pdftxt/GSD_adv_suite.txt +++ b/physics/docs/pdftxt/GSD_adv_suite.txt @@ -1,47 +1,38 @@ /** -\page GSD_v0_page GSD_v0 Suite +\page GSD_v1_page GSD_v1 Suite \section gsd_suite_overview Overview -The original Rapid Update Cycle (RUC), implemented in 1994, was designed to provide accurate short-range (0 to 12-hr) -numerical forecast guidance for weather-sensitive users, including those in the U.S. aviation community. -The RUC started to run every hour starting in 1998. Significant weather forecasting problems that occur in the 0- to -12-hr range include severe weather in all seasons (for example, tornadoes, severe thunderstorms, crippling snow, and -ice storms) and hazards to aviation (for example, clear air turbulence, icing, and downbursts). The RUC soon became a -key model for short-range convectiion forecasts and for the pre-convective environments. +Suite GSD_v1 contains the parameterizations used in the NOAA operational Rapid Refresh (RAP) +and High-Resolution Rapid Refresh (HRRR) models. These models runs at 13- and 3- km resolution, +respectively. -The RAP, which replaced the RUC in 2012, runs hourly at the National Centers for Environmental Prediction (NCEP), providing -high frequency updates of current conditions and short-range forecasts over North America at 13km resolution. A CONUS-nested -version at 3-km resolution called the High Resolution Rapid Refresh (HRRR), was implemented in the fall of 2014. Additional Model Information Links: - https://rapidrefresh.noaa.gov - https://rapidrefresh.noaa.gov/hrrr/ -The advanced GSD RAP/HRRR physics suite uses the parameterizations in the following order: +The GSD_v1 physics suite uses the parameterizations in the following order: - \ref GFS_RRTMG - \ref GFS_SFCLYR - \ref GFS_NSST - \ref GSD_RUCLSM - \ref GSD_MYNNEDMF - - \ref GFS_GWDPS + - \ref GFS_UGWP_v0 - \ref GFS_RAYLEIGH - \ref GFS_OZPHYS - \ref GFS_H2OPHYS - \ref GSD_CU_GF - \ref cu_gf_deep_group - \ref cu_gf_sh_group - - \ref GFS_GWDC - \ref GSD_THOMPSON - \ref GFS_CALPRECIPTYPE \section sdf_gsdsuite Suite Definition File - -The GSD RAP/HRRR physics suite uses the parameterizations in the following order, as defined in \c SCM_GSD_v0: \code - + @@ -72,9 +63,10 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order GFS_suite_stateout_reset get_prs_fv3 GFS_suite_interstitial_1 - dcyc2t3 GFS_surface_generic_pre GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter GFS_suite_interstitial_2 @@ -85,6 +77,9 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order sfc_nst sfc_nst_post lsm_ruc + lsm_ruc_sfc_sice_pre + sfc_sice + lsm_ruc_sfc_sice_post GFS_surface_loop_control_part2 @@ -96,8 +91,9 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order GFS_surface_generic_post mynnedmf_wrapper GFS_GWD_generic_pre - gwdps - gwdps_post + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post rayleigh_damp GFS_suite_stateout_update ozphys_2015 @@ -108,9 +104,6 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order cu_gf_driver_pre cu_gf_driver GFS_DCNV_generic_post - gwdc_pre - gwdc - gwdc_post GFS_SCNV_generic_pre GFS_SCNV_generic_post GFS_suite_interstitial_4 @@ -126,73 +119,149 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order - \endcode -\section gsd_nml_option Namelist Option +\section gsd_nml_option Namelist \code &gfs_physics_nml - fhzero = 6. - h2o_phys = .true. - ldiag3d = .true. - fhcyc = 0. - nst_anl = .true. - use_ufo = .true. - pre_rad = .false. - ncld = 5 - imp_physics = 8 - ltaerosol = .true. - lradar = .true. - ttendlim = -999. - pdfcld = .false. - fhswr = 3600. - fhlwr = 3600. - ialb = 1 - iems = 1 - iaer = 111 - ico2 = 2 - isubc_sw = 2 - isubc_lw = 2 - isol = 2 - lwhtr = .true. - swhtr = .true. - cnvgwd = .true. - shal_cnv = .true. - cal_pre = .false. - redrag = .true. - dspheat = .true. - hybedmf = .false. - satmedmf = .false. - lheatstrg = .false. - do_mynnedmf = .true. - do_mynnsfclay = .false. - random_clds = .false. - trans_trac = .true. - cnvcld = .true. - imfshalcnv = 3 - imfdeepcnv = 3 - cdmbgwd = 3.5,0.25 - prslrd0 = 0. - ivegsrc = 1 - isot = 1 - debug = .false. - oz_phys = .false. - oz_phys_2015 = .true. - nstf_name = 2,1,1,0,5 - cplflx = .false. - iau_delthrs = 6 - iaufhrs = 30 - iau_inc_files = "''" - do_sppt = .false. - do_shum = .false. - do_skeb = .false. - do_sfcperts = .false. - lsm = 2 - lsoil_lsm = 9 + fhzero = 6. + h2o_phys = .true. + ldiag3d = .true. + fhcyc = 0. + nst_anl = .true. + use_ufo = .true. + pre_rad = .false. + ncld = 5 + imp_physics = 8 + ltaerosol = .true. + lradar = .true. + ttendlim = 0.004 + pdfcld = .false. + fhswr = 3600. + fhlwr = 3600. + ialb = 1 + iems = 1 + iaer = 111 + ico2 = 2 + isubc_sw = 2 + isubc_lw = 2 + isol = 2 + lwhtr = .true. + swhtr = .true. + cnvgwd = .true. + shal_cnv = .true. + cal_pre = .false. + redrag = .true. + dspheat = .true. + hybedmf = .false. + satmedmf = .false. + lheatstrg = .false. + do_mynnedmf = .true. + do_mynnsfclay = .false. + random_clds = .false. + trans_trac = .true. + cnvcld = .true. + imfshalcnv = 3 + imfdeepcnv = 3 + cdmbgwd = 3.5,0.25 + prslrd0 = 0. + ivegsrc = 1 + isot = 1 + debug = .false. + oz_phys = .false. + oz_phys_2015 = .true. + nstf_name = 2,1,1,0,5 + cplflx = .false. + iau_delthrs = 6 + iaufhrs = 30 + iau_inc_files = "''" + do_sppt = .false. + do_shum = .false. + do_skeb = .false. + do_sfcperts = .false. + lsm = 3 + lsoil_lsm = 9 + iopt_dveg = 2 + iopt_crs = 1 + iopt_btr = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_alb = 2 + iopt_snf = 4 + iopt_tbot = 2 + iopt_stc = 1 icloud_bl = 1 bl_mynn_tkeadvect = .true. bl_mynn_edmf = 1 bl_mynn_edmf_mom = 1 + gwd_opt = 1 +/ + +&gfdl_cloud_microphysics_nml + sedi_transport = .true. + do_sedi_heat = .false. + rad_snow = .true. + rad_graupel = .true. + rad_rain = .true. + const_vi = .F. + const_vs = .F. + const_vg = .F. + const_vr = .F. + vi_max = 1. + vs_max = 2. + vg_max = 12. + vr_max = 12. + qi_lim = 1. + prog_ccn = .false. + do_qa = .false. + fast_sat_adj = .false. + tau_l2v = 225. + tau_v2l = 150. + tau_g2v = 900. + rthresh = 10.e-6 + dw_land = 0.16 + dw_ocean = 0.10 + ql_gen = 1.0e-3 + ql_mlt = 1.0e-3 + qi0_crt = 8.0E-5 + qs0_crt = 1.0e-3 + tau_i2s = 1000. + c_psaci = 0.05 + c_pgacs = 0.01 + rh_inc = 0.30 + rh_inr = 0.30 + rh_ins = 0.30 + ccn_l = 300. + ccn_o = 100. + c_paut = 0.5 + c_cracw = 0.8 + use_ppm = .false. + use_ccn = .true. + mono_prof = .true. + z_slope_liq = .true. + z_slope_ice = .true. + de_ice = .false. + fix_negative = .true. + icloud_f = 1 + mp_time = 150. +/ + +&cires_ugwp_nml + knob_ugwp_solver = 2 + knob_ugwp_source = 1,1,0,0 + knob_ugwp_wvspec = 1,25,25,25 + knob_ugwp_azdir = 2,4,4,4 + knob_ugwp_stoch = 0,0,0,0 + knob_ugwp_effac = 1,1,1,1 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_version = 0 + launch_level = 25 / \endcode diff --git a/physics/docs/pdftxt/all_shemes_list.txt b/physics/docs/pdftxt/all_shemes_list.txt index 79fd01611..4d7d08e90 100644 --- a/physics/docs/pdftxt/all_shemes_list.txt +++ b/physics/docs/pdftxt/all_shemes_list.txt @@ -1,11 +1,10 @@ /** \page allscheme_page Parameterizations and Suites Overview -\section allscheme_overview Physics Parameterizations +\section allscheme_overview Physical Parameterizations -In the CCPP-Physics v3.0 release, each parameterization is in its own modern Fortran module, - which facilitates model development and -code maintenance. While some individual parameterization can be invoked for the GMTB SCM, most users will assemble the +In the CCPP, each parameterization is in its own modern Fortran module, which facilitates model development and +code maintenance. While some individual parameterization can be invoked for the SCM, most users will assemble the parameterizations in suites. - \b Radiation @@ -38,15 +37,13 @@ parameterizations in suites. - \b Ozone \b Photochemical \b Production \b and \b Loss - \subpage GFS_OZPHYS - - \ref GFS_ozphys_2015 - \b Water \b Vapor \b Photochemical \b Production \b and \b Loss - \subpage GFS_H2OPHYS - \b Gravity \b Wave \b Drag - - \subpage GFS_GWDPS - - \subpage GFS_GWDC - - \subpage UGWPv0 + - \subpage GFS_UGWP_v0 + - \subpage GFS_GWDPS - \b Surface \b Layer \b and \b Simplified \b Ocean \b and \b Sea \b Ice \b Representation - \subpage GFS_SFCLYR @@ -88,7 +85,7 @@ GFS_v16beta, i.e., the beta version of the suite planned for GFS v16 to be imple Suite GFS_v15p2 except for an update in the PBL parameterization (Han et al. 2019 \cite Han_2019 ). Additionally, CCPP v4 includes two developmental suites which are undergoing testing to inform future implementations of the UFS. Suite csawmg differs from GFS_v15p2 as it contains different convection and microphysics schemes made available through a NOAA Climate Process Team (CPT) with components developed -at multiple research centers and universities, including Colorado State, Utah, NASA, NCAR, and EMC. Suite GSD_v0 differs from GFS_v15 as it +at multiple research centers and universities, including Colorado State, Utah, NASA, NCAR, and EMC. Suite GSD_v1 differs from GFS_v15p2 as it uses the convection, microphysics, and boundary layer schemes employed in the Rapid Refresh (RAP) and High-Resolution Rapid Refresh (HRRR \cite Benjamin_2016 ) operational models and was assembled by NOAA/GSD. An assessment of an earlier version of these suites can be found in the UFS portal diff --git a/physics/docs/pdftxt/mainpage.txt b/physics/docs/pdftxt/mainpage.txt index 2abaeca7c..fdf7d1294 100644 --- a/physics/docs/pdftxt/mainpage.txt +++ b/physics/docs/pdftxt/mainpage.txt @@ -1,11 +1,12 @@ /** \mainpage Introduction -Welcome to the scientific documentation for the parameterizations available in the Common -Community Physics Package (CCPP) v3.0 public release. +Welcome to the scientific documentation for the parameterizations and suites available in the Common +Community Physics Package (CCPP) v4. -The CCPP-Physics is envisioned to contain parameterizations used by NOAA operational models for weather through -seasonal prediction timescales, as well as developmental schemes under consideration for upcoming +The CCPP-Physics is envisioned to contain parameterizations used in NOAA's Unified Forecast System (UFS) +applications for weather through seasonal prediction timescales, encompassing operational schemes as well as +developmental schemes under consideration for upcoming operational implementations. This version contains all parameterizations of the current operational GFS, plus additional developmental schemes. There are four suites supported for use with the Single Column Model (SCM) developed by the Development Testbed Center (GFS_v15p2, GFS_v16beta, GSD_v1, and csawmg), and four suites diff --git a/physics/docs/pdftxt/suite_input.nml.txt b/physics/docs/pdftxt/suite_input.nml.txt index 95b77c22f..2565c58eb 100644 --- a/physics/docs/pdftxt/suite_input.nml.txt +++ b/physics/docs/pdftxt/suite_input.nml.txt @@ -1,20 +1,24 @@ /** -\page GFSsuite_nml Namelist Options Description +\page CCPPsuite_nml_desp Namelist Options Description -At runtime, the SCM and the UFS Atmosphere access runtime configurations from file \c input.nml. This file contains -various namelists that control aspects of the I/O, dynamics, physics etc. Most physics-related options are grouped into -two namelists:\b &gfs_physics_nml and \b &gfdl_cloud_microphysics_nml, with additional specifications for stochastic physics in +The SCM and the UFS Atmosphere access runtime configurations from file \c input.nml. This file contains +various namelists records that control aspects of the I/O, dynamics, physics etc. Most physics-related options are in +reords \b &gfs_physics_nml and \b &cires_ugwp_nml. When using the GFDL microphysics scheme, variables in namelist +\b &gfdl_cloud_microphysics_nml are also used. Additional specifications for stochastic physics are in namelists \b &stochy_nam and \b &nam_sfcperts. - Namelist \b &gfdl_cloud_microphysics_nml is only relevant when the GFDL microphysics is used, and its variables are defined in module_gfdl_cloud_microphys.F90. +- Namelist \b &cires_ugwp_nml specifies options for the use of CIRES Unified Gravity Wave Physics Version 0. + - Namelist \b &gfs_physics_nml pertains to all of the suites used, but some of the variables are only relevant for specific parameterizations. Its variables are defined in file GFS_typedefs.F90 in the host model. - Namelist \b &stochy_nam specifies options for the use of SPPT, SKEB and SHUM, while namelist \b &nam_sfcperts specifies whether and how stochastic perturbations are used in the Noah Land Surface Model. +
NML Description
option DDT in Host Model Description Default Value @@ -117,13 +121,19 @@ and how stochastic perturbations are used in the Noah Land Surface Model.
  • =2 future development (not yet)
    		• 0 -
    iaer gfs_control_type aerosol flag "abc" (volcanic, LW, SW): \n +
    iaer gfs_control_type 4-digit aerosol flag (dabc for aermdl, volcanic, LW, SW): \n
      -
    • a: stratospheric volcanic aerosols -
    • b: tropospheric aerosols for LW -
    • c: tropospheric aerosols for SW \n - 0: aerosol effect is not included; \n - 1: aerosol effect is included +
    • d:tropospheric aerosol model scheme flag \n + =0 or none, opac-climatology aerosol scheme \n + =1 use gocart climatology aerosol scheme \n + =2 use gocart prognostic aerosol scheme \n + =5 opac-clim new spectral mapping +
    • a:=0 use background stratospheric aerosol \n + =1 include stratospheric volcanic aerosol +
    • b:=0 no tropospheric aerosol in LW radiation \n + =1 include tropospheric aerosol in LW +
    • c:=0 no tropospheric aerosol in SW radiation \n + =1 include tropospheric aerosol in SW
    		1
    ico2 gfs_control_type \f$CO_2\f$ data source control flag:\n @@ -159,7 +169,7 @@ and how stochastic perturbations are used in the Noah Land Surface Model. 0
    lwhtr gfs_control_type logical flag for output of longwave heating rate .true.
    swhtr gfs_control_type logical flag for output of shortwave heating rate .true. -
    cnvgwd gfs_control_type logical flag for convective gravity wave drag scheme .false. +
    cnvgwd gfs_control_type logical flag for convective gravity wave drag scheme dependent on maxval(cdmbgwd(3:4) == 0.0) .false.
    shal_cnv gfs_control_type logical flag for calling shallow convection .false.
    lmfshal gfs_control_type flag for mass-flux shallow convection scheme in the cloud fraction calculation shal_cnv .and. (imfshalcnv > 0)
    lmfdeep2 gfs_control_type flag for mass-flux deep convection scheme in the cloud fraction calculation imfdeepcnv == 2 .or. 3 .or.4 @@ -168,6 +178,12 @@ and how stochastic perturbations are used in the Noah Land Surface Model.
    dspheat gfs_control_type logical flag for using TKE dissipative heating to temperature tendency in hybrid EDMF and TKE-EDMF schemes .false.
    hybedmf gfs_control_type logical flag for calling hybrid EDMF PBL scheme .false.
    satmedmf gfs_control_type logical flag for calling TKE EDMF PBL scheme .false. +
    isatmedmf gfs_control_type flag for scale-aware TKE-based moist EDMF scheme \n +
      +
    • 0: initial version of satmedmf (Nov.2018) +
    • 1: updated version of satmedmf (as of May 2019) +
    +     		0
    do_mynnedmf gfs_control_type flag to activate MYNN-EDMF scheme .false.
    random_clds gfs_control_type logical flag for whether clouds are random .false.
    trans_trac gfs_control_type logical flag for convective transport of tracers .false. @@ -187,6 +203,7 @@ and how stochastic perturbations are used in the Noah Land Surface Model. 1
    imfdeepcnv gfs_control_type flag for mass-flux deep convective scheme:\n
      +
    • -1: Chikira-Sugiyama deep convection (with \b cscnv = .T.)
    • 1: July 2010 version of SAS convective scheme (operational version as of 2016)
    • 2: scale- & aerosol-aware mass-flux deep convective scheme (2017)
    • 3: scale- & aerosol-aware Grell-Freitas scheme (GSD) @@ -194,12 +211,18 @@ and how stochastic perturbations are used in the Noah Land Surface Model.
    		1
    lgfdlmprad gfs_control_type flag for GFDL mp scheme and radiation consistency .false. -
    cdmbgwd(2) gfs_control_type multiplication factors for mountain blocking and orographic gravity wave drag 2.0,0.25 +
    cdmbgwd(4) gfs_control_type multiplication factors for mountain blocking(1), orographic gravity wave drag(2) +
      +
    • [1]: GWDPS mountain blocking +
    • [2]: GWDPS orographic gravity wave drag +
    • [3]: the modulation total momentum flux of NGWs by intensities of the total precipitation +
    • [4]: TKE for future tests and applications +
    +     		2.0,0.25,1.0,1.0
    prslrd0 gfs_control_type pressure level above which to apply Rayleigh damping 0.0d0
    lsm gfs_control_type flag for land surface model to use \n
      -
    • 0: OSU LSM -
    • 1: NOAH LSM +
    • 1: Noah LSM
    • 2: RUC LSM
    		1 @@ -342,7 +365,14 @@ and how stochastic perturbations are used in the Noah Land Surface Model. 1
    lsoil_lsm gfs_control_type number of soil layers internal to land surface model -1 -
    \b Stochastic \b Physics \b Specific \b Parameters +
    ldiag_ugwp GFS_control_type flag for CIRES UGWP diagnostics .false. +
    do_ugwp GFS_control_type flag for CIRES UGWP revised OGW +
      +
    • .T.: revised gwdps_v0 +
    • .F.: GFS operational orographic gwdps +
    +     		.false. +
    do_tofd GFS_control_type flag for turbulent orographic form drag .false.
    do_sppt gfs_control_type flag for stochastic SPPT option .false.
    do_shum gfs_control_type flag for stochastic SHUM option .false.
    do_skeb gfs_control_type flag for stochastic SKEB option .false. From 6c1eec4f354d305bc8088ac883e9f133785a6514 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 6 May 2020 10:19:41 -0600 Subject: [PATCH 106/141] Remove dcyc2t3_post from physics/dcyc2.meta and scientific documentation --- physics/dcyc2.meta | 67 ------------------- physics/docs/pdftxt/CPT_adv_suite.txt | 1 - physics/docs/pdftxt/GFSv14_suite.txt | 1 - physics/docs/pdftxt/GFSv15_suite.txt | 1 - physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt | 1 - physics/docs/pdftxt/GSD_adv_suite.txt | 1 - .../docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt | 1 - .../suite_FV3_GFS_v15p2_no_nsst.xml.txt | 1 - .../docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt | 1 - .../suite_FV3_GFS_v16beta_no_nsst.xml.txt | 1 - 10 files changed, 76 deletions(-) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 244ebc6bd..9a5687bf5 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -535,70 +535,3 @@ type = integer intent = out optional = F - -######################################################################## -[ccpp-arg-table] - name = dcyc2t3_post_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = dcyc2t3_post_finalize - type = scheme - -######################################################################## -[ccpp-arg-table] - name = dcyc2t3_post_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - 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 - 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/docs/pdftxt/CPT_adv_suite.txt b/physics/docs/pdftxt/CPT_adv_suite.txt index ce51b6a30..26d514d51 100644 --- a/physics/docs/pdftxt/CPT_adv_suite.txt +++ b/physics/docs/pdftxt/CPT_adv_suite.txt @@ -73,7 +73,6 @@ The csawmg physics suite uses the parameterizations in the following order: GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/GFSv14_suite.txt b/physics/docs/pdftxt/GFSv14_suite.txt index 23f611a25..d1dcb038c 100644 --- a/physics/docs/pdftxt/GFSv14_suite.txt +++ b/physics/docs/pdftxt/GFSv14_suite.txt @@ -75,7 +75,6 @@ The GFS v14 suite uses the parameterizations in the following order, as defined - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/GFSv15_suite.txt b/physics/docs/pdftxt/GFSv15_suite.txt index 6b5fddcf8..abf446224 100644 --- a/physics/docs/pdftxt/GFSv15_suite.txt +++ b/physics/docs/pdftxt/GFSv15_suite.txt @@ -85,7 +85,6 @@ The GFS v15 suite uses the parameterizations in the following order, as defined GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt b/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt index 56a1f97f5..6215fe361 100644 --- a/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt +++ b/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt @@ -76,7 +76,6 @@ The GFS v15plus suite uses the parameterizations in the following order, as defi GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/GSD_adv_suite.txt b/physics/docs/pdftxt/GSD_adv_suite.txt index 3ee38f32f..39c5ebd20 100644 --- a/physics/docs/pdftxt/GSD_adv_suite.txt +++ b/physics/docs/pdftxt/GSD_adv_suite.txt @@ -85,7 +85,6 @@ The GSD_v1 physics suite uses the parameterizations in the following order: GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt index f12b0c366..4074ddfc7 100644 --- a/physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt +++ b/physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt @@ -58,7 +58,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt index cd29eecdb..7a60f5e1c 100644 --- a/physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt +++ b/physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt @@ -56,7 +56,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt index 722224988..4abafe01a 100644 --- a/physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt +++ b/physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt @@ -58,7 +58,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt index adeb4352a..e783be1f9 100644 --- a/physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt +++ b/physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt @@ -56,7 +56,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post From e340e62c6c6186cc4e5384459ee23f8bd2da659a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 11 May 2020 07:32:57 -0600 Subject: [PATCH 107/141] physics/m_micro.F90: correct syntax for \htmlinclude statement --- physics/m_micro.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index c81348e43..8b2b4c99f 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -107,7 +107,7 @@ end subroutine m_micro_finalize !! grid-scale condensation and evaporation of cloud condensate. !! !> \section arg_table_m_micro_run Argument Table -!> \htmlinclude m_micro_run.html +!! \htmlinclude m_micro_run.html !! !>\section detail_m_micro_run MG m_micro_run Detailed Algorithm !> @{ From 8f1169b5cd4d19905bebf97fe665f3c1471ea487 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 11 May 2020 15:54:49 -0600 Subject: [PATCH 108/141] physics/gfdl_fv_sat_adj.F90: add compatibility check for six water species --- physics/gfdl_fv_sat_adj.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/physics/gfdl_fv_sat_adj.F90 b/physics/gfdl_fv_sat_adj.F90 index f5c84cd99..025ee1c34 100644 --- a/physics/gfdl_fv_sat_adj.F90 +++ b/physics/gfdl_fv_sat_adj.F90 @@ -150,6 +150,12 @@ subroutine fv_sat_adj_init(do_sat_adj, kmp, nwat, ngas, rilist, cpilist, & return end if + if (.not.nwat==6) then + write(errmsg,'(a)') 'Logic error: fv_sat_adj requires six water species (nwat=6)' + errflg = 1 + return + end if + if (is_initialized) return ! generate es table (dt = 0.1 deg c) From dd70b5558d66952fffba9dc4c2b121198c8c078c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 11 May 2020 15:55:26 -0600 Subject: [PATCH 109/141] Add GitHub workflow for basic checks, add tool to check for ASCII encoding of Fortran source files and metadata files --- .github/workflows/basic_checks.yml | 33 ++++++++++++++++++++++++++++++ tools/check_encoding.py | 25 ++++++++++++++++++++++ 2 files changed, 58 insertions(+) create mode 100644 .github/workflows/basic_checks.yml create mode 100755 tools/check_encoding.py diff --git a/.github/workflows/basic_checks.yml b/.github/workflows/basic_checks.yml new file mode 100644 index 000000000..219c53bf4 --- /dev/null +++ b/.github/workflows/basic_checks.yml @@ -0,0 +1,33 @@ +name: Basic checks for CCPP physics schemes + +on: [push, pull_request] + +jobs: + build: + + runs-on: macos-latest + + steps: + - name: Checkout + uses: actions/checkout@v2 + - name: Init submodules + run: git submodule update --init --recursive + #- name: Update packages + # run: | + # /usr/bin/ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)" + # #brew install autoconf automake coreutils gcc@9 libtool mpich gnu-sed wget + # brew install automake coreutils mpich gnu-sed + - name: Check for ASCII encoding + run: ./tools/check_encoding.py + #run: | + #export CC=gcc-9 + #export FC=gfortran-9 + #export CXX=g++-9 + #mkdir build + #cd build + #cmake -DCMAKE_INSTALL_PREFIX=$PWD/../install .. 2>&1 | tee log.cmake + #make -j8 2>&1 | tee log.make + #cd .. + #ls -l install/bin/ESMF_Info + #ls -l install/bin/wgrib2 + #cat install/share/nceplibs-external.cmake.config diff --git a/tools/check_encoding.py b/tools/check_encoding.py new file mode 100755 index 000000000..cf4f568d4 --- /dev/null +++ b/tools/check_encoding.py @@ -0,0 +1,25 @@ +#!/usr/bin/env python + +#import chardet +import os +import sys + + +SUFFICES = [ '.f', '.F', '.f90', '.F90', '.meta' ] + +for root, dirs, files in os.walk(os.getcwd()): + print root, dirs, files + for file in files: + suffix = os.path.splitext(file)[1] + print file, suffix + if suffix in SUFFICES: + with open(os.path.join(root, file)) as f: + contents = f.read() + try: + contents.decode('ascii') + except UnicodeDecodeError: + for line in contents.split('\n'): + try: + line.decode('ascii') + except UnicodeDecodeError: + raise Exception('Detected non-ascii characters in file {}, line: "{}"'.format(os.path.join(root, file), line)) From 91a0dd98b06c1acdb4d95fa74d7b7b3f939a26f4 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 11 May 2020 17:05:51 -0600 Subject: [PATCH 110/141] Fix non-ascii encoding in a bunch of files (all comments) --- physics/cires_ugwp.F90 | 4 ++-- physics/drag_suite.F90 | 8 ++++---- physics/gwdps.f | 8 ++++---- physics/micro_mg_utils.F90 | 2 +- physics/samfdeepcnv.f | 2 +- physics/ugwp_driver_v0.F | 15 ++++++++++++++- 6 files changed, 26 insertions(+), 13 deletions(-) diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 504b24a77..07b235c72 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -6,8 +6,8 @@ !! "Unified": a) all GW effects due to both dissipation/breaking; b) identical GW solvers for all GW sources; c) ability to replace solvers. !! Unified Formalism: !! 1. GW Sources: Stochastic and physics based mechanisms for GW-excitations in the lower atmosphere, calibrated by the high-res analyses/forecasts, and observations (3 types of GW sources: orography, convection, fronts/jets). -!! 2. GW Propagation: Unified solver for “propagation, dissipation and breaking” excited from all type of GW sources. -!! 3. GW Effects: Unified representation of GW impacts on the ‘resolved’ flow for all sources (energy-balanced schemes for momentum, heat and mixing). +!! 2. GW Propagation: Unified solver for "propagation, dissipation and breaking" excited from all type of GW sources. +!! 3. GW Effects: Unified representation of GW impacts on the "resolved" flow for all sources (energy-balanced schemes for momentum, heat and mixing). !! https://www.weather.gov/media/sti/nggps/Presentations%202017/02%20NGGPS_VYUDIN_2017_.pdf module cires_ugwp diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 080bee156..0189785e3 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -90,7 +90,7 @@ end subroutine drag_suite_init !! the GWD scheme has the same physical basis as in Alpert (1987) with the addition !! of enhancement factors for the amplitude, G, and mountain shape details !! in G(Fr) to account for effects from the mountain blocking. A factor, -!! E m’, is an enhancement factor on the stress in the Alpert '87 scheme. +!! E m', is an enhancement factor on the stress in the Alpert '87 scheme. !! The E ranges from no enhancement to an upper limit of 3, E=E(OA)[1-3], !! and is a function of OA, the Orographic Asymmetry defined in KA (1995) as !! @@ -105,9 +105,9 @@ end subroutine drag_suite_init !! !! !! where Nx is the number of grid intervals for the large scale domain being -!! considered. So the term, E(OA)m’/ \f$ \Delta X \f$ in Kim's scheme represents -!! a multiplier on G shown in Alpert's eq (1), where m’ is the number of mountains -!! in a sub-grid scale box. Kim increased the complexity of m’ making it a +!! considered. So the term, E(OA)m'/ \f$ \Delta X \f$ in Kim's scheme represents +!! a multiplier on G shown in Alpert's eq (1), where m' is the number of mountains +!! in a sub-grid scale box. Kim increased the complexity of m' making it a !! function of the fractional area of the sub-grid mountain and the asymmetry !! and convexity statistics which are found from running a gravity wave !! model for a large number of cases: diff --git a/physics/gwdps.f b/physics/gwdps.f index 9454b967d..96ce0205b 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -87,7 +87,7 @@ end subroutine gwdps_init !! the GWD scheme has the same physical basis as in Alpert (1987) with the addition !! of enhancement factors for the amplitude, G, and mountain shape details !! in G(Fr) to account for effects from the mountain blocking. A factor, -!! E m’, is an enhancement factor on the stress in the Alpert '87 scheme. +!! E m', is an enhancement factor on the stress in the Alpert '87 scheme. !! The E ranges from no enhancement to an upper limit of 3, E=E(OA)[1-3], !! and is a function of OA, the Orographic Asymmetry defined in Kim and Arakawa (1995) !! \cite kim_and_arakawa_1995 as @@ -103,9 +103,9 @@ end subroutine gwdps_init !! \; (x_{j} \; - \; \bar{x} )^2}{N_{x}} } !!\f] !! where \f$N_{x}\f$ is the number of grid intervals for the large scale domain being -!! considered. So the term, E(OA)m’/ \f$ \Delta X \f$ in Kim's scheme represents -!! a multiplier on G shown in Alpert's eq (1), where m’ is the number of mountains -!! in a sub-grid scale box. Kim increased the complexity of m’ making it a +!! considered. So the term, E(OA)m'/ \f$ \Delta X \f$ in Kim's scheme represents +!! a multiplier on G shown in Alpert's eq (1), where m' is the number of mountains +!! in a sub-grid scale box. Kim increased the complexity of m' making it a !! function of the fractional area of the sub-grid mountain and the asymmetry !! and convexity statistics which are found from running a gravity wave !! model for a large number of cases: diff --git a/physics/micro_mg_utils.F90 b/physics/micro_mg_utils.F90 index 89dd7193e..74da36df4 100644 --- a/physics/micro_mg_utils.F90 +++ b/physics/micro_mg_utils.F90 @@ -2656,7 +2656,7 @@ end subroutine graupel_rime_splintering ! prdg(i) = epsg*(q(i)-qvi(i))/abi ! !! make sure not pushed into ice supersat/subsat -!! put this in main mg3 code…..check for it… +!! put this in main mg3 code ... check for it ... !! formula from reisner 2 scheme !! diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 8bffd0a42..03f5f05ef 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -63,7 +63,7 @@ end subroutine samfdeepcnv_finalize !! + 2) 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 grid sizes smaller than the threshold value (currently 8 km): !! + 1) compute the cloud base mass flux using the cumulus updraft velocity averaged ove the whole cloud depth. -!! -# For scale awareness, the updraft fraction (sigma) is obtained as a function of cloud base entrainment. Then, the final cloud base mass flux is obtained by the original mass flux multiplied by the (1−sigma) 2 . +!! -# For scale awareness, the updraft fraction (sigma) is obtained as a function of cloud base entrainment. Then, the final cloud base mass flux is obtained by the original mass flux multiplied by the (1-sigma) 2. !! -# 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 samfdeep_detailed GFS samfdeepcnv Detailed Algorithm diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 6dd03534a..af19447dc 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -264,7 +264,20 @@ end subroutine cires_ugwp_driver_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. +!! 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, From 2fb92e8974de81754a712e8fca599c79dbaf3469 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 12 May 2020 07:22:44 -0600 Subject: [PATCH 111/141] Remove comments from .github/workflows/basic_checks.yml --- .github/workflows/basic_checks.yml | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/.github/workflows/basic_checks.yml b/.github/workflows/basic_checks.yml index 219c53bf4..4e40790b5 100644 --- a/.github/workflows/basic_checks.yml +++ b/.github/workflows/basic_checks.yml @@ -19,15 +19,3 @@ jobs: # brew install automake coreutils mpich gnu-sed - name: Check for ASCII encoding run: ./tools/check_encoding.py - #run: | - #export CC=gcc-9 - #export FC=gfortran-9 - #export CXX=g++-9 - #mkdir build - #cd build - #cmake -DCMAKE_INSTALL_PREFIX=$PWD/../install .. 2>&1 | tee log.cmake - #make -j8 2>&1 | tee log.make - #cd .. - #ls -l install/bin/ESMF_Info - #ls -l install/bin/wgrib2 - #cat install/share/nceplibs-external.cmake.config From 4f738694f3c462995ed72390aa932aba773e2a76 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 12 May 2020 07:39:48 -0600 Subject: [PATCH 112/141] Remove debug print statements from tools/check_encoding.py --- tools/check_encoding.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tools/check_encoding.py b/tools/check_encoding.py index cf4f568d4..1d24d4679 100755 --- a/tools/check_encoding.py +++ b/tools/check_encoding.py @@ -8,10 +8,10 @@ SUFFICES = [ '.f', '.F', '.f90', '.F90', '.meta' ] for root, dirs, files in os.walk(os.getcwd()): - print root, dirs, files + #print root, dirs, files for file in files: suffix = os.path.splitext(file)[1] - print file, suffix + #print file, suffix if suffix in SUFFICES: with open(os.path.join(root, file)) as f: contents = f.read() From bbc6f3356afc33b504811049848af986d07263d9 Mon Sep 17 00:00:00 2001 From: Hannah C Barnes <38660891+hannahcbarnes@users.noreply.github.com> Date: Wed, 13 May 2020 07:26:11 -0600 Subject: [PATCH 113/141] Number concentration bug and code clean up in GFS_suite_interstitial_4 (#26) Correction for a bug in the number concentration update in GFS_suite_interstitial_4, and removal of some variables that are no longer used in the code. --- physics/GFS_suite_interstitial.F90 | 8 ++++---- physics/GFS_suite_interstitial.meta | 16 ---------------- 2 files changed, 4 insertions(+), 20 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index db3966cee..e4026a75d 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -632,7 +632,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, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, imfdeepcnv, imfdeepcnv_gf, errmsg, errflg) + gq0, clw, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, errmsg, errflg) use machine, only: kind_phys use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber @@ -643,7 +643,7 @@ 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 + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf logical, intent(in) :: ltaerosol, cplchm @@ -725,7 +725,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to qv_mp(i,k) = spechum(i,k)/(1.0_kind_phys-spechum(i,k)) if (ntlnc>0) then !> - Convert moist mixing ratio to dry mixing ratio - qc_mp(i,k) = save_qc(i,k)/(1.0_kind_phys-spechum(i,k)) + qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k))/(1.0_kind_phys-spechum(i,k)) !> - Convert number concentration from moist to dry nc_mp(i,k) = gq0(i,k,ntlnc)/(1.0_kind_phys-spechum(i,k)) nc_mp(i,k) = nc_mp(i,k) + max(0.0, make_DropletNumber(qc_mp(i,k) * rho_dryair(i,k), nwfa(i,k)) * (1.0/rho_dryair(i,k))) @@ -734,7 +734,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to endif if (ntinc>0) then !> - Convert moist mixing ratio to dry mixing ratio - qi_mp(i,k) = save_qi(i,k)/(1.0_kind_phys-spechum(i,k)) + qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k))/(1.0_kind_phys-spechum(i,k)) !> - Convert number concentration from moist to dry ni_mp(i,k) = gq0(i,k,ntinc)/(1.0_kind_phys-spechum(i,k)) ni_mp(i,k) = ni_mp(i,k) + max(0.0, make_IceNumber(qi_mp(i,k) * rho_dryair(i,k), save_tcp(i,k)) * (1.0/rho_dryair(i,k))) diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index c48f93c68..27af68a90 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1764,22 +1764,6 @@ 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 238c84cb3c789056c701b70d3373e640ed4fa599 Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Wed, 13 May 2020 22:20:32 -0400 Subject: [PATCH 114/141] fix bugs found in pbl and ozone 3d diagnostic tendencies (#27) PBL tendencies were missing in two schemes; now fixed. Squashed commit of: * fix bugs found in pbl and ozone 3d diagnostic tendencies * remove debugging prints * implied shape arrays for five variables * more block labels * yet more bug fixes --- physics/GFS_PBL_generic.F90 | 26 +++++++------- physics/moninedmf.f | 2 +- physics/satmedmfvdifq.F | 66 ++++++++++++++++++++++++++++++----- physics/satmedmfvdifq.meta | 69 +++++++++++++++++++++++++++++++++++++ 4 files changed, 141 insertions(+), 22 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 4c641e4bf..bd9df41df 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -373,7 +373,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, errmsg = '' errflg = 0 !GJF: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. ) - if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then + if_nvdiff_ntrac: if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then dqdt = dvdftra elseif (nvdiff /= ntrac .and. .not. shinhong .and. .not. do_ysu) then ! @@ -385,7 +385,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo endif ! - if (trans_aero) then + if_trans_aero: if (trans_aero) then ! Set kk if chemistry-aerosol tracers are diffused call set_aerosol_tracer_index(imp_physics, imp_physics_wsm6, & imp_physics_thompson, ltaerosol, & @@ -403,9 +403,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo enddo enddo - endif + endif if_trans_aero ! - if (imp_physics == imp_physics_wsm6) then + if_imp_physics: if (imp_physics == imp_physics_wsm6) then ! WSM6 do k=1,levs do i=1,im @@ -517,9 +517,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntoz) = dvdftra(i,k,3) enddo enddo - endif + endif if_imp_physics - endif ! nvdiff == ntrac + endif if_nvdiff_ntrac if (cplchm) then do i = 1, im @@ -534,7 +534,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! --- ... coupling insertion - if (cplflx) then + if_cplflx: 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 @@ -572,10 +572,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, !! endif ! Ocean only, NO LAKES enddo - endif + endif if_cplflx !-------------------------------------------------------lssav if loop ---------- - if (lssav) then + if_lssav: if (lssav) then do i=1,im dusfc_diag (i) = dusfc_diag(i) + dusfc1(i)*dtf dvsfc_diag (i) = dvsfc_diag(i) + dvsfc1(i)*dtf @@ -591,7 +591,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! & dtf,' kdt=',kdt,' lat=',lat ! endif - if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then + if_diag: if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then if (lsidea) then dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf else @@ -615,9 +615,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo enddo endif - endif - - endif ! end if_lssav + endif if_diag + + endif if_lssav end subroutine GFS_PBL_generic_post_run diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 50400ee04..6cab9b7ed 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -1068,7 +1068,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. & - & flag_for_pbl_generic_tend) then + & .not. flag_for_pbl_generic_tend) then kk = ntoz is = (kk-1) * km do k = 1, km diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index f5a5f1f78..a514de6ad 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -65,6 +65,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & 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, & + & ntoz,du3dt,dv3dt,dt3dt,dq3dt,do3dt,ldiag3d,qdiag3d, & & errmsg,errflg) ! use machine , only : kind_phys @@ -73,9 +74,10 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & implicit none ! !---------------------------------------------------------------------- - integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke + integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke, ntoz integer, intent(in) :: kinver(im) integer, intent(out) :: kpbl(im) + logical, intent(in) :: ldiag3d,qdiag3d ! real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & & eps,epsm1 @@ -97,6 +99,10 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & 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(inout), dimension(:,:) :: & + & du3dt(:,:), dv3dt(:,:), & + & dt3dt(:,:), dq3dt(:,:), & + & do3dt(:,:) real(kind=kind_phys), intent(out) :: & & dusfc(im), dvsfc(im), & & dtsfc(im), dqsfc(im), & @@ -1303,6 +1309,22 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend enddo enddo + if(ldiag3d) then + do k = 1,km + do i = 1,im + ttend = (f1(i,k)-t1(i,k))*rdt + dt3dt(i,k) = dt3dt(i,k)+dspfac*ttend*delt + enddo + enddo + if(qdiag3d) then + do k = 1,km + do i = 1,im + qtend = (f2(i,k)-q1(i,k,1))*rdt + dq3dt(i,k) = dq3dt(i,k)+dspfac*qtend*delt + enddo + enddo + endif + endif ! if(ntrac1 >= 2) then do kk = 2, ntrac1 @@ -1314,19 +1336,37 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo enddo + if(ldiag3d .and. qdiag3d .and. ntoz>0) then + kk=ntoz + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (f2(i,k+is)-q1(i,k,kk))*rdt + do3dt(i,k) = do3dt(i,k)+qtend*delt + enddo + enddo + endif 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 + 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 - enddo + if(ldiag3d) then + do k = 1,km1 + do i = 1,im + ttend = diss(i,k) / cp + dt3dt(i,k) = dt3dt(i,k)+dspfac * ttend*delt + enddo + enddo + endif endif c c compute tridiagonal matrix elements for momentum @@ -1403,6 +1443,16 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend enddo enddo + if(ldiag3d) then + do k = 1,km + do i = 1,im + utend = (f1(i,k)-u1(i,k))*rdt + vtend = (f2(i,k)-v1(i,k))*rdt + du3dt(i,k) = du3dt(i,k) + utend*delt + dv3dt(i,k) = dv3dt(i,k) + vtend*delt + enddo + enddo + endif ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! pbl height for diagnostic purpose diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index ec679faec..f2c735def 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -578,6 +578,75 @@ kind = kind_phys intent = in optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[du3dt] + standard_name = cumulative_change_in_x_wind_due_to_PBL + long_name = cumulative change in x wind due to PBL + 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_PBL + long_name = cumulative change in y wind due to PBL + 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_PBL + long_name = cumulative change in temperature due to PBL + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dq3dt] + standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL + long_name = cumulative change in water vapor specific humidity due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[do3dt] + standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL + long_name = cumulative change in ozone mixing ratio due to PBL + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = inout + optional = F +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 187a69c92a501b46556815edea439ba43c463168 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 15 May 2020 10:43:16 -0600 Subject: [PATCH 115/141] Bugfixes for cu_gf_driver, cu_ntiedtke and module_MYNNPBL_wrapper related to lheatstrg --- physics/cu_gf_driver.meta | 8 ++--- physics/cu_ntiedtke.meta | 8 ++--- physics/module_MYNNPBL_wrapper.F90 | 37 +++++++++++++++++---- physics/module_MYNNPBL_wrapper.meta | 51 +++++++++++++++++++++++++++-- 4 files changed, 88 insertions(+), 16 deletions(-) diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 8d5e3a0c8..d89450273 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -261,8 +261,8 @@ intent = in optional = F [hfx2] - standard_name = kinematic_surface_upward_sensible_heat_flux - long_name = kinematic surface upward sensible heat flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 dimensions = (horizontal_dimension) type = real @@ -270,8 +270,8 @@ intent = in optional = F [qfx2] - standard_name = kinematic_surface_upward_latent_heat_flux - long_name = kinematic surface upward latent heat flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 dimensions = (horizontal_dimension) type = real diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 4208b6e46..6dcc54a15 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -171,8 +171,8 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux - long_name = kinematic surface upward latent heat flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 dimensions = (horizontal_dimension) type = real @@ -180,8 +180,8 @@ intent = in optional = F [hfx] - standard_name = kinematic_surface_upward_sensible_heat_flux - long_name = kinematic surface upward sensible heat flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 dimensions = (horizontal_dimension) type = real diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index d62a0f71d..3097d38d5 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -10,7 +10,23 @@ MODULE mynnedmf_wrapper contains - subroutine mynnedmf_wrapper_init () + subroutine mynnedmf_wrapper_init (lheatstrg, errmsg, errflg) + implicit none + + logical, intent(in) :: lheatstrg + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lheatstrg) then + errmsg = 'Logic error: lheatstrg not implemented for MYNN PBL' + errflg = 1 + return + end if + end subroutine mynnedmf_wrapper_init subroutine mynnedmf_wrapper_finalize () @@ -36,8 +52,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ice_aer_num_conc, & & prsl,exner, & & slmsk,tsurf,qsfc,ps, & - & ust,ch,hflx,qflx,wspd,rb, & - & dtsfc1,dqsfc1, & + & ust,ch,hflx,qflx,hflxq,qflxq, & + & wspd,rb,dtsfc1,dqsfc1, & & dtsfci_diag,dqsfci_diag, & & dtsfc_diag,dqsfc_diag, & & recmol, & @@ -48,7 +64,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl,sub_sqv,det_thl,det_sqv,& - & nupdraft,maxMF,ktop_shallow, & + & nupdraft,maxMF,ktop_plume, & & dudt, dvdt, dtdt, & & dqdt_water_vapor, dqdt_liquid_cloud, & & dqdt_ice_cloud, dqdt_ozone, & @@ -153,7 +169,7 @@ SUBROUTINE mynnedmf_wrapper_run( & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - + LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea, qdiag3d ! NAMELIST OPTIONS (INPUT): LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect, ltaerosol, & @@ -252,13 +268,16 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind=kind_phys), dimension(im), intent(in) :: & & dx,zorl,slmsk,tsurf,qsfc,ps, & & hflx,qflx,ust,wspd,rb,recmol + real(kind=kind_phys), dimension(im), intent(out) :: & + & hflxq, evapq + real(kind=kind_phys), dimension(im), intent(inout) :: & & pblh real(kind=kind_phys), dimension(im), intent(out) :: & & ch,dtsfc1,dqsfc1, & & dtsfci_diag,dqsfci_diag,dtsfc_diag,dqsfc_diag, & & maxMF - integer, dimension(im), intent(inout) :: & + integer, dimension(im), intent(inout) :: & & kpbl,nupdraft,ktop_plume !LOCAL @@ -287,6 +306,12 @@ SUBROUTINE mynnedmf_wrapper_run( & !print*,"in MYNN, initflag=",initflag endif + ! Set "kinematic surface upward latent/sensible heat flux reduced by + ! surface roughness" to kinematic surface upward latent/sensible heat flux, + ! because the lheatstrg capability in GFS_PBL_generic_pre is not implemented + hflxq = hflx + qflxq = qflx + ! Assign variables for each microphysics scheme if (imp_physics == imp_physics_wsm6) then ! WSM6 diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 1152d3467..7db6c2621 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1,3 +1,32 @@ +[ccpp-arg-table] + name = mynnedmf_wrapper_init + type = scheme +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + 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] name = mynnedmf_wrapper_run type = scheme @@ -305,7 +334,7 @@ intent = out optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + standard_name = kinematic_surface_upward_sensible_heat_flux long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -313,8 +342,17 @@ kind = kind_phys intent = in optional = F +[hflxq] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [qflx] - standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + 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) @@ -322,6 +360,15 @@ kind = kind_phys intent = in optional = F +[qflxq] + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [wspd] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level From 6d2cdfb267c5c6d066d9f4f3e4df888d3cd18867 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 15 May 2020 14:25:11 -0600 Subject: [PATCH 116/141] Fix bugs from merge process --- physics/GFS_suite_interstitial.F90 | 2 +- physics/module_MYNNPBL_wrapper.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 6b5083401..3d22cf33b 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -463,7 +463,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, & - xlon, xlat, gq0, imp_physics, imp_physics_mg, & + xlon, xlat, gt0, 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, & diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 3097d38d5..b215e5e62 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -269,7 +269,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & dx,zorl,slmsk,tsurf,qsfc,ps, & & hflx,qflx,ust,wspd,rb,recmol real(kind=kind_phys), dimension(im), intent(out) :: & - & hflxq, evapq + & hflxq, qflxq real(kind=kind_phys), dimension(im), intent(inout) :: & & pblh From 6e4c7874d6685953b8887fd7638fdfb8870c4b2d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 19 May 2020 07:20:18 -0600 Subject: [PATCH 117/141] Move canopy heat storage calculation of reduced latent/sensible heat flux from GFS_PBL_generic_pre to GFS_surface_generic_post and remove workaround in MYNNPBL wrapper --- physics/GFS_PBL_generic.F90 | 47 +----------- physics/GFS_PBL_generic.meta | 107 ---------------------------- physics/GFS_surface_generic.F90 | 48 ++++++++++++- physics/GFS_surface_generic.meta | 89 +++++++++++++++++++++++ physics/module_MYNNPBL_wrapper.F90 | 10 +-- physics/module_MYNNPBL_wrapper.meta | 22 +----- 6 files changed, 141 insertions(+), 182 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index b17f031bc..75c27fcc7 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -84,9 +84,8 @@ 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, lheatstrg, z0fac, e0fac, zorl, & - u10m, v10m, hflx, evap, hflxq, evapq, hffac, hefac, save_u, save_v, save_t, & - save_q, ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, errmsg, errflg) + hybedmf, do_shoc, satmedmf, qgrs, vdftra, save_u, save_v, save_t, save_q, & + ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -107,25 +106,12 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), dimension(im, levs), intent(out) :: save_u, save_v, save_t real(kind=kind_phys), dimension(im, levs, ntrac), intent(out) :: save_q - ! For canopy heat storage - logical, intent(in) :: lheatstrg - real(kind=kind_phys), intent(in) :: z0fac, e0fac - real(kind=kind_phys), dimension(im), intent(in) :: zorl, u10m, v10m - real(kind=kind_phys), dimension(im), intent(in) :: hflx, evap - real(kind=kind_phys), dimension(im), intent(out) :: hflxq, evapq - real(kind=kind_phys), dimension(im), intent(out) :: hffac, hefac - ! CCPP error handling variables character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! Parameters for canopy heat storage parametrization - real (kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 - real (kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 - ! Local variables integer :: i, k, kk, k1, n - real(kind=kind_phys) :: tem, tem1, tem2 ! Initialize CCPP error handling variables errmsg = '' @@ -281,35 +267,6 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ! endif -! --- ... Boundary Layer and Free atmospheic turbulence parameterization -! -! in order to achieve heat storage within canopy layer, in the canopy heat -! storage parameterization the kinematic sensible and latent heat fluxes -! (hflx & evap) as surface boundary forcings to the pbl scheme are -! reduced as a function of surface roughness -! - do i=1,im - hflxq(i) = hflx(i) - evapq(i) = evap(i) - hffac(i) = 1.0 - hefac(i) = 1.0 - enddo - if (lheatstrg) then - do i=1,im - tem = 0.01 * zorl(i) ! change unit from cm to m - tem1 = (tem - z0min) / (z0max - z0min) - hffac(i) = z0fac * min(max(tem1, 0.0), 1.0) - tem = sqrt(u10m(i)**2+v10m(i)**2) - tem1 = (tem - u10min) / (u10max - u10min) - tem2 = 1.0 - min(max(tem1, 0.0), 1.0) - hffac(i) = tem2 * hffac(i) - hefac(i) = 1. + e0fac * hffac(i) - hffac(i) = 1. + hffac(i) - hflxq(i) = hflx(i) / hffac(i) - evapq(i) = evap(i) / hefac(i) - enddo - endif - if(ldiag3d .and. lssav) then do k=1,levs do i=1,im diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index c46ed37f5..9a130831c 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -307,113 +307,6 @@ kind = kind_phys intent = inout optional = F -[lheatstrg] - standard_name = flag_for_canopy_heat_storage - long_name = flag for canopy heat storage parameterization - units = flag - dimensions = () - type = logical - intent = in - optional = F -[z0fac] - standard_name = surface_roughness_fraction_factor - long_name = surface roughness fraction factor for canopy heat storage parameterization - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[e0fac] - standard_name = latent_heat_flux_fraction_factor_relative_to_sensible_heat_flux - long_name = latent heat flux fraction factor relative to sensible heat flux for canopy heat storage parameterization - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[u10m] - standard_name = x_wind_at_10m - long_name = 10 meter u wind speed - 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 = 10 meter v wind speed - units = m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[hflx] - 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 -[hflxq] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward sensible heat flux reduced by surface roughness - units = K m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[evapq] - standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward latent heat flux reduced by surface roughness - units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[hefac] - standard_name = surface_upward_latent_heat_flux_reduction_factor - long_name = surface upward latent heat flux reduction factor from canopy heat storage - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[hffac] - standard_name = surface_upward_sensible_heat_flux_reduction_factor - long_name = surface upward sensible heat flux reduction factor from canopy heat storage - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F [save_u] standard_name = x_wind_save long_name = x-wind before entering a physics scheme diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index dbcdec24b..30a29d393 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -221,7 +221,8 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt dvisdfi_cpl, dnirbm_cpl, dnirdf_cpl, dvisbm_cpl, dvisdf_cpl, nlwsfci_cpl, nlwsfc_cpl, t2mi_cpl, q2mi_cpl, u10mi_cpl, & v10mi_cpl, tsfci_cpl, psurfi_cpl, nnirbmi_cpl, nnirdfi_cpl, nvisbmi_cpl, nvisdfi_cpl, nswsfci_cpl, nswsfc_cpl, nnirbm_cpl, & nnirdf_cpl, nvisbm_cpl, nvisdf_cpl, gflux, evbsa, evcwa, transa, sbsnoa, snowca, snohfa, ep, & - runoff, srunoff, runof, drain, errmsg, errflg) + runoff, srunoff, runof, drain, lheatstrg, z0fac, e0fac, zorl, hflx, evap, hflxq, evapq, hffac, hefac, & + errmsg, errflg) implicit none @@ -243,13 +244,29 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt real(kind=kind_phys), dimension(im), intent(inout) :: runoff, srunoff real(kind=kind_phys), dimension(im), intent(in) :: drain, runof + ! For canopy heat storage + logical, intent(in) :: lheatstrg + real(kind=kind_phys), intent(in) :: z0fac, e0fac + real(kind=kind_phys), dimension(im), intent(in) :: zorl + real(kind=kind_phys), dimension(im), intent(in) :: hflx, evap + real(kind=kind_phys), dimension(im), intent(out) :: hflxq, evapq + real(kind=kind_phys), dimension(im), intent(out) :: hffac, hefac + + ! CCPP error handling variables character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + ! Local variables + real(kind=kind_phys), parameter :: albdf = 0.06d0 + ! Parameters for canopy heat storage parametrization + real(kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 + real(kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 + integer :: i real(kind=kind_phys) :: xcosz_loc, ocalnirdf_cpl, ocalnirbm_cpl, ocalvisdf_cpl, ocalvisbm_cpl + real(kind=kind_phys) :: tem, tem1, tem2 ! Initialize CCPP error handling variables errmsg = '' @@ -354,6 +371,35 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt enddo endif +! --- ... Boundary Layer and Free atmospheic turbulence parameterization +! +! in order to achieve heat storage within canopy layer, in the canopy heat +! storage parameterization the kinematic sensible and latent heat fluxes +! (hflx & evap) as surface boundary forcings to the pbl scheme are +! reduced as a function of surface roughness +! + do i=1,im + hflxq(i) = hflx(i) + evapq(i) = evap(i) + hffac(i) = 1.0 + hefac(i) = 1.0 + enddo + if (lheatstrg) then + do i=1,im + tem = 0.01 * zorl(i) ! change unit from cm to m + tem1 = (tem - z0min) / (z0max - z0min) + hffac(i) = z0fac * min(max(tem1, 0.0), 1.0) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem1 = (tem - u10min) / (u10max - u10min) + tem2 = 1.0 - min(max(tem1, 0.0), 1.0) + hffac(i) = tem2 * hffac(i) + hefac(i) = 1. + e0fac * hffac(i) + hffac(i) = 1. + hffac(i) + hflxq(i) = hflx(i) / hffac(i) + evapq(i) = evap(i) / hefac(i) + enddo + endif + end subroutine GFS_surface_generic_post_run end module GFS_surface_generic_post diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 81ca18f94..10a060bc3 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -1280,6 +1280,95 @@ kind = kind_phys intent = in optional = F +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical + intent = in + optional = F +[z0fac] + standard_name = surface_roughness_fraction_factor + long_name = surface roughness fraction factor for canopy heat storage parameterization + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[e0fac] + standard_name = latent_heat_flux_fraction_factor_relative_to_sensible_heat_flux + long_name = latent heat flux fraction factor relative to sensible heat flux for canopy heat storage parameterization + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx] + 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 +[hflxq] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[evapq] + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hefac] + standard_name = surface_upward_latent_heat_flux_reduction_factor + long_name = surface upward latent heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hffac] + standard_name = surface_upward_sensible_heat_flux_reduction_factor + long_name = surface upward sensible heat flux reduction factor from canopy heat storage + units = none + 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 diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index b215e5e62..e6c553350 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -52,7 +52,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ice_aer_num_conc, & & prsl,exner, & & slmsk,tsurf,qsfc,ps, & - & ust,ch,hflx,qflx,hflxq,qflxq, & + & ust,ch,hflx,qflx, & & wspd,rb,dtsfc1,dqsfc1, & & dtsfci_diag,dqsfci_diag, & & dtsfc_diag,dqsfc_diag, & @@ -268,8 +268,6 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind=kind_phys), dimension(im), intent(in) :: & & dx,zorl,slmsk,tsurf,qsfc,ps, & & hflx,qflx,ust,wspd,rb,recmol - real(kind=kind_phys), dimension(im), intent(out) :: & - & hflxq, qflxq real(kind=kind_phys), dimension(im), intent(inout) :: & & pblh @@ -306,12 +304,6 @@ SUBROUTINE mynnedmf_wrapper_run( & !print*,"in MYNN, initflag=",initflag endif - ! Set "kinematic surface upward latent/sensible heat flux reduced by - ! surface roughness" to kinematic surface upward latent/sensible heat flux, - ! because the lheatstrg capability in GFS_PBL_generic_pre is not implemented - hflxq = hflx - qflxq = qflx - ! Assign variables for each microphysics scheme if (imp_physics == imp_physics_wsm6) then ! WSM6 diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 7db6c2621..393ad5292 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -334,40 +334,22 @@ intent = out optional = F [hflx] - 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 -[hflxq] standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = out - optional = F -[qflx] - 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 -[qflxq] +[qflx] standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = out + intent = in optional = F [wspd] standard_name = wind_speed_at_lowest_model_layer From 7d7c2ca1e7b6cedcac9484af1c46fcc19bc0714f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 19 May 2020 20:56:51 -0600 Subject: [PATCH 118/141] physics/rrtmgp_lw_cloud_sampling.*, physics/rrtmgp_sw_cloud_sampling.*: add missing mandatory CCPP arguments errmsg and errflg --- physics/rrtmgp_lw_cloud_sampling.F90 | 10 +++++++++- physics/rrtmgp_lw_cloud_sampling.meta | 19 ++++++++++++++++++- physics/rrtmgp_sw_cloud_sampling.F90 | 10 +++++++++- physics/rrtmgp_sw_cloud_sampling.meta | 19 ++++++++++++++++++- 4 files changed, 54 insertions(+), 4 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index e42336923..d1da08405 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -18,13 +18,21 @@ module rrtmgp_lw_cloud_sampling !! \section arg_table_rrtmgp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_lw_cloud_sampling_init.html !! - subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0) + subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0, errmsg, errflg) ! Inputs type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: K-distribution data ! Outputs integer, intent(out) :: & ipsdlw0 ! Initial permutation seed for McICA + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 ! Set initial permutation seed for McICA, initially set to number of G-points ipsdlw0 = lw_gas_props%get_ngpt() diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 547c6177c..87e785a4d 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -17,6 +17,23 @@ type = integer 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] @@ -111,4 +128,4 @@ dimensions = () type = integer intent = out - optional = F \ No newline at end of file + optional = F diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 0c839afb2..45d0fad67 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -18,13 +18,21 @@ module rrtmgp_sw_cloud_sampling !! \section arg_table_rrtmgp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_sw_cloud_sampling.html !! - subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0) + subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0, errmsg, errflg) ! Inputs type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: K-distribution data ! Outputs integer, intent(out) :: & ipsdsw0 ! Initial permutation seed for McICA + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error code + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 ! Set initial permutation seed for McICA, initially set to number of G-points ipsdsw0 = sw_gas_props%get_ngpt() diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 3ad9073d5..c30d4934d 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -17,6 +17,23 @@ type = integer 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] @@ -127,4 +144,4 @@ dimensions = () type = integer intent = out - optional = F \ No newline at end of file + optional = F From 4b5c379717ae789bbc61b63c1eb9d21e30018bfa Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 19 May 2020 20:58:35 -0600 Subject: [PATCH 119/141] Remove physics/GFS_suite_init_finalize_test.* --- physics/GFS_suite_init_finalize_test.F90 | 59 --------------------- physics/GFS_suite_init_finalize_test.meta | 64 ----------------------- 2 files changed, 123 deletions(-) delete mode 100644 physics/GFS_suite_init_finalize_test.F90 delete mode 100644 physics/GFS_suite_init_finalize_test.meta diff --git a/physics/GFS_suite_init_finalize_test.F90 b/physics/GFS_suite_init_finalize_test.F90 deleted file mode 100644 index 0a958d2fc..000000000 --- a/physics/GFS_suite_init_finalize_test.F90 +++ /dev/null @@ -1,59 +0,0 @@ - module GFS_suite_ini_fini_test - - contains - -!> \section arg_table_GFS_suite_ini_fini_test_init Argument Table -!! \htmlinclude GFS_suite_ini_fini_test_init.html -!! - subroutine GFS_suite_ini_fini_test_init (errmsg, errflg) - - implicit none - - ! interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - errmsg = '' - errflg = 0 - - write(0,*) "DH DEBUG: IN GFS_suite_ini_fini_test_init" - - end subroutine GFS_suite_ini_fini_test_init - -!> \section arg_table_GFS_suite_ini_fini_test_finalize Argument Table -!! \htmlinclude GFS_suite_ini_fini_test_finalize.html -!! - subroutine GFS_suite_ini_fini_test_finalize(errmsg, errflg) - - implicit none - - ! interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - errmsg = '' - errflg = 0 - - write(0,*) "DH DEBUG: IN GFS_suite_ini_fini_test_finalize" - - end subroutine GFS_suite_ini_fini_test_finalize - -!> \section arg_table_GFS_suite_ini_fini_test_run Argument Table -!! \htmlinclude GFS_suite_ini_fini_test_run.html -!! - subroutine GFS_suite_ini_fini_test_run (errmsg, errflg) - - use GFS_typedefs, only: GFS_interstitial_type - - implicit none - - ! interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - write(errmsg,'(a)') "DH ERROR: GFS_suite_ini_fini_test_run should not be called" - errflg = 1 - - end subroutine GFS_suite_ini_fini_test_run - - end module GFS_suite_ini_fini_test diff --git a/physics/GFS_suite_init_finalize_test.meta b/physics/GFS_suite_init_finalize_test.meta deleted file mode 100644 index cdca8b0e0..000000000 --- a/physics/GFS_suite_init_finalize_test.meta +++ /dev/null @@ -1,64 +0,0 @@ -[ccpp-arg-table] - name = GFS_suite_ini_fini_test_init - 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 = GFS_suite_ini_fini_test_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 = GFS_suite_ini_fini_test_run - 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 From b328abb08ff2410faeae3cc31e9619ec02807873 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Wed, 20 May 2020 04:33:34 +0000 Subject: [PATCH 120/141] Merge of latest GSL drag suite with latest updates on NOAA-GSD repo, gsd/develop branch --- physics/GFS_GWD_generic.F90 | 7 +++---- physics/GFS_GWD_generic.meta | 9 --------- physics/drag_suite.F90 | 9 --------- 3 files changed, 3 insertions(+), 22 deletions(-) diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 7d3f86b00..09c969162 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -17,7 +17,7 @@ end subroutine GFS_GWD_generic_pre_init !! @{ subroutine GFS_GWD_generic_pre_run( & & im, levs, nmtvr, mntvar, & - & var, oc, oa4, clx, theta, & + & oc, oa4, clx, theta, & & varss, ocss, oa4ss, clxss, & & sigma, gamma, elvmax, lssav, ldiag3d, & & dudt, dvdt, dtdt, du3dt, dv3dt, dt3dt, dtf, & @@ -30,8 +30,8 @@ subroutine GFS_GWD_generic_pre_run( & real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr) real(kind=kind_phys), intent(out) :: & - & var(im), oc(im), oa4(im,4), clx(im,4), & - & varss(im), ocss(im), oa4ss(im,4), clxss(im,4), & + & oc(im), oa4(im,4), clx(im,4), & + & varss(:), ocss(:), oa4ss(:,:), clxss(:,:), & & theta(im), sigma(im), gamma(im), elvmax(im) logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend @@ -84,7 +84,6 @@ subroutine GFS_GWD_generic_pre_run( & clx(:,3) = 0.0 clx(:,4) = 0.0 elseif (nmtvr == 24) then ! GSD_drag_suite - var(:) = mntvar(:,1) oc(:) = mntvar(:,2) oa4(:,1) = mntvar(:,3) oa4(:,2) = mntvar(:,4) diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index 78f2e742d..7f987f28f 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -39,15 +39,6 @@ kind = kind_phys intent = in optional = F -[var] - 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 = in - optional = F [oc] standard_name = convexity_of_subgrid_orography long_name = convexity of subgrid orography diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 0eb1f3b5f..86ed514f9 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -475,15 +475,6 @@ subroutine drag_suite_run( & errflg = 0 -! Temporary line -!if (me==master) then -! print *, "Ahoj svete!: In drag suite -- cdmbgwd =", cdmbgwd(:) -! print *, "imx =", imx, " dx =", dx(1) -! print * -!end if - - -! if (me==master) print *,"Running drag suite" !-------------------------------------------------------------------- ! SCALE-ADPTIVE PARAMETER FROM GFS GWD SCHEME !-------------------------------------------------------------------- From d44e2e7446f9fc02c99ec02b9b2fe97a5b0aa055 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 11:35:36 -0600 Subject: [PATCH 121/141] Clean up use of horizontal_dimension versus horizontal_loop_extent in a large number of files --- physics/GFS_MP_generic.F90 | 8 +++---- physics/GFS_MP_generic.meta | 8 ------- physics/GFS_rrtmg_setup.meta | 4 ++-- physics/GFS_rrtmgp_pre.F90 | 4 +--- physics/GFS_rrtmgp_pre.meta | 8 ------- physics/GFS_rrtmgp_sw_post.F90 | 5 ++-- physics/GFS_rrtmgp_sw_post.meta | 2 +- physics/cires_ugwp.F90 | 2 +- physics/cnvc90.f | 6 ++--- physics/cnvc90.meta | 8 ------- physics/cs_conv.F90 | 36 ++++++++++++++-------------- physics/cs_conv.meta | 8 ------- physics/cu_gf_driver.F90 | 32 ++++++++++++------------- physics/cu_gf_driver.meta | 8 ------- physics/cu_ntiedtke.F90 | 14 +++++------ physics/cu_ntiedtke.meta | 8 ------- physics/dcyc2.f | 18 +++++++------- physics/dcyc2.meta | 8 ------- physics/drag_suite.F90 | 4 ++-- physics/drag_suite.meta | 8 ------- physics/gcm_shoc.F90 | 8 +++---- physics/gcm_shoc.meta | 8 ------- physics/gscond.f | 20 ++++++++-------- physics/gscond.meta | 8 ------- physics/gwdc.f | 12 +++++----- physics/gwdc.meta | 8 ------- physics/gwdps.f | 34 +++++++++++++------------- physics/gwdps.meta | 8 ------- physics/h2ophys.f | 14 +++++------ physics/h2ophys.meta | 8 ------- physics/m_micro.F90 | 12 +++++----- physics/m_micro.meta | 8 ------- physics/module_MYJPBL_wrapper.F90 | 6 ++--- physics/module_MYJPBL_wrapper.meta | 8 ------- physics/module_MYJSFC_wrapper.F90 | 4 ++-- physics/module_MYJSFC_wrapper.meta | 8 ------- physics/module_MYNNPBL_wrapper.F90 | 4 ++-- physics/module_MYNNPBL_wrapper.meta | 9 +------ physics/module_MYNNSFC_wrapper.F90 | 6 ++--- physics/module_MYNNSFC_wrapper.meta | 8 ------- physics/module_SGSCloud_RadPost.F90 | 4 ++-- physics/module_SGSCloud_RadPost.meta | 8 ------- physics/module_SGSCloud_RadPre.F90 | 4 ++-- physics/module_SGSCloud_RadPre.meta | 8 ------- physics/moninedmf.f | 20 +++++++--------- physics/moninedmf.meta | 8 ------- physics/moninedmf_hafs.f | 20 +++++++--------- physics/moninedmf_hafs.meta | 8 ------- physics/moninshoc.f | 12 ++++------ physics/moninshoc.meta | 8 ------- physics/mp_thompson_post.F90 | 3 +-- physics/mp_thompson_post.meta | 8 ------- physics/ozphys.f | 12 +++++----- physics/ozphys.meta | 8 ------- physics/ozphys_2015.f | 14 +++++------ physics/ozphys_2015.meta | 8 ------- physics/precpd.f | 19 +++++++-------- physics/precpd.meta | 8 ------- physics/rascnv.F90 | 15 ++++++------ physics/rascnv.meta | 8 ------- physics/rayleigh_damp.f | 24 +++++++++---------- physics/rayleigh_damp.meta | 8 ------- physics/samfdeepcnv.f | 22 ++++++++--------- physics/samfdeepcnv.meta | 8 ------- physics/samfshalcnv.f | 18 +++++++------- physics/samfshalcnv.meta | 8 ------- physics/sascnvn.F | 9 ++++--- physics/sascnvn.meta | 8 ------- physics/satmedmfvdif.F | 22 ++++++++--------- physics/satmedmfvdif.meta | 8 ------- physics/satmedmfvdifq.F | 22 ++++++++--------- physics/satmedmfvdifq.meta | 8 ------- physics/shalcnv.F | 7 +++--- physics/shalcnv.meta | 8 ------- physics/shinhongvdif.F90 | 10 ++++---- physics/shinhongvdif.meta | 8 ------- physics/ysuvdif.F90 | 10 ++++---- physics/ysuvdif.meta | 8 ------- 78 files changed, 252 insertions(+), 567 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 13f8243ed..73b26c7a3 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -92,7 +92,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, & + subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, & imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires, cal_pre, lssav, ldiag3d, qdiag3d, 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, & @@ -104,7 +104,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) :: im, 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, qdiag3d, cplflx, cplchm @@ -112,7 +112,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt real(kind=kind_phys), dimension(im), intent(in) :: rainc, rain1, xlat, xlon, tsfc real(kind=kind_phys), dimension(im), intent(inout) :: ice, snow, graupel real(kind=kind_phys), dimension(im), intent(in) :: rain0, ice0, snow0, graupel0 - real(kind=kind_phys), dimension(ix,nrcm), intent(in) :: rann + real(kind=kind_phys), dimension(im,nrcm), intent(in) :: rann real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, prsl, save_t, save_qv, del real(kind=kind_phys), dimension(im,levs+1), intent(in) :: prsi, phii real(kind=kind_phys), dimension(im,levs,ntrac), intent(in) :: gq0 @@ -224,7 +224,7 @@ 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, & + call calpreciptype (kdt, nrcm, im, im, levs, levs+1, & rann, xlat, xlon, gt0, & gq0(:,:,1), prsl, prsi, & rain, phii, tsfc, & ! input diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 3ecc94c00..c4eacb758 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -155,14 +155,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [levs] standard_name = vertical_dimension long_name = vertical layer dimension diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 8405d160d..ad98575ca 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -195,8 +195,8 @@ intent = in optional = F [im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent + standard_name = horizontal_dimension + long_name = horizontal dimension units = count dimensions = () type = integer diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 1344f269c..a95a0fffd 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -85,12 +85,10 @@ module GFS_rrtmgp_pre !! \section arg_table_GFS_rrtmgp_pre_init !! \htmlinclude GFS_rrtmgp_pre_init.html !! - subroutine GFS_rrtmgp_pre_init(Model, Radtend, active_gases_array, errmsg, errflg) + subroutine GFS_rrtmgp_pre_init(Model, active_gases_array, errmsg, errflg) ! Inputs type(GFS_control_type), intent(inout) :: & Model ! DDT: FV3-GFS model control parameters - type(GFS_radtend_type), intent(inout) :: & - Radtend ! DDT: FV3-GFS radiation tendencies ! Outputs character(len=*),dimension(Model%ngases), intent(out) :: & diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index c80098709..ae94ddf20 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -9,14 +9,6 @@ type = GFS_control_type intent = inout optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 4e9f8a33f..3b09298c4 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -93,7 +93,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - type(cmpfsw_type), dimension(nCol), intent(inout), optional :: & + type(cmpfsw_type), dimension(nCol), intent(inout) :: & scmpsw ! 2D surface fluxes, components: ! uvbfc - total sky downward uv-b flux at (W/m2) ! uvbf0 - clear sky downward uv-b flux at (W/m2) @@ -105,7 +105,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein integer :: i, j, k, iSFC, iTOA, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 real(kind_phys), dimension(nDay, Model%levs) :: thetaTendClrSky, thetaTendAllSky - logical :: l_fluxessw2d, top_at_1, l_sfcFluxessw1D + logical :: l_fluxessw2d, top_at_1 ! Initialize CCPP error handling variables errmsg = '' @@ -116,7 +116,6 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! Are any optional outputs requested? l_fluxessw2d = present(flxprf_sw) - l_sfcfluxessw1D = present(scmpsw) ! ####################################################################################### ! What is vertical ordering? diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index a817d9332..806bd49e4 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -56,7 +56,7 @@ dimensions = (horizontal_dimension) type = cmpfsw_type intent = inout - optional = T + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index bf2825104..df0116cd0 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -260,7 +260,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr enddo if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then - call gwdps_run(im, im, levs, Pdvdt, Pdudt, Pdtdt, & + call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, & ugrs, vgrs, tgrs, qgrs, & kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & hprime, oc, oa4, clx, theta, sigma, gamma, & diff --git a/physics/cnvc90.f b/physics/cnvc90.f index 87d034b77..9bef0ebf9 100644 --- a/physics/cnvc90.f +++ b/physics/cnvc90.f @@ -21,7 +21,7 @@ end subroutine cnvc90_init !! \htmlinclude cnvc90_run.html !! ! \section gen_cnvc_run GFS cnvc90_run General Algorithm - SUBROUTINE cnvc90_run(CLSTP,IM,IX,RN,KBOT,KTOP,KM,PRSI, & + SUBROUTINE cnvc90_run(CLSTP,IM,RN,KBOT,KTOP,KM,PRSI, & & ACV,ACVB,ACVT,CV,CVB,CVT,errmsg,errflg) USE MACHINE, ONLY :kind_phys @@ -29,11 +29,11 @@ SUBROUTINE cnvc90_run(CLSTP,IM,IX,RN,KBOT,KTOP,KM,PRSI, & ! Interface variables real(kind=kind_phys), intent(in) :: clstp - integer, intent(in) :: im, ix, km + integer, intent(in) :: im, km real(kind=kind_phys), intent(in) :: RN(IM) integer, intent(in) :: KBOT(IM) integer, intent(in) :: KTOP(IM) - real(kind=kind_phys), intent(in) :: prsi(ix,km+1) + real(kind=kind_phys), intent(in) :: prsi(IM,km+1) real(kind=kind_phys), intent(inout) :: ACV(IM) real(kind=kind_phys), intent(inout) :: ACVB(IM) real(kind=kind_phys), intent(inout) :: ACVT(IM) diff --git a/physics/cnvc90.meta b/physics/cnvc90.meta index 57290c9c5..0cf7c22a4 100644 --- a/physics/cnvc90.meta +++ b/physics/cnvc90.meta @@ -23,14 +23,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [rn] standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep long_name = convective rainfall amount on dynamics timestep diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index 29044e4ec..386349422 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -289,7 +289,7 @@ end subroutine cs_conv_finalize !! !! \section general_cs_conv CS Convection Scheme General Algorithm !> @{ - subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & + subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & NTR , nctp , & !DD dimensions otspt , lat , kdt , & t , q , rain1 , clw , & @@ -308,24 +308,24 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & ! ! input arguments ! - INTEGER, INTENT(IN) :: IM,IJSDIM, KMAX, ntracp1, nn, NTR, mype, nctp, mp_phys, kdt, lat !! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IJSDIM, KMAX, ntracp1, nn, NTR, mype, nctp, mp_phys, kdt, lat !! DD, for GFS, pass in logical, intent(in) :: otspt(1:ntracp1,1:2)! otspt(:,1) - on/off switch for tracer transport by updraft and ! downdraft. should not include subgrid PDF and turbulence ! otspt(:,2) - on/off switch for tracer transport by subsidence ! should include subgrid PDF and turbulence - real(r8), intent(inout) :: t(IM,KMAX) ! temperature at mid-layer (K) - real(r8), intent(inout) :: q(IM,KMAX) ! water vapor array including moisture (kg/kg) - real(r8), intent(inout) :: clw(IM,KMAX,nn) ! tracer array including cloud condensate (kg/kg) - real(r8), intent(in) :: pap(IM,KMAX) ! pressure at mid-layer (Pa) - real(r8), intent(in) :: paph(IM,KMAX+1) ! pressure at boundaries (Pa) - real(r8), intent(in) :: zm(IM,KMAX) ! geopotential at mid-layer (m) - real(r8), intent(in) :: zi(IM,KMAX+1) ! geopotential at boundaries (m) + real(r8), intent(inout) :: t(IJSDIM,KMAX) ! temperature at mid-layer (K) + real(r8), intent(inout) :: q(IJSDIM,KMAX) ! water vapor array including moisture (kg/kg) + real(r8), intent(inout) :: clw(IJSDIM,KMAX,nn) ! tracer array including cloud condensate (kg/kg) + real(r8), intent(in) :: pap(IJSDIM,KMAX) ! pressure at mid-layer (Pa) + real(r8), intent(in) :: paph(IJSDIM,KMAX+1) ! pressure at boundaries (Pa) + real(r8), intent(in) :: zm(IJSDIM,KMAX) ! geopotential at mid-layer (m) + real(r8), intent(in) :: zi(IJSDIM,KMAX+1) ! geopotential at boundaries (m) real(r8), intent(in) :: fscav(ntr), fswtr(ntr), wcbmaxm(ijsdim) real(r8), intent(in) :: precz0in, preczhin, clmdin ! added for cs_convr - real(r8), intent(inout) :: u(IM,KMAX) ! zonal wind at mid-layer (m/s) - real(r8), intent(inout) :: v(IM,KMAX) ! meridional wind at mid-layer (m/s) + real(r8), intent(inout) :: u(IJSDIM,KMAX) ! zonal wind at mid-layer (m/s) + real(r8), intent(inout) :: v(IJSDIM,KMAX) ! meridional wind at mid-layer (m/s) real(r8), intent(in) :: DELTA ! physics time step real(r8), intent(in) :: DELTI ! dynamics time step (model time increment in seconds) @@ -333,7 +333,7 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & ! ! modified arguments ! - real(r8), intent(inout) :: CBMFX(IM,nctp) ! cloud base mass flux (kg/m2/s) + real(r8), intent(inout) :: CBMFX(IJSDIM,nctp) ! cloud base mass flux (kg/m2/s) ! ! output arguments ! @@ -348,21 +348,21 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & cnv_dqldt, clcn, cnv_fice, & cnv_ndrop, cnv_nice, cf_upi ! *GJF - integer, intent(inout) :: kcnv(im) ! zero if no deep convection and 1 otherwise + integer, intent(inout) :: kcnv(ijsdim) ! zero if no deep convection and 1 otherwise character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg !DDsigma - output added for AW sigma diagnostics ! interface sigma and vertical velocity by cloud type (1=sfc) -! real(r8), intent(out), dimension(IM,KMAX,nctp) :: sigmai, vverti - real(r8), intent(out), dimension(IM,KMAX) :: sigma ! sigma sigma totaled over cloud type - on interfaces (1=sfc) +! real(r8), intent(out), dimension(IJSDIM,KMAX,nctp) :: sigmai, vverti + real(r8), intent(out), dimension(IJSDIM,KMAX) :: sigma ! sigma sigma totaled over cloud type - on interfaces (1=sfc) ! sigma terms in eq 91 and 92 -! real(r8), dimension(IM,KMAX) :: sfluxterm, qvfluxterm, condterm +! real(r8), dimension(IJSDIM,KMAX) :: sfluxterm, qvfluxterm, condterm !DDsigma ! ! output arguments of CS_CUMLUS ! - real(r8), dimension(IM,KMAX,nctp) :: vverti + real(r8), dimension(IJSDIM,KMAX,nctp) :: vverti real(r8) GTT(IJSDIM,KMAX) !< temperature tendency [K/s] real(r8) GTQ(IJSDIM,KMAX,NTR) !< tracer tendency [kg/kg/s] @@ -528,7 +528,7 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & enddo ! !> -# Call cs_cumlus() for the main CS cumulus parameterization - call CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions + call CS_CUMLUS (IJSDIM, IJSDIM, KMAX , NTR , & !DD dimensions otspt(1:ntr,1), otspt(1:ntr,2), & lprnt , ipr , & GTT , GTQ , GTU , GTV , & ! output diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta index d499885c7..b19a42a5b 100644 --- a/physics/cs_conv.meta +++ b/physics/cs_conv.meta @@ -266,14 +266,6 @@ [ccpp-arg-table] name = cs_conv_run type = scheme -[im] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [ijsdim] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 927b452cd..5c43709d1 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -68,7 +68,7 @@ end subroutine cu_gf_driver_finalize !! !>\section gen_gf_driver GSD GF Cumulus Scheme General Algorithm !> @{ - subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & + subroutine cu_gf_driver_run(ntracer,garea,im,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, & @@ -97,39 +97,37 @@ subroutine cu_gf_driver_run(ntracer,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,ntracer + integer, intent(in ) :: im,km,ntracer logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend logical, intent(in ) :: ldiag3d,qdiag3d - 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 - real(kind=kind_phys), dimension( ix , km ), intent(inout ) :: qci_conv - real(kind=kind_phys), dimension( ix ) :: rand_mom,rand_vmas - real(kind=kind_phys), dimension( ix,4 ) :: rand_clos - real(kind=kind_phys), dimension( ix , km, 11 ) :: gdc,gdc2 - real(kind=kind_phys), dimension( ix , km ), intent(out ) :: cnvw_moist,cnvc - real(kind=kind_phys), dimension( ix , km ), intent(inout ) :: cliw, clcw + real(kind=kind_phys), dimension( im , km ), intent(in ) :: forcet,forceqv_spechum,w,phil + real(kind=kind_phys), dimension( im , km ), intent(inout ) :: t,us,vs + real(kind=kind_phys), dimension( im , km ), intent(inout ) :: qci_conv + real(kind=kind_phys), dimension( im ) :: rand_mom,rand_vmas + real(kind=kind_phys), dimension( im,4 ) :: rand_clos + real(kind=kind_phys), dimension( im , km, 11 ) :: gdc,gdc2 + real(kind=kind_phys), dimension( im , km ), intent(out ) :: cnvw_moist,cnvc + real(kind=kind_phys), dimension( im , km ), intent(inout ) :: cliw, clcw real(kind=kind_phys), dimension( : , : ), intent(inout ) :: & du3dt_SCNV,dv3dt_SCNV,dt3dt_SCNV,dq3dt_SCNV, & du3dt_DCNV,dv3dt_DCNV,dt3dt_DCNV,dq3dt_DCNV -! 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 + integer, dimension (im) :: tropics ! 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 -! end change ix to im - real(kind=kind_phys), dimension (ix,km) :: t2di,p2di + real(kind=kind_phys), dimension (im,km) :: t2di,p2di ! Specific humidity from FV3 - real(kind=kind_phys), dimension (ix,km), intent(in) :: qv2di_spechum - real(kind=kind_phys), dimension (ix,km), intent(inout) :: qv_spechum + real(kind=kind_phys), dimension (im,km), intent(in) :: qv2di_spechum + real(kind=kind_phys), dimension (im,km), intent(inout) :: qv_spechum ! Local water vapor mixing ratios and cloud water mixing ratios - real(kind=kind_phys), dimension (ix,km) :: qv2di, qv, forceqv, cnvw + real(kind=kind_phys), dimension (im,km) :: qv2di, qv, forceqv, cnvw ! real(kind=kind_phys), dimension( im ),intent(in) :: garea real(kind=kind_phys), intent(in ) :: dt diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index d89450273..e92949080 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -69,14 +69,6 @@ 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 = vertical layer dimension diff --git a/physics/cu_ntiedtke.F90 b/physics/cu_ntiedtke.F90 index 156e75c70..a824c6af4 100644 --- a/physics/cu_ntiedtke.F90 +++ b/physics/cu_ntiedtke.F90 @@ -148,8 +148,8 @@ end subroutine cu_ntiedtke_finalize !----------------------------------------------------------------------- ! level 1 subroutine 'tiecnvn' !----------------------------------------------------------------- - 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,& + subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & + evap,hfx,zprecc,lmask,lq,km,dt,dx,kbot,ktop,kcnv, & ktrac,ud_mf,dd_mf,dt_mf,cnvw,cnvc,errmsg,errflg) !----------------------------------------------------------------- ! this is the interface between the model and the mass @@ -157,14 +157,14 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, !----------------------------------------------------------------- implicit none ! in&out variables - integer, intent(in) :: lq, ix, km, ktrac + integer, intent(in) :: lq, km, ktrac real(kind=kind_phys), intent(in ) :: dt 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 ) :: tdi, qvdi, poz, prsl, pomg, pqvf, ptf - real(kind=kind_phys), dimension( ix , km+1 ), intent(in ) :: pzz, prsi - real(kind=kind_phys), dimension( ix , km, ktrac ), intent(inout ) :: clw + real(kind=kind_phys), dimension( lq , km ), intent(inout) :: pu, pv, pt, pqv + real(kind=kind_phys), dimension( lq , km ), intent(in ) :: tdi, qvdi, poz, prsl, pomg, pqvf, ptf + real(kind=kind_phys), dimension( lq , km+1 ), intent(in ) :: pzz, prsi + real(kind=kind_phys), dimension( lq , km, ktrac ), intent(inout ) :: clw integer, dimension( lq ), intent(out) :: kbot, ktop, kcnv real(kind=kind_phys), dimension( lq ), intent(out) :: zprecc diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 6dcc54a15..0e6a3d4b0 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -213,14 +213,6 @@ 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 = vertical layer dimension diff --git a/physics/dcyc2.f b/physics/dcyc2.f index c7a1ddd59..dcb164369 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -52,7 +52,7 @@ end subroutine dcyc2t3_finalize ! sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, ! ! sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, ! ! sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, ! -! ix, im, levs, deltim, fhswr, ! +! im, levs, deltim, fhswr, ! ! dry, icy, wet ! ! input/output: ! ! dtdt,dtdtc, ! @@ -83,10 +83,10 @@ end subroutine dcyc2t3_finalize ! sfcdsw (im) - real, total sky sfc downward sw flux ( w/m**2 ) ! ! sfcnsw (im) - real, total sky sfc net sw into ground (w/m**2) ! ! sfcdlw (im) - real, total sky sfc downward lw flux ( w/m**2 ) ! -! swh(ix,levs) - real, total sky sw heating rates ( k/s ) ! -! swhc(ix,levs) - real, clear sky sw heating rates ( k/s ) ! -! hlw(ix,levs) - real, total sky lw heating rates ( k/s ) ! -! hlwc(ix,levs) - real, clear sky lw heating rates ( k/s ) ! +! swh(im,levs) - real, total sky sw heating rates ( k/s ) ! +! swhc(im,levs) - real, clear sky sw heating rates ( k/s ) ! +! hlw(im,levs) - real, total sky lw heating rates ( k/s ) ! +! hlwc(im,levs) - real, clear sky lw heating rates ( k/s ) ! ! sfcnirbmu(im)- real, tot sky sfc nir-beam sw upward flux (w/m2) ! ! sfcnirdfu(im)- real, tot sky sfc nir-diff sw upward flux (w/m2) ! ! sfcvisbmu(im)- real, tot sky sfc uv+vis-beam sw upward flux (w/m2)! @@ -95,7 +95,7 @@ end subroutine dcyc2t3_finalize ! sfcnirdfd(im)- real, tot sky sfc nir-diff sw downward flux (w/m2) ! ! sfcvisbmd(im)- real, tot sky sfc uv+vis-beam sw dnward flux (w/m2)! ! sfcvisdfd(im)- real, tot sky sfc uv+vis-diff sw dnward flux (w/m2)! -! ix, im - integer, horiz. dimention and num of used points ! +! im - integer, horizontal dimension ! ! levs - integer, vertical layer dimension ! ! deltim - real, physics time step in seconds ! ! fhswr - real, Short wave radiation time step in seconds ! @@ -184,7 +184,7 @@ subroutine dcyc2t3_run & & sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, & & sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & - & ix, im, levs, deltim, fhswr, & + & im, levs, deltim, fhswr, & & dry, icy, wet, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: @@ -212,7 +212,7 @@ subroutine dcyc2t3_run & & pid12 = con_pi / hour12 ! --- inputs: - integer, intent(in) :: ix, im, levs + integer, intent(in) :: im, levs ! integer, intent(in) :: ipr ! logical lprnt @@ -232,7 +232,7 @@ subroutine dcyc2t3_run & & sfcnirbmu, sfcnirdfu, sfcvisbmu, sfcvisdfu, & & sfcnirbmd, sfcnirdfd, sfcvisbmd, sfcvisdfd - real(kind=kind_phys), dimension(ix,levs), intent(in) :: swh, hlw & + real(kind=kind_phys), dimension(im,levs), intent(in) :: swh, hlw & &, swhc, hlwc ! --- input/output: diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 9a5687bf5..fa1ef4800 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -290,14 +290,6 @@ kind = kind_phys intent = in optional = F -[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 diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 0189785e3..6527adb34 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -194,7 +194,7 @@ end subroutine drag_suite_init ! & nmtvr, cdmbgwd, me, lprnt, ipr, rdxzb, errmsg, errflg) ! subroutine drag_suite_run( & - & IM,IX,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & + & IM,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & & PRSI,DEL,PRSL,PRSLK,PHII,PHIL,DELTIM,KDT, & & VAR,oc1,oa4,ol4, & ! & varss,oc1ss,oa4ss,ol4ss, & @@ -295,7 +295,7 @@ subroutine drag_suite_run( & implicit none ! Interface variables - integer, intent(in) :: im, ix, km, imx, kdt, ipr, me, master + integer, intent(in) :: im, km, imx, kdt, ipr, me, master integer, intent(in) :: gwd_opt logical, intent(in) :: lprnt integer, intent(in) :: KPBL(im) diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index dfb6f64b8..22747da0a 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -14,14 +14,6 @@ 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 layers diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index b32843bc1..f9f2d4c0a 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -19,12 +19,10 @@ end subroutine shoc_init subroutine shoc_finalize () end subroutine shoc_finalize -#if 0 !> \section arg_table_shoc_run Argument Table !! \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, & +subroutine shoc_run (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, & @@ -32,7 +30,7 @@ subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, implicit none - integer, intent(in) :: ix, nx, nzm, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc + integer, intent(in) :: 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 ! @@ -114,7 +112,7 @@ 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' - call shoc_work (ix, nx, nzm, nzm+1, dtp, prsl, delp, & + call shoc_work (nx, 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, & diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index f4d2f3ae9..5bd59c589 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = shoc_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [nx] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/gscond.f b/physics/gscond.f index 6dd77d87e..28f24763c 100644 --- a/physics/gscond.f +++ b/physics/gscond.f @@ -41,7 +41,7 @@ end subroutine zhaocarr_gscond_finalize !! -# Update \f$t\f$, \f$q\f$, \f$cwm\f$ due to cloud evaporation and condensation processes. !> \section Zhao-Carr_cond_detailed GFS gscond Scheme Detailed Algorithm !> @{ - subroutine zhaocarr_gscond_run (im,ix,km,dt,dtf,prsl,ps,q,clw1 & + subroutine zhaocarr_gscond_run (im,km,dt,dtf,prsl,ps,q,clw1 & &, clw2, cwm, t, tp, qp, psp & &, tp1, qp1, psp1, u, lprnt, ipr, errmsg, errflg) @@ -71,15 +71,15 @@ subroutine zhaocarr_gscond_run (im,ix,km,dt,dtf,prsl,ps,q,clw1 & implicit none ! ! Interface variables - integer, intent(in) :: im, ix, km, ipr + integer, intent(in) :: im, km, ipr real(kind=kind_phys), intent(in) :: dt, dtf - real(kind=kind_phys), intent(in) :: prsl(ix,km), ps(im) - real(kind=kind_phys), intent(inout) :: q(ix,km) - real(kind=kind_phys), intent(in) :: clw1(ix,km), clw2(ix,km) - real(kind=kind_phys), intent(out) :: cwm(ix,km) - real(kind=kind_phys), intent(inout) :: t(ix,km) & - &, tp(ix,km), qp(ix,km), psp(im) & - &, tp1(ix,km), qp1(ix,km), psp1(im) + real(kind=kind_phys), intent(in) :: prsl(im,km), ps(im) + real(kind=kind_phys), intent(inout) :: q(im,km) + real(kind=kind_phys), intent(in) :: clw1(im,km), clw2(im,km) + real(kind=kind_phys), intent(out) :: cwm(im,km) + real(kind=kind_phys), intent(inout) :: t(im,km) & + &, tp(im,km), qp(im,km), psp(im) & + &, tp1(im,km), qp1(im,km), psp1(im) real(kind=kind_phys), intent(in) :: u(im,km) logical, intent(in) :: lprnt ! @@ -124,7 +124,7 @@ subroutine zhaocarr_gscond_run (im,ix,km,dt,dtf,prsl,ps,q,clw1 & ! el2orc = hvap*hvap / (rv*cp) albycp = hvap / cp -! write(0,*)' in gscond im=',im,' ix=',ix +! write(0,*)' in gscond im=',im ! rdt = h1/dt us = h1 diff --git a/physics/gscond.meta b/physics/gscond.meta index f2046df0a..9302dc8ca 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -19,14 +19,6 @@ 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 = vertical layer dimension diff --git a/physics/gwdc.f b/physics/gwdc.f index 314aa4d44..5c6f8ecd7 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -141,7 +141,7 @@ end subroutine gwdc_init !! !> \section al_gwdc GFS Convective GWD Scheme Detailed Algorithm !> @{ - subroutine gwdc_run (im,ix,km,lat,u1,v1,t1,q1,deltim, & + subroutine gwdc_run (im,km,lat,u1,v1,t1,q1,deltim, & & pmid1,pint1,dpmid1,qmax,ktop,kbot,kcnv,cldf, & & grav,cp,rd,fv,pi,dlength,lprnt,ipr,fhour, & & utgwc,vtgwc,tauctx,taucty,errmsg,errflg) @@ -186,16 +186,16 @@ subroutine gwdc_run (im,ix,km,lat,u1,v1,t1,q1,deltim, & ! !----------------------------------------------------------------------- - integer, intent(in) :: im, ix, km, lat, ipr + integer, intent(in) :: im, km, lat, ipr integer, intent(in) :: ktop(im),kbot(im),kcnv(im) real(kind=kind_phys), intent(in) :: grav,cp,rd,fv,fhour,deltim,pi real(kind=kind_phys), dimension(im), intent(in) :: qmax real(kind=kind_phys), dimension(im), intent(out) :: tauctx,taucty real(kind=kind_phys), dimension(im), intent(in) :: cldf,dlength - real(kind=kind_phys), dimension(ix,km), intent(in) :: u1,v1,t1, & + real(kind=kind_phys), dimension(im,km), intent(in) :: u1,v1,t1, & & q1,pmid1,dpmid1 - real(kind=kind_phys), dimension(ix,km), intent(out) :: utgwc,vtgwc - real(kind=kind_phys), dimension(ix,km+1), intent(in) :: pint1 + real(kind=kind_phys), dimension(im,km), intent(out) :: utgwc,vtgwc + real(kind=kind_phys), dimension(im,km+1), intent(in) :: pint1 ! logical, intent(in) :: lprnt ! @@ -375,7 +375,7 @@ subroutine gwdc_run (im,ix,km,lat,u1,v1,t1,q1,deltim, & ! print *,' ' ! write(*,*) 'Inside GWDC raw input start print at fhour = ', ! & fhour -! write(*,*) 'IX IM KM ',ix,im,km +! write(*,*) 'IM KM ',im,km ! write(*,*) 'KBOT KTOP QMAX DLENGTH kcnv ', ! + kbot(ipr),ktop(ipr),qmax(ipr),dlength(ipr),kcnv(ipr) ! write(*,*) 'grav cp rd ',grav,cp,rd diff --git a/physics/gwdc.meta b/physics/gwdc.meta index 2151cc5f7..fc57604fb 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -185,14 +185,6 @@ 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 layers diff --git a/physics/gwdps.f b/physics/gwdps.f index 96ce0205b..b09413f02 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -196,7 +196,7 @@ end subroutine gwdps_init !> \section det_gwdps GFS Orographic GWD Scheme Detailed Algorithm !> @{ subroutine gwdps_run( & - & IM,IX,KM,A,B,C,U1,V1,T1,Q1,KPBL, & + & IM,KM,A,B,C,U1,V1,T1,Q1,KPBL, & & PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DELTIM,KDT, & & HPRIME,OC,OA4,CLX4,THETA,SIGMA,GAMMA,ELVMAX, & & DUSFC,DVSFC,G, CP, RD, RV, IMX, & @@ -269,13 +269,13 @@ subroutine gwdps_run( & ! CRITICAL LEVELS ! ! INPUT -! A(IX,KM) NON-LIN TENDENCY FOR V WIND COMPONENT -! B(IX,KM) NON-LIN TENDENCY FOR U WIND COMPONENT -! C(IX,KM) NON-LIN TENDENCY FOR TEMPERATURE -! U1(IX,KM) ZONAL WIND M/SEC AT T0-DT -! V1(IX,KM) MERIDIONAL WIND M/SEC AT T0-DT -! T1(IX,KM) TEMPERATURE DEG K AT T0-DT -! Q1(IX,KM) SPECIFIC HUMIDITY AT T0-DT +! A(IM,KM) NON-LIN TENDENCY FOR V WIND COMPONENT +! B(IM,KM) NON-LIN TENDENCY FOR U WIND COMPONENT +! C(IM,KM) NON-LIN TENDENCY FOR TEMPERATURE +! U1(IM,KM) ZONAL WIND M/SEC AT T0-DT +! V1(IM,KM) MERIDIONAL WIND M/SEC AT T0-DT +! T1(IM,KM) TEMPERATURE DEG K AT T0-DT +! Q1(IM,KM) SPECIFIC HUMIDITY AT T0-DT ! ! DELTIM TIME STEP SECS ! SI(N) P/PSFC AT BASE OF LAYER N @@ -297,24 +297,24 @@ subroutine gwdps_run( & implicit none ! ! Interface variables - integer, intent(in) :: im, ix, km, imx, kdt, ipr, me + integer, intent(in) :: im, km, imx, kdt, ipr, me integer, intent(in) :: KPBL(IM) ! Index for the PBL top layer! 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) + & A(IM,KM), B(IM,KM), C(IM,KM) real(kind=kind_phys), intent(in) :: & - & U1(IX,KM), V1(IX,KM), T1(IX,KM), & - & Q1(IX,KM), PRSI(IX,KM+1), DEL(IX,KM), & - & PRSL(IX,KM), PRSLK(IX,KM), PHIL(IX,KM), & - & PHII(IX,KM+1) + & U1(IM,KM), V1(IM,KM), T1(IM,KM), & + & Q1(IM,KM), PRSI(IM,KM+1), DEL(IM,KM), & + & PRSL(IM,KM), PRSLK(IM,KM), PHIL(IM,KM), & + & PHII(IM,KM+1) real(kind=kind_phys), intent(in) :: & - & OC(IM), OA4(IX,4), CLX4(IX,4), HPRIME(IM) + & OC(IM), OA4(IM,4), CLX4(IM,4), HPRIME(IM) real(kind=kind_phys), intent(inout) :: ELVMAX(IM) real(kind=kind_phys), intent(in) :: & & THETA(IM), SIGMA(IM), GAMMA(IM) real(kind=kind_phys), intent(out) :: DUSFC(IM), DVSFC(IM), & - & RDXZB(IX) + & RDXZB(IM) integer, intent(in) :: nmtvr logical, intent(in) :: lprnt character(len=*), intent(out) :: errmsg @@ -471,7 +471,7 @@ subroutine gwdps_run( & ! kreflm(i) = 0 enddo ! if (lprnt) -! & print *,' in gwdps_lm.f npt,IM,IX,IY,km,me=',npt,IM,IX,IY,km,me +! & print *,' in gwdps_lm.f npt,IM,IY,km,me=',npt,IM,IY,km,me ! ! !> --- Subgrid Mountain Blocking Section diff --git a/physics/gwdps.meta b/physics/gwdps.meta index 677dc6502..d843e6d53 100644 --- a/physics/gwdps.meta +++ b/physics/gwdps.meta @@ -14,14 +14,6 @@ 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 layers diff --git a/physics/h2ophys.f b/physics/h2ophys.f index 929b38aa7..b3bdd279f 100644 --- a/physics/h2ophys.f +++ b/physics/h2ophys.f @@ -26,7 +26,7 @@ end subroutine h2ophys_init !! !! \section genal_h2ophys GFS H2O Physics Scheme General Algorithm !> @{ - subroutine h2ophys_run(ix, im, levs, kh2o, dt, h2o, ph2o, prsl, & + subroutine h2ophys_run(im, levs, kh2o, dt, h2o, ph2o, prsl, & & h2opltc, h2o_coeff, ldiag3d, me, & & errmsg, errflg) ! @@ -39,14 +39,14 @@ subroutine h2ophys_run(ix, im, levs, kh2o, dt, h2o, ph2o, prsl, & use machine , only : kind_phys implicit none ! interface variables - integer, intent(in) :: ix, im, levs, kh2o, h2o_coeff, me + integer, intent(in) :: im, levs, kh2o, h2o_coeff, me real(kind=kind_phys), intent(in) :: dt - real(kind=kind_phys), intent(inout) :: h2o(ix,levs) + real(kind=kind_phys), intent(inout) :: h2o(im,levs) real(kind=kind_phys), intent(in) :: ph2o(kh2o) - real(kind=kind_phys), intent(in) :: prsl(ix,levs) - real(kind=kind_phys), intent(in) :: h2opltc(ix,kh2o,h2o_coeff) + real(kind=kind_phys), intent(in) :: prsl(im,levs) + real(kind=kind_phys), intent(in) :: h2opltc(im,kh2o,h2o_coeff) logical , intent(in) :: ldiag3d - !real(kind=kind_phys), intent(inout) :: h2op(ix,levs,h2o_coeff) + !real(kind=kind_phys), intent(inout) :: h2op(im,levs,h2o_coeff) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! local variables @@ -61,7 +61,7 @@ subroutine h2ophys_run(ix, im, levs, kh2o, dt, h2o, ph2o, prsl, & errmsg = '' errflg = 0 ! -! write(1000+me,*)' in h2ophys ix=',ix, im, levs, kh2o, dt +! write(1000+me,*)' in h2ophys im=', im, levs, kh2o, dt do l=1,levs pmin = 1.0e10 pmax = -1.0e10 diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index 9aed54eb2..995e25436 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -6,14 +6,6 @@ [ccpp-arg-table] name = h2ophys_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 diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 8b2b4c99f..f3420e094 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -111,7 +111,7 @@ end subroutine m_micro_finalize !! !>\section detail_m_micro_run MG m_micro_run Detailed Algorithm !> @{ - subroutine m_micro_run( im, ix, lm, flipv, dt_i & + subroutine m_micro_run( im, lm, flipv, dt_i & &, prsl_i, prsi_i, phil, phii & &, omega_i, QLLS_i, QLCN_i, QILS_i, QICN_i& &, lwheat_i, swheat_i, w_upi, cf_upi & @@ -174,15 +174,15 @@ 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, kdt, fprcp, pdfflag + integer,intent(in) :: im, lm, kdt, fprcp, pdfflag logical,intent(in) :: flipv, skip_macro integer,intent(in) :: iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) - real (kind=kind_phys), dimension(ix,lm),intent(in) :: & + real (kind=kind_phys), dimension(im,lm),intent(in) :: & & prsl_i,u_i,v_i,phil, omega_i, QLLS_i,QILS_i, & & lwheat_i,swheat_i - real (kind=kind_phys), dimension(ix,0:lm),intent(in):: prsi_i, & + real (kind=kind_phys), dimension(im,0:lm),intent(in):: prsi_i, & & phii ! GJF* These variables are conditionally allocated depending on whether the ! Morrison-Gettelman microphysics is used, so they must be declared @@ -202,7 +202,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! & CNVPRCP ! output - real (kind=kind_phys),dimension(ix,lm), intent(out) :: lwm_o, qi_o, & + real (kind=kind_phys),dimension(im,lm), intent(out) :: lwm_o, qi_o, & cldreffl, cldreffi, cldreffr, cldreffs, cldreffg real (kind=kind_phys),dimension(im), intent(out) :: rn_o, sr_o character(len=*), intent(out) :: errmsg @@ -211,7 +211,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! input and output ! Anning Cheng 10/24/2016 twat for total water, diagnostic purpose integer, dimension(IM), intent(inout):: KCBL - real (kind=kind_phys),dimension(ix,lm),intent(inout):: q_io, t_io, & + real (kind=kind_phys),dimension(im,lm),intent(inout):: q_io, t_io, & & ncpl_io,ncpi_io,CLLS_io ! GJF* These variables are conditionally allocated depending on whether the ! Morrison-Gettelman microphysics is used, so they must be declared diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 8ea90f7b9..b0b0c3522 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -309,14 +309,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [lm] standard_name = vertical_dimension long_name = vertical layer dimension diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 index e28cf5e69..d239013b4 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -21,8 +21,8 @@ end subroutine myjpbl_wrapper_finalize !! !###=================================================================== SUBROUTINE myjpbl_wrapper_run( & - & restart,do_myjsfc, & - & ix,im,levs,dt_phs, & + & restart,do_myjsfc, & + & im,levs,dt_phs, & & kdt,ntrac,ntke, & & ntcw,ntiw,ntrw,ntsw,ntgl, & & ugrs, vgrs, tgrs, qgrs, & @@ -76,7 +76,7 @@ SUBROUTINE myjpbl_wrapper_run( & integer, intent(out) :: errflg !MYJ-1D - integer,intent(in) :: im, ix, levs + integer,intent(in) :: im, levs integer,intent(in) :: kdt, me integer,intent(in) :: ntrac,ntke,ntcw,ntiw,ntrw,ntsw,ntgl logical,intent(in) :: restart,do_myjsfc,lprnt diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index dd2560e06..c8a4a0b9e 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -17,14 +17,6 @@ type = logical intent = in optional = F -[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 diff --git a/physics/module_MYJSFC_wrapper.F90 b/physics/module_MYJSFC_wrapper.F90 index 1406a99be..8d4ccc858 100644 --- a/physics/module_MYJSFC_wrapper.F90 +++ b/physics/module_MYJSFC_wrapper.F90 @@ -22,7 +22,7 @@ end subroutine myjsfc_wrapper_finalize !###=================================================================== SUBROUTINE myjsfc_wrapper_run( & & restart, & - & ix,im,levs, & + & im,levs, & & kdt,ntrac,ntke, & & ntcw,ntiw,ntrw,ntsw,ntgl, & & iter,flag_iter, & @@ -84,7 +84,7 @@ SUBROUTINE myjsfc_wrapper_run( & integer, intent(out) :: errflg !MYJ-1D - integer,intent(in) :: im, ix, levs + integer,intent(in) :: im, levs integer,intent(in) :: kdt, iter, me integer,intent(in) :: ntrac,ntke,ntcw,ntiw,ntrw,ntsw,ntgl logical,intent(in) :: restart, lprnt diff --git a/physics/module_MYJSFC_wrapper.meta b/physics/module_MYJSFC_wrapper.meta index 8100d0b05..bc7c7cec4 100644 --- a/physics/module_MYJSFC_wrapper.meta +++ b/physics/module_MYJSFC_wrapper.meta @@ -9,14 +9,6 @@ type = logical intent = in optional = F -[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 diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index e6c553350..0e9cb3c4f 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -37,7 +37,7 @@ end subroutine mynnedmf_wrapper_finalize !! \htmlinclude mynnedmf_wrapper_run.html !! SUBROUTINE mynnedmf_wrapper_run( & - & ix,im,levs, & + & im,levs, & & flag_init,flag_restart,cycling, & & lssav, ldiag3d, qdiag3d, lsidea,& & delt,dtf,dx,zorl, & @@ -204,7 +204,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !MYNN-1D REAL(kind=kind_phys), intent(in) :: delt, dtf - INTEGER, intent(in) :: im, ix, levs + INTEGER, intent(in) :: im, levs LOGICAL, intent(in) :: flag_init, flag_restart INTEGER :: initflag, k, i INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 393ad5292..31ebcde74 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -27,17 +27,10 @@ intent = out optional = F +##################################################################### [ccpp-arg-table] name = mynnedmf_wrapper_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 diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 82cdbca76..5693c49a8 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -19,14 +19,12 @@ end subroutine mynnsfc_wrapper_finalize !>\defgroup gsd_mynn_sfc GSD MYNN Surface Layer Scheme Module !> \brief This scheme (1) performs pre-mynnsfc work, (2) runs the mynn sfc layer scheme, and (3) performs post-mynnsfc work -#if 0 !! \section arg_table_mynnsfc_wrapper_run Argument Table !! \htmlinclude mynnsfc_wrapper_run.html !! -#endif !###=================================================================== SUBROUTINE mynnsfc_wrapper_run( & - & ix,im,levs, & + & im,levs, & & itimestep,iter, & & flag_init,flag_restart,lsm, & & delt,dx, & @@ -105,7 +103,7 @@ SUBROUTINE mynnsfc_wrapper_run( & !MYNN-1D REAL :: delt - INTEGER :: im, ix, levs + INTEGER :: im, levs INTEGER :: iter, k, i, itimestep, lsm LOGICAL :: flag_init,flag_restart,lprnt INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index a58253c08..61ddb4fd0 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = mynnsfc_wrapper_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 diff --git a/physics/module_SGSCloud_RadPost.F90 b/physics/module_SGSCloud_RadPost.F90 index 051033a26..bedb660a6 100644 --- a/physics/module_SGSCloud_RadPost.F90 +++ b/physics/module_SGSCloud_RadPost.F90 @@ -19,7 +19,7 @@ end subroutine sgscloud_radpost_finalize !! \htmlinclude sgscloud_radpost_run.html !! subroutine sgscloud_radpost_run( & - ix,im,levs, & + im,levs, & flag_init,flag_restart, & qc,qi, & qc_save,qi_save, & @@ -32,7 +32,7 @@ subroutine sgscloud_radpost_run( & implicit none !------------------------------------------------------------------- - integer, intent(in) :: ix, im, levs + integer, intent(in) :: 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) :: qc_save, qi_save diff --git a/physics/module_SGSCloud_RadPost.meta b/physics/module_SGSCloud_RadPost.meta index b3a5bce2b..da4191aad 100644 --- a/physics/module_SGSCloud_RadPost.meta +++ b/physics/module_SGSCloud_RadPost.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = sgscloud_radpost_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 diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index e78941d81..16ebac5d7 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -32,7 +32,7 @@ end subroutine sgscloud_radpre_finalize !>\section sgscloud_radpre GSD SGS Scheme General Algorithm !> @{ subroutine sgscloud_radpre_run( & - ix,im,levs, & + im,levs, & flag_init,flag_restart, & do_mynnedmf, & qc, qi, T3D, & @@ -57,7 +57,7 @@ subroutine sgscloud_radpre_run( & !------------------------------------------------------------------- ! Interface variables real (kind=kind_phys), parameter :: gfac=1.0e5/con_g - integer, intent(in) :: ix, im, levs, imfdeepcnv, imfdeepcnv_gf, nlay + integer, intent(in) :: im, levs, imfdeepcnv, imfdeepcnv_gf, nlay logical, intent(in) :: flag_init, flag_restart, do_mynnedmf real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc, qi real(kind=kind_phys), dimension(im,levs), intent(inout) :: qr, qs diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index f959e66ef..79691920d 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -11,14 +11,6 @@ [ccpp-arg-table] name = sgscloud_radpre_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 diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 6cab9b7ed..63edc3486 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -57,7 +57,7 @@ end subroutine hedmf_finalize !! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. !! \section detailed_hedmf GFS Hybrid HEDMF Detailed Algorithm !! @{ - subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & + subroutine hedmf_run (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, & @@ -79,7 +79,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & logical, intent(in) :: lprnt,lssav,ldiag3d,qdiag3d,lsidea logical, intent(in) :: flag_for_pbl_generic_tend integer, intent(in) :: ipr - integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im), ntoz + integer, intent(in) :: im, km, ntrac, ntcw, kinver(im), ntoz integer, intent(out) :: kpbl(im) ! @@ -91,9 +91,9 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & real(kind=kind_phys), intent(inout), dimension(:,:) :: & & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL,do3dt_PBL 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), & + & u1(im,km), v1(im,km), & + & t1(im,km), q1(im,km,ntrac), & + & swh(im,km), hlw(im,km), & & xmu(im), psk(im), & & rbsoil(im), zorl(im), & & u10m(im), v10m(im), & @@ -102,9 +102,9 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & 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) + & prsi(im,km+1), del(im,km), & + & prsl(im,km), prslk(im,km), & + & phii(im,km+1), phil(im,km) real(kind=kind_phys), intent(out) :: & & dusfc(im), dvsfc(im), & & dtsfc(im), dqsfc(im), & @@ -243,8 +243,6 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !> ## Compute preliminary variables from input arguments ! compute preliminary variables -! - if (ix .lt. im) stop ! ! iprt = 0 ! if(iprt.eq.1) then @@ -860,7 +858,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo !> For details of the mfpbl subroutine, step into its documentation ::mfpbl - call mfpbl(im,ix,km,ntrac,dt2,pcnvflg, + call mfpbl(im,im,km,ntrac,dt2,pcnvflg, & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) ! diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 313e22e17..a89660cac 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -32,14 +32,6 @@ [ccpp-arg-table] name = hedmf_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 diff --git a/physics/moninedmf_hafs.f b/physics/moninedmf_hafs.f index 5c6ff85a8..00a8dbd0b 100644 --- a/physics/moninedmf_hafs.f +++ b/physics/moninedmf_hafs.f @@ -57,7 +57,7 @@ end subroutine hedmf_hafs_finalize !! -# 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, & + subroutine hedmf_hafs_run(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, & @@ -76,7 +76,7 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! logical, intent(in) :: lprnt integer, intent(in) :: ipr - integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) + integer, intent(in) :: im, km, ntrac, ntcw, kinver(im) integer, intent(in) :: islimsk(1:im) integer, intent(out) :: kpbl(im) @@ -86,9 +86,9 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & 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), & + & u1(im,km), v1(im,km), & + & t1(im,km), q1(im,km,ntrac), & + & swh(im,km), hlw(im,km), & & xmu(im), psk(im), & & rbsoil(im), zorl(im), & & u10m(im), v10m(im), & @@ -97,9 +97,9 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & 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) + & prsi(im,km+1), del(im,km), & + & prsl(im,km), prslk(im,km), & + & phii(im,km+1), phil(im,km) real(kind=kind_phys), intent(out) :: & & dusfc(im), dvsfc(im), & & dtsfc(im), dqsfc(im), & @@ -257,8 +257,6 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !> ## Compute preliminary variables from input arguments ! compute preliminary variables -! - if (ix .lt. im) stop ! ! iprt = 0 ! if(iprt.eq.1) then @@ -1107,7 +1105,7 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo !> For details of the mfpbl subroutine, step into its documentation ::mfpbl - call mfpbl(im,ix,km,ntrac,dt2,pcnvflg, + call mfpbl(im,im,km,ntrac,dt2,pcnvflg, & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) ! diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta index d600c8eac..2883e6847 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -32,14 +32,6 @@ [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 diff --git a/physics/moninshoc.f b/physics/moninshoc.f index eb6ccd7e7..86cab9643 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -24,7 +24,7 @@ end subroutine moninshoc_finalize !> \section arg_table_moninshoc_run Argument Table !! \htmlinclude moninshoc_run.html !! - subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, + subroutine moninshoc_run (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, @@ -41,7 +41,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! arguments ! - integer, intent(in) :: ix, im, + integer, intent(in) :: im, & km, ntrac, ntcw, ncnd, ntke integer, dimension(im), intent(in) :: kinver @@ -51,10 +51,10 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & rd, cp, hvap, fv real(kind=kind_phys), dimension(im), intent(in) :: psk, & rbsoil, zorl, u10m, v10m, fm, fh, tsea, heat, evap, stress, spd1 - real(kind=kind_phys), dimension(ix,km), intent(in) :: u1, v1, + real(kind=kind_phys), dimension(im,km), intent(in) :: u1, v1, & t1, tkh, del, prsl, phil, prslk - real(kind=kind_phys), dimension(ix,km+1), intent(in) :: prsi, phii - real(kind=kind_phys), dimension(ix,km,ntrac), intent(in) :: q1 + real(kind=kind_phys), dimension(im,km+1), intent(in) :: prsi, phii + real(kind=kind_phys), dimension(im,km,ntrac), intent(in) :: q1 real(kind=kind_phys), dimension(im,km), intent(inout) :: du, dv, & tau @@ -114,8 +114,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, !----------------------------------------------------------------------- ! ! compute preliminary variables -! - if (ix < im) stop ! dt2 = delt rdt = 1. / dt2 diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index d5fd594ab..e8da8478d 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = moninshoc_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 diff --git a/physics/mp_thompson_post.F90 b/physics/mp_thompson_post.F90 index dd4a2b3f5..97b44943d 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/mp_thompson_post.F90 @@ -17,12 +17,11 @@ module mp_thompson_post !! \section arg_table_mp_thompson_post_init Argument Table !! \htmlinclude mp_thompson_post_init.html !! - subroutine mp_thompson_post_init(ncol, ttendlim, errmsg, errflg) + subroutine mp_thompson_post_init(ttendlim, errmsg, errflg) implicit none ! Interface variables - integer, intent(in) :: ncol real(kind_phys), intent(in) :: ttendlim ! CCPP error handling diff --git a/physics/mp_thompson_post.meta b/physics/mp_thompson_post.meta index 7a26db6f5..eeaeeb65d 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/mp_thompson_post.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = mp_thompson_post_init type = scheme -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F [ttendlim] standard_name = limit_for_temperature_tendency_for_microphysics long_name = temperature tendency limiter per physics time step diff --git a/physics/ozphys.f b/physics/ozphys.f index 8ca13b99f..f8da58760 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -50,7 +50,7 @@ end subroutine ozphys_finalize !> \section genal_ozphys GFS ozphys_run General Algorithm !> @{ subroutine ozphys_run ( & - & ix, im, levs, ko3, dt, oz, tin, po3, & + & im, levs, ko3, dt, oz, tin, po3, & & prsl, prdout, oz_coeff, delp, ldiag3d, qdiag3d, & & ozp1, ozp2, ozp3, ozp4, con_g, me, errmsg, errflg) ! @@ -61,15 +61,15 @@ subroutine ozphys_run ( & implicit none ! ! Interface variables - integer, intent(in) :: im, ix, levs, ko3, oz_coeff, me + integer, intent(in) :: im, levs, ko3, oz_coeff, me real(kind=kind_phys), intent(inout) :: & - & oz(ix,levs) + & oz(im,levs) ! These arrays may not be allocated and need assumed array sizes real(kind=kind_phys), intent(inout) :: & & ozp1(:,:), ozp2(:,:), ozp3(:,:), ozp4(:,:) real(kind=kind_phys), intent(in) :: & - & dt, po3(ko3), prdout(ix,ko3,oz_coeff), & - & prsl(ix,levs), tin(ix,levs), delp(ix,levs), & + & dt, po3(ko3), prdout(im,ko3,oz_coeff), & + & prsl(im,levs), tin(im,levs), delp(im,levs), & & con_g real :: gravi logical, intent(in) :: ldiag3d, qdiag3d @@ -82,7 +82,7 @@ subroutine ozphys_run ( & logical flg(im) real(kind=kind_phys) pmax, pmin, tem, temp real(kind=kind_phys) wk1(im), wk2(im), wk3(im), prod(im,oz_coeff), - & ozib(im), colo3(im,levs+1), ozi(ix,levs) + & ozib(im), colo3(im,levs+1), ozi(im,levs) ! ! Initialize CCPP error handling variables errmsg = '' diff --git a/physics/ozphys.meta b/physics/ozphys.meta index 8cce5c266..4f0e6aa9d 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -36,14 +36,6 @@ [ccpp-arg-table] name = ozphys_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 diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index a42c74bfc..238a8fb21 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -54,7 +54,7 @@ end subroutine ozphys_2015_finalize !! climatological T and O3 are in location 5 and 6 of prdout array !!\author June 2015 - Shrinivas Moorthi subroutine ozphys_2015_run ( & - & ix, im, levs, ko3, dt, oz, tin, po3, & + & im, levs, ko3, dt, oz, tin, po3, & & prsl, prdout, pl_coeff, delp, & & ldiag3d, qdiag3d, & & ozp1,ozp2,ozp3,ozp4,con_g, & @@ -66,15 +66,15 @@ subroutine ozphys_2015_run ( & ! real(kind=kind_phys),intent(in) :: con_g real :: gravi - integer, intent(in) :: im, ix, levs, ko3, pl_coeff,me + integer, intent(in) :: im, levs, ko3, pl_coeff,me real(kind=kind_phys), intent(in) :: po3(ko3), & - & prsl(ix,levs), tin(ix,levs), & - & delp(ix,levs), & - & prdout(ix,ko3,pl_coeff), dt + & prsl(im,levs), tin(im,levs), & + & delp(im,levs), & + & prdout(im,ko3,pl_coeff), dt ! These arrays may not be allocated and need assumed array sizes real(kind=kind_phys), intent(inout) :: & & ozp1(:,:), ozp2(:,:), ozp3(:,:),ozp4(:,:) - real(kind=kind_phys), intent(inout) :: oz(ix,levs) + real(kind=kind_phys), intent(inout) :: oz(im,levs) character(len=*), intent(out) :: errmsg @@ -85,7 +85,7 @@ subroutine ozphys_2015_run ( & real(kind=kind_phys) pmax, pmin, tem, temp real(kind=kind_phys) wk1(im), wk2(im), wk3(im),prod(im,pl_coeff), & & ozib(im), colo3(im,levs+1), coloz(im,levs+1),& - & ozi(ix,levs) + & ozi(im,levs) ! ! Initialize CCPP error handling variables errmsg = '' diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index eedfe3ca2..bfc010358 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -36,14 +36,6 @@ [ccpp-arg-table] name = ozphys_2015_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 diff --git a/physics/precpd.f b/physics/precpd.f index 5e7018314..0e330558b 100644 --- a/physics/precpd.f +++ b/physics/precpd.f @@ -45,7 +45,7 @@ end subroutine zhaocarr_precpd_init !! -# Calculate precipitation at surface (\f$rn\f$) and fraction of frozen precipitation (\f$sr\f$). !! \section Zhao-Carr_precip_detailed GFS precpd Scheme Detailed Algorithm !> @{ - subroutine zhaocarr_precpd_run (im,ix,km,dt,del,prsl,q,cwm,t,rn & + subroutine zhaocarr_precpd_run (im,km,dt,del,prsl,q,cwm,t,rn & &, sr,rainp,u00k,psautco,prautco,evpco,wminco & &, wk1,lprnt,jpr,errmsg,errflg) @@ -77,18 +77,17 @@ subroutine zhaocarr_precpd_run (im,ix,km,dt,del,prsl,q,cwm,t,rn & ! argument list: ! -------------- ! im : inner dimension over which calculation is made -! ix : maximum inner dimension ! km : number of vertical levels ! dt : time step in seconds ! del(km) : pressure layer thickness (bottom to top) ! prsl(km) : pressure values for model layers (bottom to top) -! q(ix,km) : specific humidity (updated in the code) -! cwm(ix,km) : condensate mixing ratio (updated in the code) -! t(ix,km) : temperature (updated in the code) +! q(im,km) : specific humidity (updated in the code) +! cwm(im,km) : condensate mixing ratio (updated in the code) +! t(im,km) : temperature (updated in the code) ! rn(im) : precipitation over one time-step dt (m/dt) !old sr(im) : index (=-1 snow, =0 rain/snow, =1 rain) !new sr(im) : "snow ratio", ratio of snow to total precipitation -! cll(ix,km) : cloud cover +! cll(im,km) : cloud cover !hchuang rn(im) unit in m per time step ! precipitation rate conversion 1 mm/s = 1 kg/m2/s ! @@ -101,11 +100,11 @@ subroutine zhaocarr_precpd_run (im,ix,km,dt,del,prsl,q,cwm,t,rn & ! include 'constant.h' ! ! Interface variables - integer, intent(in) :: im, ix, km, jpr + integer, intent(in) :: im, km, jpr real (kind=kind_phys), intent(in) :: dt - real (kind=kind_phys), intent(in) :: del(ix,km), prsl(ix,km) - real (kind=kind_phys), intent(inout) :: q(ix,km), t(ix,km), & - & cwm(ix,km) + real (kind=kind_phys), intent(in) :: del(im,km), prsl(im,km) + real (kind=kind_phys), intent(inout) :: q(im,km), t(im,km), & + & cwm(im,km) real (kind=kind_phys), intent(out) :: rn(im), sr(im), rainp(im,km) real (kind=kind_phys), intent(in) :: u00k(im,km) real (kind=kind_phys), intent(in) :: psautco(2), prautco(2), & diff --git a/physics/precpd.meta b/physics/precpd.meta index 37a1850ab..6df3f35af 100644 --- a/physics/precpd.meta +++ b/physics/precpd.meta @@ -14,14 +14,6 @@ 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 = vertical layer dimension diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index be3b928a8..cc6838b2c 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -228,11 +228,10 @@ end subroutine rascnv_finalize !! 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) ! +!! rannum - real, array holding random numbers between 0 an 1 (im,nrcm) ! !! tin - real, input temperature (K) !! qin - real, input specific humidity (kg/kg) !! uin - real, input zonal wind component @@ -286,7 +285,7 @@ end subroutine rascnv_finalize !! \section arg_table_rascnv_run Argument Table !! \htmlinclude rascnv_run.html !! - subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & + subroutine rascnv_run(IM, k, ntr, dt, dtf & &, ccwf, area, dxmin, dxinv & &, psauras, prauras, wminras, dlqf, flipv & &, me, rannum, nrcm, mp_phys, mp_phys_mg & @@ -321,7 +320,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! ! input ! - integer, intent(in) :: im, ix, k, ntr, me, nrcm, ntk, kdt & + integer, intent(in) :: im, k, ntr, me, nrcm, ntk, kdt & &, mp_phys, mp_phys_mg integer, dimension(im) :: kbot, ktop, kcnv, kpbl ! @@ -329,9 +328,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, psauras(2), prauras(2) & &, wminras(2), dlqf(2) ! - real(kind=kind_phys), dimension(ix,k) :: tin, qin, uin, vin & + real(kind=kind_phys), dimension(im,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+1) :: prsi, prsik, phii real(kind=kind_phys), dimension(im,k) :: ud_mf, dd_mf, dt_mf & &, rhc, qlcn, qicn, w_upi & &, cnv_mfd & @@ -340,8 +339,8 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, cnv_nice, cf_upi 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,ntr+2) + real(kind=kind_phys), dimension(im,nrcm):: rannum + real(kind=kind_phys) ccin(im,k,ntr+2) real(kind=kind_phys) trcmin(ntr+2) real(kind=kind_phys) DT, dtf, qw0, qi0 diff --git a/physics/rascnv.meta b/physics/rascnv.meta index 0a201e74d..c2ad6bf3f 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -196,14 +196,6 @@ 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 diff --git a/physics/rayleigh_damp.f b/physics/rayleigh_damp.f index 8ef5aa947..a56a85e8c 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -24,7 +24,7 @@ end subroutine rayleigh_damp_init !>\section gen_ray_damp_run GFS rayleigh_damp_runGeneral Algorithm !> @{ subroutine rayleigh_damp_run ( & - & lsidea,IM,IX,KM,A,B,C,U1,V1,DT,CP, & + & lsidea,IM,KM,A,B,C,U1,V1,DT,CP, & & LEVR,pgr,PRSL,PRSLRD0,ral_ts, & & ldiag3d,du3dt,dv3dt,dt3dt, & & errmsg,errflg) @@ -49,16 +49,16 @@ subroutine rayleigh_damp_run ( & ! IS CONVERTED INTO INTERNAL ENERGY. ! ! INPUT -! A(IX,KM) NON-LIN TENDENCY FOR V WIND COMPONENT -! B(IX,KM) NON-LIN TENDENCY FOR U WIND COMPONENT -! C(IX,KM) NON-LIN TENDENCY FOR TEMPERATURE -! U1(IX,KM) ZONAL WIND M/SEC AT T0-DT -! V1(IX,KM) MERIDIONAL WIND M/SEC AT T0-DT -! T1(IX,KM) TEMPERATURE DEG K AT T0-DT +! A(IM,KM) NON-LIN TENDENCY FOR V WIND COMPONENT +! B(IM,KM) NON-LIN TENDENCY FOR U WIND COMPONENT +! C(IM,KM) NON-LIN TENDENCY FOR TEMPERATURE +! U1(IM,KM) ZONAL WIND M/SEC AT T0-DT +! V1(IM,KM) MERIDIONAL WIND M/SEC AT T0-DT +! T1(IM,KM) TEMPERATURE DEG K AT T0-DT ! ! DT TIME STEP SECS ! pgr(im) surface pressure (Pa) -! prsl(IX,KM) PRESSURE AT MIDDLE OF LAYER (Pa) +! prsl(IM,KM) PRESSURE AT MIDDLE OF LAYER (Pa) ! prslrd0 pressure level above which to apply Rayleigh damping ! ral_ts timescale in days for Rayleigh damping ! @@ -69,11 +69,11 @@ subroutine rayleigh_damp_run ( & implicit none ! logical,intent(in) :: lsidea,ldiag3d - integer,intent(in) :: im, ix, km,levr + integer,intent(in) :: im, km,levr real(kind=kind_phys),intent(in) :: DT, CP, PRSLRD0, ral_ts - real(kind=kind_phys),intent(in) :: pgr(im), PRSL(IX,KM) - real(kind=kind_phys),intent(in) :: U1(IX,KM), V1(IX,KM) - real(kind=kind_phys),intent(inout) :: A(IX,KM), B(IX,KM), C(IX,KM) + real(kind=kind_phys),intent(in) :: pgr(im), PRSL(IM,KM) + real(kind=kind_phys),intent(in) :: U1(IM,KM), V1(IM,KM) + real(kind=kind_phys),intent(inout) :: A(IM,KM), B(IM,KM), C(IM,KM) real(kind=kind_phys),intent(inout) :: du3dt(:,:) real(kind=kind_phys),intent(inout) :: dv3dt(:,:) real(kind=kind_phys),intent(inout) :: dt3dt(:,:) diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index 2f9d81ed5..554ac4139 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -22,14 +22,6 @@ 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 layers diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 03f5f05ef..361aadbae 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -68,7 +68,7 @@ end subroutine samfdeepcnv_finalize !! !! \section samfdeep_detailed GFS samfdeepcnv Detailed Algorithm !! @{ - subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & + subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp, & & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav, & @@ -86,24 +86,24 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & implicit none ! - integer, intent(in) :: im, ix, km, itc, ntc, ntk, ntr, ncloud + integer, intent(in) :: im, km, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(im) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, eps, epsm1, & & fv, grav, hvap, rd, rv, t0c real(kind=kind_phys), intent(in) :: delt - real(kind=kind_phys), intent(in) :: psp(im), delp(ix,km), & - & prslp(ix,km), garea(im), dot(ix,km), phil(ix,km) + real(kind=kind_phys), intent(in) :: psp(im), delp(im,km), & + & prslp(im,km), garea(im), dot(im,km), phil(im,km) real(kind=kind_phys), dimension(:), intent(in) :: fscav real(kind=kind_phys), intent(in) :: nthresh - real(kind=kind_phys), intent(in) :: ca_deep(ix) - real(kind=kind_phys), intent(out) :: rainevap(ix) + real(kind=kind_phys), intent(in) :: ca_deep(im) + real(kind=kind_phys), intent(out) :: rainevap(im) logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger integer, intent(inout) :: kcnv(im) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH - real(kind=kind_phys), intent(inout) :: qtr(ix,km,ntr+2), & - & q1(ix,km), t1(ix,km), u1(ix,km), v1(ix,km), & - & cnvw(ix,km), cnvc(ix,km) + real(kind=kind_phys), intent(inout) :: qtr(im,km,ntr+2), & + & q1(im,km), t1(im,km), u1(im,km), v1(im,km), & + & cnvw(im,km), cnvc(im,km) integer, intent(out) :: kbot(im), ktop(im) real(kind=kind_phys), intent(out) :: cldwrk(im), & @@ -169,7 +169,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & ! ! real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), real(kind=kind_phys) aa1(im), tkemean(im),clamt(im), - & ps(im), del(ix,km), prsl(ix,km), + & ps(im), del(im,km), prsl(im,km), & umean(im), tauadv(im), gdx(im), & delhbar(im), delq(im), delq2(im), & delqbar(im), delqev(im), deltbar(im), @@ -2476,7 +2476,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & !> - Transport aerosols if present if (do_aerosols) - & call samfdeepcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, + & call samfdeepcnv_aerosols(im, im, km, itc, ntc, ntr, delt, & xlamde, xlamdd, cnvflg, jmin, kb, kmax, kbcon, ktcon, fscav, & edto, xlamd, xmb, c0t, eta, etad, zi, xlamue, xlamud, delp, & qtr, qaero) diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index 215026eb2..6f7ec3166 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -19,14 +19,6 @@ 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 = vertical layer dimension diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index ed80a2f54..36dab1c9a 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -49,7 +49,7 @@ end subroutine samfshalcnv_finalize !! -# 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 det_samfshalcnv GFS samfshalcnv Detailed Algorithm !! @{ - subroutine samfshalcnv_run(im,ix,km,itc,ntc,cliq,cp,cvap, & + subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp, & & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav, & @@ -62,23 +62,23 @@ subroutine samfshalcnv_run(im,ix,km,itc,ntc,cliq,cp,cvap, & implicit none ! - integer, intent(in) :: im, ix, km, itc, ntc, ntk, ntr, ncloud + integer, intent(in) :: im, km, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(im) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, & & eps, epsm1, fv, grav, hvap, rd, rv, t0c real(kind=kind_phys), intent(in) :: delt - real(kind=kind_phys), intent(in) :: psp(im), delp(ix,km), & - & prslp(ix,km), garea(im), hpbl(im), dot(ix,km), phil(ix,km) + real(kind=kind_phys), intent(in) :: psp(im), delp(im,km), & + & prslp(im,km), garea(im), hpbl(im), dot(im,km), phil(im,km) ! real(kind=kind_phys), dimension(:), intent(in) :: fscav integer, intent(inout) :: kcnv(im) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH - real(kind=kind_phys), intent(inout) :: qtr(ix,km,ntr+2), & - & q1(ix,km), t1(ix,km), u1(ix,km), v1(ix,km) + real(kind=kind_phys), intent(inout) :: qtr(im,km,ntr+2), & + & q1(im,km), t1(im,km), u1(im,km), v1(im,km) ! integer, intent(out) :: kbot(im), ktop(im) real(kind=kind_phys), intent(out) :: rn(im), & - & cnvw(ix,km), cnvc(ix,km), ud_mf(im,km), dt_mf(im,km) + & cnvw(im,km), cnvc(im,km), ud_mf(im,km), dt_mf(im,km) ! real(kind=kind_phys), intent(in) :: clam, c0s, c1, & & asolfac, pgcon @@ -119,7 +119,7 @@ subroutine samfshalcnv_run(im,ix,km,itc,ntc,cliq,cp,cvap, & ! real(kind=kind_phys) aa1(im), cina(im), & tkemean(im), clamt(im), - & ps(im), del(ix,km), prsl(ix,km), + & ps(im), del(im,km), prsl(im,km), & umean(im), tauadv(im), gdx(im), & delhbar(im), delq(im), delq2(im), & delqbar(im), delqev(im), deltbar(im), @@ -1504,7 +1504,7 @@ subroutine samfshalcnv_run(im,ix,km,itc,ntc,cliq,cp,cvap, & !> - Transport aerosols if present ! if (do_aerosols) - & call samfshalcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, + & call samfshalcnv_aerosols(im, im, km, itc, ntc, ntr, delt, ! & xlamde, xlamdd, cnvflg, jmin, kb, kmax, kbcon, ktcon, fscav, & cnvflg, kb, kmax, kbcon, ktcon, fscav, ! & edto, xlamd, xmb, c0t, eta, etad, zi, xlamue, xlamud, delp, diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index 5189afd95..156cda581 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -19,14 +19,6 @@ 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 = vertical layer dimension diff --git a/physics/sascnvn.F b/physics/sascnvn.F index 79c1bdc36..ac59b9c5c 100644 --- a/physics/sascnvn.F +++ b/physics/sascnvn.F @@ -55,8 +55,7 @@ end subroutine sascnvn_finalize !! !! 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] im horizontal dimension !! \param[in] km vertical layer dimension !! \param[in] jcap number of spectral wave trancation !! \param[in] delt physics time step in seconds @@ -99,7 +98,7 @@ end subroutine sascnvn_finalize !! @{ 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, & + & im,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, & @@ -119,7 +118,7 @@ subroutine sascnvn_run( ! 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, & + integer, intent(in) :: im, km, jcap, ncloud, & & mp_phys, mp_phys_mg integer, intent(inout) :: kbot(:), ktop(:), kcnv(:) integer, intent(in) :: islimsk(:) @@ -184,7 +183,7 @@ subroutine sascnvn_run( & 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) ps(im), del(im,km), prsl(im,km) ! real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), & delhbar(im), delq(im), delq2(im), diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta index f330dd94d..dbc10783a 100644 --- a/physics/sascnvn.meta +++ b/physics/sascnvn.meta @@ -151,14 +151,6 @@ 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 diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index f17aaa35c..f00fb3776 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -53,7 +53,7 @@ end subroutine satmedmfvdif_finalize !! (mfscu.f). !! \section detail_satmedmfvidf GFS satmedmfvdif Detailed Algorithm !> @{ - subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & + subroutine satmedmfvdif_run(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, & @@ -70,7 +70,7 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & implicit none ! !---------------------------------------------------------------------- - integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke + integer, intent(in) :: im, km, ntrac, ntcw, ntiw, ntke integer, intent(in) :: kinver(im) integer, intent(out) :: kpbl(im) ! @@ -84,19 +84,19 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & 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), & + & u1(im,km), v1(im,km), & + & t1(im,km), q1(im,km,ntrac), & + & swh(im,km), hlw(im,km), & & xmu(im), garea(im), & - & psk(ix), rbsoil(im), & + & psk(im), 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) + & prsi(im,km+1), del(im,km), & + & prsl(im,km), prslk(im,km), & + & phii(im,km+1), phil(im,km) real(kind=kind_phys), intent(out) :: & & dusfc(im), dvsfc(im), & & dtsfc(im), dqsfc(im), & @@ -807,13 +807,13 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo !> - Call mfpblt(), which is an EDMF parameterization (Siebesma et al.(2007) \cite Siebesma_2007) !! to take into account nonlocal transport by large eddies. - call mfpblt(im,ix,km,kmpbl,ntcw,ntrac1,dt2, + call mfpblt(im,im,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) !> - Call mfscu(), which is a new mass-flux parameterization for !! stratocumulus-top-induced turbulence mixing. - call mfscu(im,ix,km,kmscu,ntcw,ntrac1,dt2, + call mfscu(im,im,km,kmscu,ntcw,ntrac1,dt2, & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, & thlx,thvx,thlvx,gdx,thetae,radj, & krad,mrad,radmin,buod,xmfd, diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index b1c3fbfc4..6ff485565 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -39,14 +39,6 @@ [ccpp-arg-table] name = satmedmfvdif_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 diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index f10ed97ef..c71663dc7 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -57,7 +57,7 @@ end subroutine satmedmfvdifq_finalize !! (mfscuq.f). !! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm !! @{ - subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & + subroutine satmedmfvdifq_run(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, & @@ -74,7 +74,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & implicit none ! !---------------------------------------------------------------------- - integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke, ntoz + integer, intent(in) :: im, km, ntrac, ntcw, ntiw, ntke, ntoz integer, intent(in) :: kinver(im) integer, intent(out) :: kpbl(im) logical, intent(in) :: ldiag3d,qdiag3d @@ -86,19 +86,19 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & 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), & + & u1(im,km), v1(im,km), & + & t1(im,km), q1(im,km,ntrac), & + & swh(im,km), hlw(im,km), & & xmu(im), garea(im), & - & psk(ix), rbsoil(im), & + & psk(im), 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) + & prsi(im,km+1), del(im,km), & + & prsl(im,km), prslk(im,km), & + & phii(im,km+1), phil(im,km) real(kind=kind_phys), intent(inout), dimension(:,:) :: & & du3dt(:,:), dv3dt(:,:), & & dt3dt(:,:), dq3dt(:,:), & @@ -773,13 +773,13 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & 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, + call mfpbltq(im,im,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, + call mfscuq(im,im,km,kmscu,ntcw,ntrac1,dt2, & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, & thlx,thvx,thlvx,gdx,thetae, & krad,mrad,radmin,buod,xmfd, diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 01211b599..c0cefb632 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -39,14 +39,6 @@ [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 diff --git a/physics/shalcnv.F b/physics/shalcnv.F index 5c9e65203..2a8918985 100644 --- a/physics/shalcnv.F +++ b/physics/shalcnv.F @@ -58,8 +58,7 @@ end subroutine shalcnv_finalize !! !! 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] im horizontal dimension !! \param[in] km vertical layer dimension !! \param[in] jcap number of spectral wave trancation !! \param[in] delt physics time step in seconds @@ -101,7 +100,7 @@ end subroutine shalcnv_finalize !! @{ 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, & + & im,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) @@ -118,7 +117,7 @@ subroutine shalcnv_run( & ! 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(in) :: im, km, jcap, ncloud integer, intent(inout) :: kbot(:), ktop(:), kcnv(:) integer, intent(in) :: islimsk(:) real(kind=kind_phys), intent(in) :: delt, clam, c0, c1, pgcon diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta index e0d806a5c..2a508cb0b 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -167,14 +167,6 @@ 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 diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index 8053934ac..83270a08d 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -25,7 +25,7 @@ end subroutine shinhongvdif_finalize !! \htmlinclude shinhongvdif_run.html !! !------------------------------------------------------------------------------- - subroutine shinhongvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & + subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & utnp,vtnp,ttnp,qtnp,ntrac,ndiff,ntcw,ntiw, & phii,phil,psfcpa, & zorl,stress,hpbl,psim,psih, & @@ -104,20 +104,20 @@ subroutine shinhongvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & real(kind=kind_phys),parameter :: cpent = -0.4,rigsmax = 100. real(kind=kind_phys),parameter :: entfmin = 1.0, entfmax = 5.0 ! 1D in - integer, intent(in ) :: ix,im,km,ntrac,ndiff,ntcw,ntiw + integer, intent(in ) :: im,km,ntrac,ndiff,ntcw,ntiw real(kind=kind_phys), intent(in ) :: g,cp,rd,rv,ep1,ep2,xlv,dt ! 3D in - real(kind=kind_phys), dimension(ix, km) , & + real(kind=kind_phys), dimension(im, km) , & intent(in ) :: phil, & pi2d, & p2d, & ux, & vx, & tx - real(kind=kind_phys), dimension( ix, km, ntrac ) , & + real(kind=kind_phys), dimension( im, km, ntrac ) , & intent(in ) :: qx - real(kind=kind_phys), dimension( ix, km+1 ) , & + real(kind=kind_phys), dimension( im, km+1 ) , & intent(in ) :: p2di, & phii ! 3D in&out diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 4ce047aa2..08646d7b9 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = shinhongvdif_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 diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index fff945774..51ed599f0 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -25,7 +25,7 @@ end subroutine ysuvdif_finalize !! \htmlinclude ysuvdif_run.html !! !------------------------------------------------------------------------------- - subroutine ysuvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & + subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & utnp,vtnp,ttnp,qtnp, & swh,hlw,xmu,ntrac,ndiff,ntcw,ntiw, & phii,phil,psfcpa, & @@ -59,16 +59,16 @@ subroutine ysuvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & ! !------------------------------------------------------------------------------------- ! input variables - integer, intent(in ) :: ix,im,km,ntrac,ndiff,ntcw,ntiw + integer, intent(in ) :: im,km,ntrac,ndiff,ntcw,ntiw real(kind=kind_phys), intent(in ) :: g,cp,rd,rv,ep1,ep2,xlv,dt - real(kind=kind_phys), dimension( ix,km ), & + real(kind=kind_phys), dimension( im,km ), & intent(in) :: pi2d,p2d,phil,ux,vx,swh,hlw,tx - real(kind=kind_phys), dimension( ix,km,ntrac ) , & + real(kind=kind_phys), dimension( im,km,ntrac ) , & intent(in ) :: qx - real(kind=kind_phys), dimension( ix, km+1 ) , & + real(kind=kind_phys), dimension( im, km+1 ) , & intent(in ) :: p2di,phii real(kind=kind_phys), dimension( im ) , & diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index fe18e6f45..c040233a7 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = ysuvdif_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 From b3c070d72e33ce6ffd2d8dd5b52f0b3e2f9a8b31 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 11:36:04 -0600 Subject: [PATCH 122/141] physics/GFS_debug.F90: bugfix for conditionally allocated variables --- physics/GFS_debug.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 0d010ed76..cfd190b26 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -348,12 +348,18 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, end if ! CCPP/MYNNPBL only if (Model%do_mynnedmf) then - call print_var(mpirank,omprank, blkno, 'Diag%edmf_a ', Diag%edmf_a) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_w ', Diag%edmf_w) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_qt ', Diag%edmf_qt) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_thl ', Diag%edmf_thl) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_ent ', Diag%edmf_ent) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_qc ', Diag%edmf_qc) + if (Model%bl_mynn_output .ne. 0) then + call print_var(mpirank,omprank, blkno, 'Diag%edmf_a ', Diag%edmf_a) + call print_var(mpirank,omprank, blkno, 'Diag%edmf_w ', Diag%edmf_w) + call print_var(mpirank,omprank, blkno, 'Diag%edmf_qt ', Diag%edmf_qt) + call print_var(mpirank,omprank, blkno, 'Diag%edmf_thl ', Diag%edmf_thl) + call print_var(mpirank,omprank, blkno, 'Diag%edmf_ent ', Diag%edmf_ent) + call print_var(mpirank,omprank, blkno, 'Diag%edmf_qc ', Diag%edmf_qc) + call print_var(mpirank,omprank, blkno, 'Diag%sub_thl ', Diag%sub_thl) + call print_var(mpirank,omprank, blkno, 'Diag%sub_sqv ', Diag%sub_sqv) + call print_var(mpirank,omprank, blkno, 'Diag%det_thl ', Diag%det_thl) + call print_var(mpirank,omprank, blkno, 'Diag%det_sqv ', Diag%det_sqv) + end if call print_var(mpirank,omprank, blkno, 'Diag%nupdraft ', Diag%nupdraft) call print_var(mpirank,omprank, blkno, 'Diag%maxMF ', Diag%maxMF) call print_var(mpirank,omprank, blkno, 'Diag%ktop_plume ', Diag%ktop_plume) From fca0786f3834f8f6993f470b01ea3bd644a6efa0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 11:36:28 -0600 Subject: [PATCH 123/141] physics/GFS_phys_time_vary.fv3.meta: bugfix, use correct dimensions in metadata --- physics/GFS_phys_time_vary.fv3.meta | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index ac2ccbf3c..199cc362c 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -5,7 +5,7 @@ standard_name = GFS_data_type_instance_all_blocks long_name = Fortran DDT containing FV3-GFS data units = DDT - dimensions = (ccpp_block_number) + dimensions = (ccpp_block_count) type = GFS_data_type intent = inout optional = F @@ -21,7 +21,7 @@ standard_name = GFS_interstitial_type_instance_all_threads long_name = Fortran DDT containing FV3-GFS interstitial data units = DDT - dimensions = (ccpp_thread_number) + dimensions = (omp_threads) type = GFS_interstitial_type intent = inout optional = F @@ -81,7 +81,7 @@ standard_name = GFS_data_type_instance_all_blocks long_name = Fortran DDT containing FV3-GFS data units = DDT - dimensions = (ccpp_block_number) + dimensions = (ccpp_block_count) type = GFS_data_type intent = inout optional = F From 2354a89824f23a8eb42fa4b1a647337530347e79 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 11:36:40 -0600 Subject: [PATCH 124/141] physics/module_bl_mynn.F90: fix compiler warning --- physics/module_bl_mynn.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 6be141d9c..edc5d4a1e 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3105,7 +3105,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=thl(k) + tcd(k)*delt + dtz(k)*(s_awthl(k)-s_awthl(k+1)) + & - & + diss_heat(k)*delt*dheat_opt + & + & diss_heat(k)*delt*dheat_opt + & & sub_thl(k)*delt + det_thl(k)*delt ENDDO From 6d6dd49eafeb687ea23b23790937a8f2e21a898e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 11:37:18 -0600 Subject: [PATCH 125/141] physics/mp_thompson.{F90,meta}: revert workaround in mp_thompson_init; remove physics/mp_thompson.meta.backup.before.workaround --- physics/mp_thompson.F90 | 567 ++++++--------- physics/mp_thompson.meta | 304 +++++--- .../mp_thompson.meta.backup.before.workaround | 676 ------------------ 3 files changed, 399 insertions(+), 1148 deletions(-) delete mode 100644 physics/mp_thompson.meta.backup.before.workaround diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index d7a08b7ef..824c4f63c 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -23,17 +23,10 @@ module mp_thompson contains -! DH* Note. The following is a nasty modification of the mp_thompson_init -! routine to account for the fact that the initialization of the physics -! must run over all blocks concurrently. In order to pass in the arguments -! as individual Fortran arrays as before, we need to remove the dynamic -! build first and add logic to detect that an array ... - !> This subroutine is a wrapper around the actual thompson_init(). !! \section arg_table_mp_thompson_init Argument Table !! \htmlinclude mp_thompson_init.html !! -#if 0 subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & imp_physics, imp_physics_thompson, & spechum, qc, qr, qi, qs, qg, ni, nr, & @@ -41,7 +34,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & nwfa, nifa, tgrs, prsl, phil, area, & re_cloud, re_ice, re_snow, & mpicomm, mpirank, mpiroot, & - threads, blkno, errmsg, errflg) + threads, errmsg, errflg) implicit none @@ -83,7 +76,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & integer, intent(in ) :: mpiroot ! Threading/blocking information integer, intent(in ) :: threads - integer, intent(in ) :: blkno ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -105,91 +97,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! real (kind=kind_phys) :: h_01, airmass, niIN3, niCCN3 integer :: i, k -#else - subroutine mp_thompson_init(Data, ntqv, ntcw, ntrw, ntiw, ntsw, ntgl, & - ntinc, ntrnc, ntlnc, ntwa, ntia, nleffr, & - nieffr, nseffr, con_g, con_rd, & - restart, imp_physics, imp_physics_thompson, & - is_aerosol_aware, mpicomm, mpirank, mpiroot,& - threads, errmsg, errflg) - - use GFS_typedefs, only : GFS_data_type - - implicit none - - ! Interface variables - type(GFS_data_type), intent(inout) :: Data(:) - integer, intent(in ) :: ntqv - integer, intent(in ) :: ntcw - integer, intent(in ) :: ntrw - integer, intent(in ) :: ntiw - integer, intent(in ) :: ntsw - integer, intent(in ) :: ntgl - integer, intent(in ) :: ntinc - integer, intent(in ) :: ntrnc - integer, intent(in ) :: ntlnc - integer, intent(in ) :: ntwa - integer, intent(in ) :: ntia - integer, intent(in ) :: nleffr - integer, intent(in ) :: nieffr - integer, intent(in ) :: nseffr - real(kind_phys), intent(in ) :: con_g, con_rd - logical, intent(in ) :: restart - integer, intent(in ) :: imp_physics - integer, intent(in ) :: imp_physics_thompson - ! Aerosols - logical, intent(in ) :: is_aerosol_aware - ! MPI information - integer, intent(in ) :: mpicomm - integer, intent(in ) :: mpirank - integer, intent(in ) :: mpiroot - ! Threading/blocking information - integer, intent(in ) :: threads - ! CCPP error handling - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - ! Local variables/pointers - - ! Hydrometeors - real(kind_phys), dimension(:,:), allocatable :: qv_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: qc_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: qr_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: qi_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: qs_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: qg_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: ni_mp !< kg-1 - real(kind_phys), dimension(:,:), allocatable :: nr_mp !< kg-1 - real(kind_phys), dimension(:,:), allocatable :: nc_mp !< kg-1 - ! - real(kind_phys), dimension(:,:), allocatable :: hgt ! m - real(kind_phys), dimension(:,:), allocatable :: rho ! kg m-3 - real(kind_phys), dimension(:,:), allocatable :: orho ! m3 kg-1 - real(kind_phys), pointer :: spechum (:,:) - real(kind_phys), pointer :: qc (:,:) - real(kind_phys), pointer :: qr (:,:) - real(kind_phys), pointer :: qi (:,:) - real(kind_phys), pointer :: qs (:,:) - real(kind_phys), pointer :: qg (:,:) - real(kind_phys), pointer :: ni (:,:) - real(kind_phys), pointer :: nr (:,:) - real(kind_phys), pointer :: nc (:,:) - real(kind_phys), pointer :: nwfa (:,:) - real(kind_phys), pointer :: nifa (:,:) - real(kind_phys), pointer :: nwfa2d (:) - real(kind_phys), pointer :: nifa2d (:) - real(kind_phys), pointer :: tgrs (:,:) - real(kind_phys), pointer :: prsl (:,:) - real(kind_phys), pointer :: phil (:,:) - real(kind_phys), pointer :: area (:) - real(kind_phys), pointer :: re_cloud (:,:) - real(kind_phys), pointer :: re_ice (:,:) - real(kind_phys), pointer :: re_snow (:,:) - - ! - real (kind=kind_phys) :: h_01, airmass, niIN3, niCCN3 - integer :: i, k, blkno, nblocks, ncol, nlev -#endif ! Initialize the CCPP error handling variables errmsg = '' @@ -212,298 +119,238 @@ subroutine mp_thompson_init(Data, ntqv, ntcw, ntrw, ntiw, ntsw, ntgl, & return end if - nblocks = size(Data) - block_loop: do blkno=1,nblocks - - spechum => Data(blkno)%Statein%qgrs(:,:,ntqv) - qc => Data(blkno)%Statein%qgrs(:,:,ntcw) - qr => Data(blkno)%Statein%qgrs(:,:,ntrw) - qi => Data(blkno)%Statein%qgrs(:,:,ntiw) - qs => Data(blkno)%Statein%qgrs(:,:,ntsw) - qg => Data(blkno)%Statein%qgrs(:,:,ntgl) - ni => Data(blkno)%Statein%qgrs(:,:,ntinc) - nr => Data(blkno)%Statein%qgrs(:,:,ntrnc) - if (is_aerosol_aware) then - nc => Data(blkno)%Statein%qgrs(:,:,ntlnc) - nwfa => Data(blkno)%Statein%qgrs(:,:,ntwa) - nifa => Data(blkno)%Statein%qgrs(:,:,ntia) - nwfa2d => Data(blkno)%Coupling%nwfa2d - nifa2d => Data(blkno)%Coupling%nifa2d - end if - tgrs => Data(blkno)%Statein%tgrs - prsl => Data(blkno)%Statein%prsl - phil => Data(blkno)%Statein%phil - area => Data(blkno)%Grid%area - re_cloud => Data(blkno)%Tbd%phy_f3d(:,:,nleffr) - re_ice => Data(blkno)%Tbd%phy_f3d(:,:,nieffr) - re_snow => Data(blkno)%Tbd%phy_f3d(:,:,nseffr) - - ncol = size(spechum(:,1)) - nlev = size(spechum(1,:)) - allocate(qv_mp(ncol,nlev)) - allocate(qc_mp(ncol,nlev)) - allocate(qr_mp(ncol,nlev)) - allocate(qi_mp(ncol,nlev)) - allocate(qs_mp(ncol,nlev)) - allocate(qg_mp(ncol,nlev)) - allocate(ni_mp(ncol,nlev)) - allocate(nr_mp(ncol,nlev)) - if (is_aerosol_aware) allocate(nc_mp(ncol,nlev)) - allocate(hgt (ncol,nlev)) - allocate(rho (ncol,nlev)) - allocate(orho (ncol,nlev)) - - only_for_first_block: if (blkno==1) then - - ! Call Thompson init - if (is_aerosol_aware) then - call thompson_init(nwfa2d=nwfa2d, nifa2d=nifa2d, nwfa=nwfa, nifa=nifa, & - mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & - threads=threads, errmsg=errmsg, errflg=errflg) - if (errflg /= 0) return - else - call thompson_init(mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & - threads=threads, errmsg=errmsg, errflg=errflg) - if (errflg /= 0) return - end if - - ! For restart runs, the init is done here - if (restart) then - is_initialized = .true. - return - end if - - end if only_for_first_block - - ! Fix initial values of hydrometeors - where(spechum<0) spechum = 0.0 - where(qc<0) qc = 0.0 - where(qr<0) qr = 0.0 - where(qi<0) qi = 0.0 - where(qs<0) qs = 0.0 - where(qg<0) qg = 0.0 - where(ni<0) ni = 0.0 - where(nr<0) nr = 0.0 - - if (is_aerosol_aware) then - ! Fix initial values of aerosols - where(nc<0) nc = 0.0 - where(nwfa<0) nwfa = 0.0 - where(nifa<0) nifa = 0.0 - where(nwfa2d<0) nwfa2d = 0.0 - where(nifa2d<0) nifa2d = 0.0 - end if + ! Call Thompson init + if (is_aerosol_aware) then + call thompson_init(nwfa2d=nwfa2d, nifa2d=nifa2d, nwfa=nwfa, nifa=nifa, & + mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & + threads=threads, errmsg=errmsg, errflg=errflg) + if (errflg /= 0) return + else + call thompson_init(mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & + threads=threads, errmsg=errmsg, errflg=errflg) + if (errflg /= 0) return + end if - ! Geopotential height in m2 s-2 to height in m - hgt = phil/con_g - - ! Density of air in kg m-3 and inverse density of air - rho = prsl/(con_rd*tgrs) - orho = 1.0/rho - - ! Prior to calling the functions: make_DropletNumber, make_IceNumber, make_RainNumber, - ! the incoming mixing ratios should be converted to units of mass/num per cubic meter - ! rather than per kg of air. So, to pass back to the model state variables, - ! they also need to be switched back to mass/number per kg of air, because - ! what is returned by the functions is in units of number per cubic meter. - ! They also need to be converted to dry mixing ratios. - - !> - Convert specific humidity/moist mixing ratios to dry mixing ratios - qv_mp = spechum/(1.0_kind_phys-spechum) - qc_mp = qc/(1.0_kind_phys-spechum) - qr_mp = qr/(1.0_kind_phys-spechum) - qi_mp = qi/(1.0_kind_phys-spechum) - qs_mp = qs/(1.0_kind_phys-spechum) - qg_mp = qg/(1.0_kind_phys-spechum) - - !> - Convert number concentrations from moist to dry - ni_mp = ni/(1.0_kind_phys-spechum) - nr_mp = nr/(1.0_kind_phys-spechum) - if (is_aerosol_aware) then - nc_mp = nc/(1.0_kind_phys-spechum) - end if + ! For restart runs, the init is done here + if (restart) then + is_initialized = .true. + return + end if - ! If qi is in boundary conditions but ni is not, calculate ni from qi, rho and tgrs - if (maxval(qi_mp)>0.0 .and. maxval(ni_mp)==0.0) then - ni_mp = make_IceNumber(qi_mp*rho, tgrs) * orho - end if + ! Fix initial values of hydrometeors + where(spechum<0) spechum = 0.0 + where(qc<0) qc = 0.0 + where(qr<0) qr = 0.0 + where(qi<0) qi = 0.0 + where(qs<0) qs = 0.0 + where(qg<0) qg = 0.0 + where(ni<0) ni = 0.0 + where(nr<0) nr = 0.0 - ! If ni is in boundary conditions but qi is not, reset ni to zero - if (maxval(ni_mp)>0.0 .and. maxval(qi_mp)==0.0) ni_mp = 0.0 + if (is_aerosol_aware) then + ! Fix initial values of aerosols + where(nc<0) nc = 0.0 + where(nwfa<0) nwfa = 0.0 + where(nifa<0) nifa = 0.0 + where(nwfa2d<0) nwfa2d = 0.0 + where(nifa2d<0) nifa2d = 0.0 + end if - ! If qr is in boundary conditions but nr is not, calculate nr from qr, rho and tgrs - if (maxval(qr_mp)>0.0 .and. maxval(nr_mp)==0.0) then - nr_mp = make_RainNumber(qr_mp*rho, tgrs) * orho - end if + ! Geopotential height in m2 s-2 to height in m + hgt = phil/con_g - ! If nr is in boundary conditions but qr is not, reset nr to zero - if (maxval(nr_mp)>0.0 .and. maxval(qr_mp)==0.0) nr_mp = 0.0 + ! Density of air in kg m-3 and inverse density of air + rho = prsl/(con_rd*tgrs) + orho = 1.0/rho - !..Check for existing aerosol data, both CCN and IN aerosols. If missing - !.. fill in just a basic vertical profile, somewhat boundary-layer following. - if (is_aerosol_aware) then + ! Prior to calling the functions: make_DropletNumber, make_IceNumber, make_RainNumber, + ! the incoming mixing ratios should be converted to units of mass/num per cubic meter + ! rather than per kg of air. So, to pass back to the model state variables, + ! they also need to be switched back to mass/number per kg of air, because + ! what is returned by the functions is in units of number per cubic meter. + ! They also need to be converted to dry mixing ratios. - ! CCN - if (MAXVAL(nwfa) .lt. eps) then - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently there are no initial CCN aerosols.' - do i = 1, ncol - if (hgt(i,1).le.1000.0) then - h_01 = 0.8 - elseif (hgt(i,1).ge.2500.0) then - h_01 = 0.01 - else - h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) - endif - niCCN3 = -1.0*ALOG(naCCN1/naCCN0)/h_01 - nwfa(i,1) = naCCN1+naCCN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niCCN3) - airmass = 1./orho(i,1) * (hgt(i,2)-hgt(i,1))*area(i) ! kg - nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*2.E-10) - do k = 2, nlev - nwfa(i,k) = naCCN1+naCCN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niCCN3) - enddo + !> - Convert specific humidity/moist mixing ratios to dry mixing ratios + qv_mp = spechum/(1.0_kind_phys-spechum) + qc_mp = qc/(1.0_kind_phys-spechum) + qr_mp = qr/(1.0_kind_phys-spechum) + qi_mp = qi/(1.0_kind_phys-spechum) + qs_mp = qs/(1.0_kind_phys-spechum) + qg_mp = qg/(1.0_kind_phys-spechum) + + !> - Convert number concentrations from moist to dry + ni_mp = ni/(1.0_kind_phys-spechum) + nr_mp = nr/(1.0_kind_phys-spechum) + if (is_aerosol_aware) then + nc_mp = nc/(1.0_kind_phys-spechum) + end if + + ! If qi is in boundary conditions but ni is not, calculate ni from qi, rho and tgrs + if (maxval(qi_mp)>0.0 .and. maxval(ni_mp)==0.0) then + ni_mp = make_IceNumber(qi_mp*rho, tgrs) * orho + end if + + ! If ni is in boundary conditions but qi is not, reset ni to zero + if (maxval(ni_mp)>0.0 .and. maxval(qi_mp)==0.0) ni_mp = 0.0 + + ! If qr is in boundary conditions but nr is not, calculate nr from qr, rho and tgrs + if (maxval(qr_mp)>0.0 .and. maxval(nr_mp)==0.0) then + nr_mp = make_RainNumber(qr_mp*rho, tgrs) * orho + end if + + ! If nr is in boundary conditions but qr is not, reset nr to zero + if (maxval(nr_mp)>0.0 .and. maxval(qr_mp)==0.0) nr_mp = 0.0 + + !..Check for existing aerosol data, both CCN and IN aerosols. If missing + !.. fill in just a basic vertical profile, somewhat boundary-layer following. + if (is_aerosol_aware) then + + ! CCN + if (MAXVAL(nwfa) .lt. eps) then + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosols.' + do i = 1, ncol + if (hgt(i,1).le.1000.0) then + h_01 = 0.8 + elseif (hgt(i,1).ge.2500.0) then + h_01 = 0.01 + else + h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) + endif + niCCN3 = -1.0*ALOG(naCCN1/naCCN0)/h_01 + nwfa(i,1) = naCCN1+naCCN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niCCN3) + airmass = 1./orho(i,1) * (hgt(i,2)-hgt(i,1))*area(i) ! kg + nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*2.E-10) + do k = 2, nlev + nwfa(i,k) = naCCN1+naCCN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niCCN3) enddo - else - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial CCN aerosols are present.' - if (MAXVAL(nwfa2d) .lt. eps) then + enddo + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosols are present.' + if (MAXVAL(nwfa2d) .lt. eps) then ! Hard-coded switch between new (from WRFv4.0, top) and old (until WRFv3.9.1.1, bottom) surface emission rate calculations #if 0 - !+---+-----------------------------------------------------------------+ - !..Scale the lowest level aerosol data into an emissions rate. This is - !.. very far from ideal, but need higher emissions where larger amount - !.. of (climo) existing and lesser emissions where there exists fewer to - !.. begin as a first-order simplistic approach. Later, proper connection to - !.. emission inventory would be better, but, for now, scale like this: - !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per second per grid box unit - !.. that was tested as ~(20kmx20kmx50m = 2.E10 m**-3) - !+---+-----------------------------------------------------------------+ - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Use new (WRFv4+) formula to calculate CCN surface emission rates.' - do i = 1, ncol - airmass = 1./orho(i,1) * (hgt(i,2)-hgt(i,1))*area(i) ! kg - nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*2.E-10) - enddo + !+---+-----------------------------------------------------------------+ + !..Scale the lowest level aerosol data into an emissions rate. This is + !.. very far from ideal, but need higher emissions where larger amount + !.. of (climo) existing and lesser emissions where there exists fewer to + !.. begin as a first-order simplistic approach. Later, proper connection to + !.. emission inventory would be better, but, for now, scale like this: + !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per second per grid box unit + !.. that was tested as ~(20kmx20kmx50m = 2.E10 m**-3) + !+---+-----------------------------------------------------------------+ + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' + if (mpirank==mpiroot) write(*,*) ' Use new (WRFv4+) formula to calculate CCN surface emission rates.' + do i = 1, ncol + airmass = 1./orho(i,1) * (hgt(i,2)-hgt(i,1))*area(i) ! kg + nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*2.E-10) + enddo #else - !+---+-----------------------------------------------------------------+ - !..Scale the lowest level aerosol data into an emissions rate. This is - !.. very far from ideal, but need higher emissions where larger amount - !.. of existing and lesser emissions where not already lots of aerosols - !.. for first-order simplistic approach. Later, proper connection to - !.. emission inventory would be better, but, for now, scale like this: - !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per kg per second - !.. Nwfa=500 per cc, emit 0.875E5 aerosols per kg per second - !.. Nwfa=5000 per cc, emit 0.875E6 aerosols per kg per second - !.. for a grid with 20km spacing and scale accordingly for other spacings. - !+---+-----------------------------------------------------------------+ - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Use old (pre WRFv4) formula to calculate CCN surface emission rates.' - do i = 1, ncol - if (SQRT(area(i))/20000.0 .ge. 1.0) then - h_01 = 0.875 - else - h_01 = (0.875 + 0.125*((20000.-SQRT(area(i)))/16000.)) * SQRT(area(i))/20000. - endif - nwfa2d(i) = 10.0**(LOG10(nwfa(i,1)*1.E-6)-3.69897) - nwfa2d(i) = nwfa2d(i)*h_01 * 1.E6 - enddo -#endif - else - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial CCN aerosol surface emission rates are present.' - endif - endif - - ! IN - if (MAXVAL(nifa) .lt. eps) then - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently there are no initial IN aerosols.' + !+---+-----------------------------------------------------------------+ + !..Scale the lowest level aerosol data into an emissions rate. This is + !.. very far from ideal, but need higher emissions where larger amount + !.. of existing and lesser emissions where not already lots of aerosols + !.. for first-order simplistic approach. Later, proper connection to + !.. emission inventory would be better, but, for now, scale like this: + !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per kg per second + !.. Nwfa=500 per cc, emit 0.875E5 aerosols per kg per second + !.. Nwfa=5000 per cc, emit 0.875E6 aerosols per kg per second + !.. for a grid with 20km spacing and scale accordingly for other spacings. + !+---+-----------------------------------------------------------------+ + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' + if (mpirank==mpiroot) write(*,*) ' Use old (pre WRFv4) formula to calculate CCN surface emission rates.' do i = 1, ncol - if (hgt(i,1).le.1000.0) then - h_01 = 0.8 - elseif (hgt(i,1).ge.2500.0) then - h_01 = 0.01 - else - h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) - endif - niIN3 = -1.0*ALOG(naIN1/naIN0)/h_01 - nifa(i,1) = naIN1+naIN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niIN3) - nifa2d(i) = 0. - do k = 2, nlev - nifa(i,k) = naIN1+naIN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niIN3) - enddo + if (SQRT(area(i))/20000.0 .ge. 1.0) then + h_01 = 0.875 + else + h_01 = (0.875 + 0.125*((20000.-SQRT(area(i)))/16000.)) * SQRT(area(i))/20000. + endif + nwfa2d(i) = 10.0**(LOG10(nwfa(i,1)*1.E-6)-3.69897) + nwfa2d(i) = nwfa2d(i)*h_01 * 1.E6 enddo +#endif else - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial IN aerosols are present.' - if (MAXVAL(nifa2d) .lt. eps) then - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently there are no initial IN aerosol surface emission rates, set to zero.' - ! calculate IN surface flux here, right now just set to zero - nifa2d = 0. + if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosol surface emission rates are present.' + endif + endif + + ! IN + if (MAXVAL(nifa) .lt. eps) then + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial IN aerosols.' + do i = 1, ncol + if (hgt(i,1).le.1000.0) then + h_01 = 0.8 + elseif (hgt(i,1).ge.2500.0) then + h_01 = 0.01 else - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial IN aerosol surface emission rates are present.' + h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) endif + niIN3 = -1.0*ALOG(naIN1/naIN0)/h_01 + nifa(i,1) = naIN1+naIN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niIN3) + nifa2d(i) = 0. + do k = 2, nlev + nifa(i,k) = naIN1+naIN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niIN3) + enddo + enddo + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial IN aerosols are present.' + if (MAXVAL(nifa2d) .lt. eps) then + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial IN aerosol surface emission rates, set to zero.' + ! calculate IN surface flux here, right now just set to zero + nifa2d = 0. + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial IN aerosol surface emission rates are present.' endif + endif - ! If qc is in boundary conditions but nc is not, calculate nc from qc, rho and nwfa - if (maxval(qc_mp)>0.0 .and. maxval(nc_mp)==0.0) then - nc_mp = make_DropletNumber(qc_mp*rho, nwfa) * orho - end if + ! If qc is in boundary conditions but nc is not, calculate nc from qc, rho and nwfa + if (maxval(qc_mp)>0.0 .and. maxval(nc_mp)==0.0) then + nc_mp = make_DropletNumber(qc_mp*rho, nwfa) * orho + end if - ! If nc is in boundary conditions but qc is not, reset nc to zero - if (maxval(nc_mp)>0.0 .and. maxval(qc_mp)==0.0) nc_mp = 0.0 + ! If nc is in boundary conditions but qc is not, reset nc to zero + if (maxval(nc_mp)>0.0 .and. maxval(qc_mp)==0.0) nc_mp = 0.0 - else + else - ! Constant droplet concentration for single moment cloud water as in - ! module_mp_thompson.F90, only needed for effective radii calculation - nc_mp = Nt_c/rho + ! Constant droplet concentration for single moment cloud water as in + ! module_mp_thompson.F90, only needed for effective radii calculation + nc_mp = Nt_c/rho - end if + end if - ! Calculate initial cloud effective radii if requested - do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = 2.49E-6 - re_ice(i,k) = 4.99E-6 - re_snow(i,k) = 9.99E-6 - end do + ! Calculate initial cloud effective radii if requested + do i = 1, ncol + do k = 1, nlev + re_cloud(i,k) = 2.49E-6 + re_ice(i,k) = 4.99E-6 + re_snow(i,k) = 9.99E-6 end do - do i = 1, ncol - call calc_effectRad (tgrs(i,:), prsl(i,:), qv_mp(i,:), qc_mp(i,:), & - nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & - re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, nlev) + end do + do i = 1, ncol + call calc_effectRad (tgrs(i,:), prsl(i,:), qv_mp(i,:), qc_mp(i,:), & + nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & + re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, nlev) + end do + do i = 1, ncol + do k = 1, nlev + re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) + re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) + re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) end do - do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) - re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) - re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) - end do - end do - ! Convert to micron: required for bit-for-bit identical restarts; - ! otherwise entering mp_thompson_init and converting mu to m and - ! back (without updating re_*) introduces b4b differences. - re_cloud = 1.0E6*re_cloud - re_ice = 1.0E6*re_ice - re_snow = 1.0E6*re_snow - - !> - Convert number concentrations from dry to moist - ni = ni_mp/(1.0_kind_phys+qv_mp) - nr = nr_mp/(1.0_kind_phys+qv_mp) - if (is_aerosol_aware) then - nc = nc_mp/(1.0_kind_phys+qv_mp) - end if + end do + ! Convert to micron: required for bit-for-bit identical restarts; + ! otherwise entering mp_thompson_init and converting mu to m and + ! back (without updating re_*) introduces b4b differences. + re_cloud = 1.0E6*re_cloud + re_ice = 1.0E6*re_ice + re_snow = 1.0E6*re_snow - deallocate(qv_mp) - deallocate(qc_mp) - deallocate(qr_mp) - deallocate(qi_mp) - deallocate(qs_mp) - deallocate(qg_mp) - deallocate(ni_mp) - deallocate(nr_mp) - if (is_aerosol_aware) deallocate(nc_mp) - deallocate(hgt ) - deallocate(rho ) - deallocate(orho ) - - end do block_loop + !> - Convert number concentrations from dry to moist + ni = ni_mp/(1.0_kind_phys+qv_mp) + nr = nr_mp/(1.0_kind_phys+qv_mp) + if (is_aerosol_aware) then + nc = nc_mp/(1.0_kind_phys+qv_mp) + end if is_initialized = .true. diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index cbaf8b801..9b26bdc23 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -1,122 +1,18 @@ [ccpp-arg-table] name = mp_thompson_init type = scheme -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type - units = DDT - dimensions = (ccpp_block_number) - type = GFS_data_type - intent = inout - optional = F -[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 -[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 -[ntrw] - standard_name = index_for_rain_water - long_name = tracer index for rain 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 -[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 -[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 -[ntrnc] - standard_name = index_for_rain_number_concentration - long_name = tracer index for rain 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 -[ntwa] - standard_name = index_for_water_friendly_aerosols - long_name = tracer index for water friendly aerosol - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntia] - standard_name = index_for_ice_friendly_aerosols - long_name = tracer index for ice friendly aerosol - units = index - dimensions = () - type = integer - intent = in - optional = F -[nleffr] - standard_name = index_for_cloud_liquid_water_effective_radius - long_name = the index of cloud liquid water effective radius in phy_f3d - units = - dimensions = () - type = integer - intent = in - optional = F -[nieffr] - standard_name = index_for_ice_effective_radius - long_name = the index of ice effective radius in phy_f3d - units = +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () type = integer intent = in optional = F -[nseffr] - standard_name = index_for_snow_effective_radius - long_name = the index of snow effective radius in phy_f3d - units = +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () type = integer intent = in @@ -163,6 +59,78 @@ type = integer intent = in optional = F +[spechum] + 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 = inout + optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio + long_name = cloud water mixing ratio wrt dry+vapor (no condensates) + 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 + long_name = rain water mixing ratio wrt dry+vapor (no condensates) + 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 + long_name = ice water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qs] + standard_name = snow_water_mixing_ratio + long_name = snow water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qg] + standard_name = graupel_mixing_ratio + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ni] + standard_name = ice_number_concentration + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nr] + standard_name = rain_number_concentration + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [is_aerosol_aware] standard_name = flag_for_aerosol_physics long_name = flag for aerosol-aware physics @@ -171,6 +139,116 @@ type = logical intent = in optional = F +[nc] + standard_name = cloud_droplet_number_concentration + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[nwfa2d] + standard_name = tendency_of_water_friendly_aerosols_at_surface + long_name = instantaneous fake water-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) + optional = T +[nifa2d] + standard_name = tendency_of_ice_friendly_aerosols_at_surface + long_name = instantaneous fake ice-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) + optional = T +[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 = inout + optional = T +[nifa] + standard_name = ice_friendly_aerosol_number_concentration + long_name = number concentration of ice-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + 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 +[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 +[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 +[re_cloud] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[re_ice] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[re_snow] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T [mpicomm] standard_name = mpi_comm long_name = MPI communicator @@ -374,6 +452,7 @@ type = real kind = kind_phys intent = in + active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [nifa2d] standard_name = tendency_of_ice_friendly_aerosols_at_surface @@ -383,6 +462,7 @@ type = real kind = kind_phys intent = in + active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [tgrs] standard_name = air_temperature_updated_by_physics diff --git a/physics/mp_thompson.meta.backup.before.workaround b/physics/mp_thompson.meta.backup.before.workaround deleted file mode 100644 index 0419a6c15..000000000 --- a/physics/mp_thompson.meta.backup.before.workaround +++ /dev/null @@ -1,676 +0,0 @@ -[ccpp-arg-table] - name = mp_thompson_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 = number of vertical levels - units = count - dimensions = () - type = integer - 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_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 -[restart] - standard_name = flag_for_restart - long_name = flag for restart (warmstart) or coldstart - 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_thompson] - standard_name = flag_for_thompson_microphysics_scheme - long_name = choice of Thompson microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[spechum] - 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 = inout - optional = F -[qc] - standard_name = cloud_condensed_water_mixing_ratio - long_name = cloud water mixing ratio wrt dry+vapor (no condensates) - 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 - long_name = rain water mixing ratio wrt dry+vapor (no condensates) - 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 - long_name = ice water mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qs] - standard_name = snow_water_mixing_ratio - long_name = snow water mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qg] - standard_name = graupel_mixing_ratio - long_name = graupel mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ni] - standard_name = ice_number_concentration - long_name = ice number concentration - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[nr] - standard_name = rain_number_concentration - long_name = rain number concentration - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[is_aerosol_aware] - standard_name = flag_for_aerosol_physics - long_name = flag for aerosol-aware physics - units = flag - dimensions = () - type = logical - intent = in - optional = F -[nc] - standard_name = cloud_droplet_number_concentration - long_name = cloud droplet number concentration - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[nwfa2d] - standard_name = tendency_of_water_friendly_aerosols_at_surface - long_name = instantaneous fake water-friendly surface aerosol source - units = kg-1 s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[nifa2d] - standard_name = tendency_of_ice_friendly_aerosols_at_surface - long_name = instantaneous fake ice-friendly surface aerosol source - units = kg-1 s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[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 = inout - optional = T -[nifa] - standard_name = ice_friendly_aerosol_number_concentration - long_name = number concentration of ice-friendly aerosols - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K - 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 -[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 -[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 -[re_cloud] - standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um - long_name = eff. radius of cloud liquid water particle in micrometer - units = um - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[re_ice] - standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um - long_name = eff. radius of cloud ice water particle in micrometer - units = um - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[re_snow] - standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um - long_name = effective radius of cloud snow particle in micrometer - units = um - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - 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 -[blkno] - standard_name = ccpp_block_number - long_name = for explicit data blocking: block number of this block - 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 = mp_thompson_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 = number of vertical levels - units = count - dimensions = () - type = integer - 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_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 -[spechum] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qc] - standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = cloud water mixing ratio wrt dry+vapor (no condensates) - 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 = rain water mixing ratio wrt dry+vapor (no condensates) - 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 = ice water mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qs] - standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = snow water mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qg] - standard_name = graupel_mixing_ratio_updated_by_physics - long_name = graupel mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ni] - standard_name = ice_number_concentration_updated_by_physics - long_name = ice number concentration - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[nr] - standard_name = rain_number_concentration_updated_by_physics - long_name = rain number concentration - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[is_aerosol_aware] - standard_name = flag_for_aerosol_physics - long_name = flag for aerosol-aware physics - units = flag - dimensions = () - type = logical - intent = in - optional = F -[nc] - standard_name = cloud_droplet_number_concentration_updated_by_physics - long_name = cloud droplet number concentration - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[nwfa] - standard_name = water_friendly_aerosol_number_concentration_updated_by_physics - long_name = number concentration of water-friendly aerosols - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[nifa] - standard_name = ice_friendly_aerosol_number_concentration_updated_by_physics - long_name = number concentration of ice-friendly aerosols - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[nwfa2d] - standard_name = tendency_of_water_friendly_aerosols_at_surface - long_name = instantaneous fake water-friendly surface aerosol source - units = kg-1 s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = T -[nifa2d] - standard_name = tendency_of_ice_friendly_aerosols_at_surface - long_name = instantaneous fake ice-friendly surface aerosol source - units = kg-1 s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = T -[tgrs] - standard_name = air_temperature_updated_by_physics - long_name = model layer mean temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - 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 -[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 -[omega] - 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 -[dtp] - standard_name = time_step_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[prcp] - 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 -[rain] - standard_name = lwe_thickness_of_explicit_rain_amount - long_name = explicit rain fall on physics timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[graupel] - standard_name = lwe_thickness_of_graupel_amount - long_name = graupel fall on physics timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ice] - standard_name = lwe_thickness_of_ice_amount - long_name = ice fall on physics timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[snow] - standard_name = lwe_thickness_of_snow_amount - long_name = snow fall on physics timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[sr] - standard_name = ratio_of_snowfall_to_rainfall - long_name = ratio of snowfall to large-scale rainfall - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - 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 = out - optional = F -[do_radar_ref] - standard_name = flag_for_radar_reflectivity - long_name = flag for radar reflectivity - units = flag - dimensions = () - type = logical - intent = in - optional = F -[re_cloud] - standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um - long_name = eff. radius of cloud liquid water particle in micrometer (meter here) - units = m - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = T -[re_ice] - standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um - long_name = eff. radius of cloud ice water particle in micrometer (meter here) - units = m - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = T -[re_snow] - standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um - long_name = effective radius of cloud snow particle in micrometer (meter here) - units = m - 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 -[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_thompson_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 From 5e5cfb35756ed9c4a60d81ed2eda58796b994139 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 16:31:52 -0600 Subject: [PATCH 126/141] Minor bugfixes for handling conditionally allocated variables --- physics/mp_thompson.meta | 4 ---- 1 file changed, 4 deletions(-) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 9b26bdc23..81b2241e1 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -156,7 +156,6 @@ type = real kind = kind_phys intent = inout - active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [nifa2d] standard_name = tendency_of_ice_friendly_aerosols_at_surface @@ -166,7 +165,6 @@ type = real kind = kind_phys intent = inout - active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [nwfa] standard_name = water_friendly_aerosol_number_concentration @@ -452,7 +450,6 @@ type = real kind = kind_phys intent = in - active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [nifa2d] standard_name = tendency_of_ice_friendly_aerosols_at_surface @@ -462,7 +459,6 @@ type = real kind = kind_phys intent = in - active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [tgrs] standard_name = air_temperature_updated_by_physics From ecd67779749491ca6d0e0ec6f71ab5e8535f8a7f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 28 May 2020 11:11:39 -0600 Subject: [PATCH 127/141] Remove legacy code in physics/module_mp_thompson.F90 --- physics/module_mp_thompson.F90 | 6 ------ 1 file changed, 6 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index b5c8da161..b3ccb7412 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -418,14 +418,8 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & !..OPTIONAL variables that control application of aerosol-aware scheme -#if 0 - REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: nwfa, nifa - REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: nwfa2d, nifa2d -#else -! DH* 20200208 - change dimensions for nasty init hack REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: nwfa, nifa REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: nwfa2d, nifa2d -#endif INTEGER, INTENT(IN) :: mpicomm, mpirank, mpiroot INTEGER, INTENT(IN) :: threads CHARACTER(len=*), INTENT(INOUT) :: errmsg From d9816a2d2d66fc679e5b475bee11612a17582e13 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 2 Jun 2020 07:29:12 -0600 Subject: [PATCH 128/141] physics/mp_thompson.{F90,meta}: cleanup use of optional arguments for cloud effective radii --- physics/mp_thompson.F90 | 61 +++++++++++++++++++++++----------------- physics/mp_thompson.meta | 6 ++-- 2 files changed, 38 insertions(+), 29 deletions(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 824c4f63c..3f2ee144e 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -67,9 +67,9 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & real(kind_phys), intent(in ) :: phil(:,:) real(kind_phys), intent(in ) :: area(:) ! Cloud effective radii - real(kind_phys), optional, intent(inout) :: re_cloud(:,:) - real(kind_phys), optional, intent(inout) :: re_ice(:,:) - real(kind_phys), optional, intent(inout) :: re_snow(:,:) + real(kind_phys), optional, intent( out) :: re_cloud(:,:) + real(kind_phys), optional, intent( out) :: re_ice(:,:) + real(kind_phys), optional, intent( out) :: re_snow(:,:) ! MPI information integer, intent(in ) :: mpicomm integer, intent(in ) :: mpirank @@ -319,31 +319,40 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & end if ! Calculate initial cloud effective radii if requested - do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = 2.49E-6 - re_ice(i,k) = 4.99E-6 - re_snow(i,k) = 9.99E-6 + if (present(re_cloud) .and. present(re_ice) .and. present(re_snow)) then + do i = 1, ncol + do k = 1, nlev + re_cloud(i,k) = 2.49E-6 + re_ice(i,k) = 4.99E-6 + re_snow(i,k) = 9.99E-6 + end do + end do + do i = 1, ncol + call calc_effectRad (tgrs(i,:), prsl(i,:), qv_mp(i,:), qc_mp(i,:), & + nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & + re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, nlev) end do - end do - do i = 1, ncol - call calc_effectRad (tgrs(i,:), prsl(i,:), qv_mp(i,:), qc_mp(i,:), & - nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & - re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, nlev) - end do - do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) - re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) - re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) + do i = 1, ncol + do k = 1, nlev + re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) + re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) + re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) + end do end do - end do - ! Convert to micron: required for bit-for-bit identical restarts; - ! otherwise entering mp_thompson_init and converting mu to m and - ! back (without updating re_*) introduces b4b differences. - re_cloud = 1.0E6*re_cloud - re_ice = 1.0E6*re_ice - re_snow = 1.0E6*re_snow + !! Convert to micron: required for bit-for-bit identical restarts; + !! otherwise entering mp_thompson_init and converting mu to m and + !! back (without updating re_*) introduces b4b differences. + !! If this code is used, change units in metadata from m to um! + !re_cloud = 1.0E6*re_cloud + !re_ice = 1.0E6*re_ice + !re_snow = 1.0E6*re_snow + else if (present(re_cloud) .or. present(re_ice) .or. present(re_snow)) then + write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_init:', & + ' all or none of the following optional', & + ' arguments are required: re_cloud, re_ice, re_snow' + errflg = 1 + return + end if !> - Convert number concentrations from dry to moist ni = ni_mp/(1.0_kind_phys+qv_mp) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 81b2241e1..5bbd85732 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -223,7 +223,7 @@ [re_cloud] standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um long_name = eff. radius of cloud liquid water particle in micrometer - units = um + units = m dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -232,7 +232,7 @@ [re_ice] standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = eff. radius of cloud ice water particle in micrometer - units = um + units = m dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -241,7 +241,7 @@ [re_snow] standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometer - units = um + units = m dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys From a219a4750614a5457fd7b7315ea804c4adad679e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 2 Jun 2020 07:29:31 -0600 Subject: [PATCH 129/141] physics/GFS_rrtmg_pre.F90: cleanup calculation of cloud effective radii, fix bugs --- physics/GFS_rrtmg_pre.F90 | 134 ++++++++++++++++---------------------- 1 file changed, 55 insertions(+), 79 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index d2ecef895..84732e401 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -581,7 +581,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then do k=1,LMK do i=1,IM - qvs = Statein%qgrs(i,k2,1) + qvs = Statein%qgrs(i,k,1) qv_mp (i,k) = qvs/(1.-qvs) qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) @@ -594,7 +594,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input elseif (Model%imp_physics == Model%imp_physics_thompson) then do k=1,LMK do i=1,IM - qvs = Statein%qgrs(i,k2,1) + qvs = Statein%qgrs(i,k,1) qv_mp (i,k) = qvs/(1.-qvs) qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) @@ -701,76 +701,60 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo endif elseif (Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP - if(Model%kdt == 1 ) then - do k=1,lm - k1 = k + kd - do i=1,im - effrl(i,k1) = Tbd%phy_f3d(i,k,Model%nleffr) - effri(i,k1) = Tbd%phy_f3d(i,k,Model%nieffr) - effrr(i,k1) = 1000. ! rrain_def=1000. - effrs(i,k1) = Tbd%phy_f3d(i,k,Model%nseffr) - enddo + ! + ! Compute effective radii for QC, QI, QS with (GF, MYNN) or without (all others) sub-grid clouds + ! + ! Update number concentration, consistent with sub-grid clouds (GF, MYNN) or without (all others) + do k=1,lm + do i=1,im + if (Model%ltaerosol .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then + nc_mp(i,k) = make_DropletNumber(qc_mp(i,k)*rho(i,k), nwfa(i,k)) * orho(i,k) + endif + if (qi_mp(i,k)>1.e-12 .and. ni_mp(i,k)<100.) then + ni_mp(i,k) = make_IceNumber(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k) + endif + end do + end do + ! Call Thompson's subroutine to compute effective radii + do i=1,im + ! Initialize to default in units m as in module_mp_thompson.F90 + re_cloud(i,:) = 2.49E-6 + re_ice(i,:) = 4.99E-6 + re_snow(i,:) = 9.99E-6 + call calc_effectRad (tlyr(i,:), plyr(i,:), qv_mp(i,:), qc_mp(i,:), & + nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & + re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, lm ) + end do + ! Scale Thompson's effective radii from meter to micron and apply bounds + do k=1,lm + do i=1,im + re_cloud(i,k) = MAX(2.49, MIN(re_cloud(i,k)*1.e6, 50.)) + re_ice(i,k) = MAX(4.99, MIN(re_ice(i,k)*1.e6, 125.)) + !tgs: clduni has different limits for ice radii: 10.0-150.0 + ! it will raise the low limit from 5 to 10, but the + ! high limit will remain 125. + re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) + end do + end do + do k=1,lm + k1 = k + kd + do i=1,im + effrl(i,k1) = re_cloud (i,k) + effri(i,k1) = re_ice (i,k) + effrr(i,k1) = 1000. ! rrain_def=1000. + effrs(i,k1) = re_snow(i,k) enddo - else ! kdt>1 - if(Model%do_mynnedmf .or. & - Model%imfdeepcnv == Model%imfdeepcnv_gf ) then - !tgs - take into account sub-grid clouds from GF or MYNN PBL - - ! Compute effective radii for QC and QI with sub-grid clouds - do k=1,lm - do i=1,im - ! make NC consistent with sub-grid clouds - if (Model%ltaerosol .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then - nc_mp(i,k) = make_DropletNumber(qc_mp(i,k)*rho(i,k), nwfa(i,k)) * orho(i,k) - endif - if (qi_mp(i,k)>1.e-12 .and. ni_mp(i,k)<100.) then - ni_mp(i,k) = make_IceNumber(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k) - endif - end do - end do - ! Call Thompson's subroutine to compute effective radii - do i=1,im - ! Initialize to default in units m as in module_mp_thompson.F90 - re_cloud(i,:) = 2.49E-6 - re_ice(i,:) = 4.99E-6 - re_snow(i,:) = 9.99E-6 - call calc_effectRad (tlyr(i,:), plyr(i,:), qv_mp(i,:), qc_mp(i,:), & - nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & - re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, lm ) - end do - do k=1,lm - do i=1,im - re_cloud(i,k) = MAX(2.49, MIN(re_cloud(i,k)*1.e6, 50.)) - re_ice(i,k) = MAX(4.99, MIN(re_ice(i,k)*1.e6, 125.)) - !tgs: clduni has different limits for ice radii: 10.0-150.0 - ! it will raise the low limit from 5 to 10, but the - ! high limit will remain 125. - re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) - end do - end do - - do k=1,lm - k1 = k + kd - do i=1,im - effrl(i,k1) = re_cloud (i,k) ! Tbd%phy_f3d(i,k,Model%nleffr) - effri(i,k1) = re_ice (i,k) ! Tbd%phy_f3d(i,k,Model%nieffr) - effrr(i,k1) = 1000. ! rrain_def=1000. - effrs(i,k1) = Tbd%phy_f3d(i,k,Model%nseffr) - enddo - enddo - else ! not MYNN or not GF - do k=1,lm - k1 = k + kd - do i=1,im - effrl(i,k1) = Tbd%phy_f3d(i,k,Model%nleffr) - effri(i,k1) = Tbd%phy_f3d(i,k,Model%nieffr) - effrr(i,k1) = 1000. ! rrain_def=1000. - effrs(i,k1) = Tbd%phy_f3d(i,k,Model%nseffr) - enddo - enddo - endif ! MYNN PBL or GF conv - endif ! kdt - else ! neither of the other two cases + enddo + ! Update global arrays + do k=1,lm + k1 = k + kd + do i=1,im + Tbd%phy_f3d(i,k,Model%nleffr) = effrl(i,k1) + Tbd%phy_f3d(i,k,Model%nieffr) = effri(i,k1) + Tbd%phy_f3d(i,k,Model%nseffr) = effrs(i,k1) + enddo + enddo + else ! all other cases cldcov = 0.0 endif @@ -936,14 +920,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input else ! kdt > 1 - do k=1,lm - k1 = k + kd - do i=1,im - Tbd%phy_f3d(i,k,Model%nleffr) = effrl(i,k1) - Tbd%phy_f3d(i,k,Model%nieffr) = effri(i,k1) - Tbd%phy_f3d(i,k,Model%nseffr) = effrs(i,k1) - enddo - enddo ! --- call progcld6 to get Xu-Randall total cloud cover (clouds(:,1:LMK,1)) ! tgs: a short subroutine could be made of progcld5 to ! compute only total cloud fraction. From 2aa91ae97ef29195995317ee2285972c0abc1afb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 2 Jun 2020 15:04:04 -0600 Subject: [PATCH 130/141] physics/GFS_suite_interstitial.F90: update of calculation of number concentrations for Thompson MP --- physics/GFS_suite_interstitial.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 3d22cf33b..466bcbb19 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -728,7 +728,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k))/(1.0_kind_phys-spechum(i,k)) !> - Convert number concentration from moist to dry nc_mp(i,k) = gq0(i,k,ntlnc)/(1.0_kind_phys-spechum(i,k)) - nc_mp(i,k) = nc_mp(i,k) + max(0.0, make_DropletNumber(qc_mp(i,k) * rho_dryair(i,k), nwfa(i,k)) * (1.0/rho_dryair(i,k))) + nc_mp(i,k) = max(0.0, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho_dryair(i,k), nwfa(i,k)) * (1.0/rho_dryair(i,k))) !> - Convert number concentrations from dry to moist gq0(i,k,ntlnc) = nc_mp(i,k)/(1.0_kind_phys+qv_mp(i,k)) endif @@ -737,7 +737,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k))/(1.0_kind_phys-spechum(i,k)) !> - Convert number concentration from moist to dry ni_mp(i,k) = gq0(i,k,ntinc)/(1.0_kind_phys-spechum(i,k)) - ni_mp(i,k) = ni_mp(i,k) + max(0.0, make_IceNumber(qi_mp(i,k) * rho_dryair(i,k), save_tcp(i,k)) * (1.0/rho_dryair(i,k))) + ni_mp(i,k) = max(0.0, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho_dryair(i,k), save_tcp(i,k)) * (1.0/rho_dryair(i,k))) !> - Convert number concentrations from dry to moist gq0(i,k,ntinc) = ni_mp(i,k)/(1.0_kind_phys+qv_mp(i,k)) endif From b271cf7e974a1b10c60593555e615635de98a836 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 3 Jun 2020 17:45:46 -0600 Subject: [PATCH 131/141] mp_thompson_post.F90: print statistics about tendency limiter use only in DEBUG mode --- physics/mp_thompson_post.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/physics/mp_thompson_post.F90 b/physics/mp_thompson_post.F90 index 97b44943d..cca74951d 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/mp_thompson_post.F90 @@ -76,7 +76,9 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli ! Local variables real(kind_phys), dimension(1:ncol,1:nlev) :: mp_tend integer :: i, k +#ifdef DEBUG integer :: events +#endif ! Initialize the CCPP error handling variables errmsg = '' @@ -95,26 +97,30 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli ! mp_tend and ttendlim are expressed in potential temperature mp_tend = (tgrs - tgrs_save)/prslk +#ifdef DEBUG events = 0 +#endif do k=1,nlev do i=1,ncol mp_tend(i,k) = max( -ttendlim*dtp, min( ttendlim*dtp, mp_tend(i,k) ) ) - if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then #ifdef DEBUG + if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then 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 +#endif tgrs(i,k) = tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) end do end do +#ifdef DEBUG if (events > 0) then write(0,'(a,i0,a,i0,a,i0)') "mp_thompson_post_run: ttendlim applied ", events, "/", nlev*ncol, & & " times at timestep ", kdt end if +#endif end subroutine mp_thompson_post_run From 56d3bda05f8f39576c1d033869f07faa8f66aafd Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Thu, 4 Jun 2020 21:25:03 +0000 Subject: [PATCH 132/141] Follow up commit for Cleanup of Thompson MP cloud effective radii calculation --- physics/GFS_rrtmg_pre.F90 | 93 +-------- physics/module_SGSCloud_RadPre.F90 | 280 ++++++++++++++++++++-------- physics/module_SGSCloud_RadPre.meta | 50 +++++ 3 files changed, 258 insertions(+), 165 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 84732e401..413b532b4 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -180,7 +180,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw - logical :: clduni real(kind=kind_phys) :: qvs ! !===> ... begin here @@ -730,7 +729,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input do i=1,im re_cloud(i,k) = MAX(2.49, MIN(re_cloud(i,k)*1.e6, 50.)) re_ice(i,k) = MAX(4.99, MIN(re_ice(i,k)*1.e6, 125.)) - !tgs: clduni has different limits for ice radii: 10.0-150.0 + !tgs: progclduni has different limits for ice radii: 10.0-150.0 ! it will raise the low limit from 5 to 10, but the ! high limit will remain 125. re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) @@ -888,91 +887,16 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input elseif(Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP - clduni = .true. - if(Model%do_mynnedmf .or. & Model%imfdeepcnv == Model%imfdeepcnv_gf ) then ! MYNN PBL or GF conv - ! MYNN PBL or convective GF - - if (Model%kdt == 1 ) then - ! --- call progcld6 to get Xu-Randall total cloud cover (clouds(:,1:LMK,1)) at - ! --- initial time step, it takes into account subgrid PBL - ! --- clouds - call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs - Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & - ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - ntsw-1,ntgl-1, & - im, lmk, lmp, Model%uni_cld, & - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,Model%nleffr), & - Tbd%phy_f3d(:,:,Model%nieffr), & - Tbd%phy_f3d(:,:,Model%nseffr), & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs - if (clduni) then - ! use progclduni for interaction with radiation, - ! overwrites 'clouds' from progcld6 - call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & - IM, LMK, LMP, clouds(:,1:LMK,1), & - effrl, effri, effrr, effrs, Model%effr_in , & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs - endif - - else ! kdt > 1 - - ! --- call progcld6 to get Xu-Randall total cloud cover (clouds(:,1:LMK,1)) - ! tgs: a short subroutine could be made of progcld5 to - ! compute only total cloud fraction. - call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs - Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & - ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - ntsw-1,ntgl-1, & - im, lmk, lmp, Model%uni_cld, & - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,Model%nleffr), & - Tbd%phy_f3d(:,:,Model%nieffr), & - Tbd%phy_f3d(:,:,Model%nseffr), & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs - - if (Model%do_mynnedmf) then - !tgs - let's use the PBL cloud fraction for now - do k=1,lmk - do i=1,im - !if (tracer1(i,k,ntrw) > 1.0e-7 .OR. tracer1(i,k,ntsw) > 1.0e-7) then - ! ! Xu-Randall cloud fraction computed in progcld6 - ! cldcov(i,k) = clouds(i,k,1) - !else - ! MYNN sub-grid cloud fraction - cldcov(i,k) = clouds1(i,k) - clouds(i,k,1) = clouds1(i,k) - !endif - enddo - enddo - elseif (Model%imfdeepcnv == Model%imfdeepcnv_gf) then ! GF conv - do k=1,lmk - do i=1,im - ! Xu-Randall cloud fraction computed in progcld6 - cldcov(i,k) = clouds(i,k,1) - enddo + !-- MYNN PBL or convective GF + !-- use cloud fractions with SGS clouds + do k=1,lmk + do i=1,im + clouds(i,k,1) = clouds1(i,k) enddo - endif + enddo - if (.not. clduni) then - ! --- call progcld6 for interaction with the radiation with setting - ! --- uni_cld=.true. to keep precomputed cloud - ! --- fraction - call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs - Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & - ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - ntsw-1,ntgl-1, & - im, lmk, lmp, .true., & ! Model%uni_cld - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,Model%nleffr), & - Tbd%phy_f3d(:,:,Model%nieffr), & - Tbd%phy_f3d(:,:,Model%nseffr), & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs - - else ! clduni ! --- use clduni as with the GFDL microphysics. ! --- make sure that effr_in=.true. in the input.nml! call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs @@ -980,9 +904,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input IM, LMK, LMP, clouds(:,1:LMK,1), & effrl, effri, effrr, effrs, Model%effr_in , & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs - endif ! clduni - - endif ! kdt else ! MYNN PBL or GF convective are not used diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index 16ebac5d7..4fb967ab0 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -2,7 +2,8 @@ !! Contains the preliminary (interstitial) work to the call to the radiation schemes: !! 1) Backs up the original qc & qi !! 2) Adds the partioning of convective condensate into liqice/ice for effective radii -!! 3) Adds the subgrid clouds mixing ratio and cloud fraction to the original qc, qi and cloud fraction coming from the microphysics scheme. +!! 3) Adds the subgrid clouds mixing ratio and cloud fraction to the original (resolved- +!! scale) qc, qi and cloud fraction coming from the microphysics scheme. !! 4) Recompute the diagnostic high, mid, low, total and bl clouds to be consistent with radiation module sgscloud_radpre @@ -17,11 +18,13 @@ end subroutine sgscloud_radpre_finalize !> \defgroup sgsrad_group GSD sgscloud_radpre_run Module !> \ingroup sgscloud_radpre -!! This interstitial code adds the subgrid clouds to the resolved-scale clouds if there is no resolved-scale clouds in that particular grid box. +!! This interstitial code adds the subgrid clouds to the resolved-scale clouds +!! if there is no resolved-scale clouds in that particular grid box. It can also +!! specify a cloud fraction for resolved-scale clouds, using Wu-Randall (1996), +!! if desired. !> \section arg_table_sgscloud_radpre_run Argument Table !! \htmlinclude sgscloud_radpre_run.html !! -!! !! cloud array description: ! !! clouds(:,:,1) - layer total cloud fraction ! !! clouds(:,:,2) - layer cloud liq water path ! @@ -35,7 +38,7 @@ subroutine sgscloud_radpre_run( & im,levs, & flag_init,flag_restart, & do_mynnedmf, & - qc, qi, T3D, & + qc, qi, qv, T3D, P3D, & qr, qs, & qci_conv, & imfdeepcnv, imfdeepcnv_gf, & @@ -45,25 +48,34 @@ subroutine sgscloud_radpre_run( & clouds4,clouds5,slmsk, & nlay, plyr, xlat, dz,de_lgth, & cldsa,mtopa,mbota, & + imp_physics, imp_physics_gfdl,& + imp_physics_thompson, & + imp_physics_wsm6, & errmsg, errflg ) ! should be moved to inside the mynn: use machine , only : kind_phys - use physcons, only : con_g, con_pi + use physcons, only : con_g, con_pi, & + eps => con_eps, & ! Rd/Rv + epsm1 => con_epsm1 ! Rd/Rv-1 use module_radiation_clouds, only : gethml - + use radcons, only: qmin ! Minimum vlaues for varius calculations + use funcphys, only: fpvs ! Function ot compute sat. vapor pressure over liq. !------------------------------------------------------------------- implicit none !------------------------------------------------------------------- ! Interface variables real (kind=kind_phys), parameter :: gfac=1.0e5/con_g - integer, intent(in) :: im, levs, imfdeepcnv, imfdeepcnv_gf, nlay + integer, intent(in) :: im, levs, imfdeepcnv, imfdeepcnv_gf, & + & nlay, imp_physics, imp_physics_wsm6, & + & imp_physics_thompson, imp_physics_gfdl logical, intent(in) :: flag_init, flag_restart, do_mynnedmf real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc, qi real(kind=kind_phys), dimension(im,levs), intent(inout) :: qr, qs ! qci_conv only allocated if GF is used real(kind=kind_phys), dimension(:,:), intent(inout) :: qci_conv - real(kind=kind_phys), dimension(im,levs), intent(in) :: T3D,delp + real(kind=kind_phys), dimension(im,levs), intent(in) :: T3D,delp, & + & qv,P3D real(kind=kind_phys), dimension(im,levs), intent(inout) :: & & clouds1,clouds2,clouds3,clouds4,clouds5 real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc_save, qi_save @@ -82,97 +94,207 @@ subroutine sgscloud_radpre_run( & data ptopc / 1050., 650., 400., 0.0, 1050., 750., 500., 0.0 / real(kind=kind_phys), dimension(im,nlay) :: cldcnv real(kind=kind_phys), dimension(im) :: rxlat - real (kind=kind_phys):: Tc, iwc, tem1 + real (kind=kind_phys):: Tc, iwc integer :: i, k, id + ! PARAMETERS FOR RANDALL AND XU (1996) CLOUD FRACTION + REAL, PARAMETER :: coef_p = 0.25, coef_gamm = 0.49, coef_alph = 100. + REAL :: rhgrid,h2oliq,qsat,tem1,tem2,clwt,es,onemrh,value + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 !write(0,*)"==============================================" - !write(0,*)"in mynn rad pre" + !write(0,*)"in SGSCLoud_RadPre" if (flag_init .and. (.not. flag_restart)) then - !write (0,*) 'Skip MYNNrad_pre flag_init = ', flag_init - return - endif - ! Back-up microphysics cloud information: - do k = 1, levs - do i = 1, im - qc_save(i,k) = qc(i,k) - qi_save(i,k) = qi(i,k) - end do - end do - - ! add boundary layer clouds - Note: now the temperature-dependent sorting of - ! ice and water subgrid-scale clouds is done inside the MYNN-EDMF - if (do_mynnedmf) then + !write (0,*) 'Skip this flag_init = ', flag_init + ! return + ! Need default cloud fraction when MYNN is not used: Resort to + ! Xu-Randall (1996). + ! cloud fraction = + ! {1-exp[-100.0*qc/((1-RH)*qsat)**0.49]}*RH**0.25 do k = 1, levs do i = 1, im - clouds1(i,k) = cldfra_bl(i,k) - - !if( qr(i,k) > 1.0e-7 .OR. qs(i,k) > 1.0e-7.or.qci_conv(i,k)>1.0e-7)THEN - !Keep Xu-RandalL clouds fraction - do not overwrite - !else - ! clouds1(i,k) = cldfra_bl(i,k) - !endif - - if (qc(i,k) < 1.e-6 .and. cldfra_bl(i,k)>0.001) then - qc(i,k) = qc_bl(i,k)*cldfra_bl(i,k) - if (nint(slmsk(i)) == 1) then !land - if(qc(i,k)>1.E-8)clouds3(i,k)=5.4 !eff radius cloud water (microns) - else - !eff radius cloud water (microns), from Miles et al. - if(qc(i,k)>1.E-8)clouds3(i,k)=9.6 - endif - !calculate the liquid water path using additional BL clouds - clouds2(i,k) = max(0.0, qc(i,k) * gfac * delp(i,k)) - endif - if (qi(i,k) < 1.e-8 .and. cldfra_bl(i,k)>0.001) then - qi(i,k) = qi_bl(i,k)*cldfra_bl(i,k) - Tc = T3D(i,k) - 273.15 - !iwc = qi(i,k)*1.0e6*rho(i,k) - if (nint(slmsk(i)) == 1) then !land - !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) - if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) - else - if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) - !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 8b) - !IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) + if ( qi(i,k) > 1E-7 .OR. qc(i,k) > 1E-7 ) then + es = min( p3d(i,k), fpvs( t3d(i,k) ) ) ! fpvs and prsl in pa + qsat = max( QMIN, eps * es / (p3d(i,k) + epsm1*es) ) + rhgrid = max( 0., min( 0.95, qv(i,k)/qsat ) ) + h2oliq = qc(i,k) + qi(i,k) ! g/kg + clwt = 1.0e-6 * (p3d(i,k)*0.00001) + + if (h2oliq > clwt) then + onemrh= max( 1.e-10, 1.0-rhgrid ) + tem1 = min(max((onemrh*qsat)**0.49,0.0001),1.0) !jhan + tem1 = 100.0 / tem1 + value = max( min( tem1*(h2oliq), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhgrid) ) + + clouds1(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) endif - !calculate the ice water path using additional BL clouds - clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) + !clouds1(i,k)=(1.-exp(-coef_alph*h2oliq/ & + ! & ((1.-rhgrid)*qsat*1000.0)**coef_gamm))*(rhgrid**coef_p) + !clouds1(i,k)=max(0.0,MIN(1.,clouds1(i,k))) endif - enddo enddo - endif ! do_mynnedmf - ! add convective clouds - if (imfdeepcnv == imfdeepcnv_gf) then + else ! kdt > 1 or restart + + ! Back-up microphysics cloud information: do k = 1, levs do i = 1, im - if ( qci_conv(i,k) > 0.) then - !Partition the convective clouds into water & ice according to a linear - qc(i,k) = qc(i,k)+qci_conv(i,k)*(min(1., max(0., (T3D(i,k)-244.)/25.))) - qi(i,k) = qi(i,k)+qci_conv(i,k)*(1. - min(1., max(0., (T3D(i,k)-244.)/25.))) - - Tc = T3D(i,k) - 273.15 - - if (nint(slmsk(i)) == 1) then !land - if(qc(i,k)>1.E-8)clouds3(i,k)=5.4 !eff radius cloud water (microns) - !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos) - if(qi(i,k)>1.e-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) - else - !eff radius cloud water (microns), from Miles et al. - if(qc(i,k)>1.E-8)clouds3(i,k)=9.6 - !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) - if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + qc_save(i,k) = qc(i,k) + qi_save(i,k) = qi(i,k) + end do + end do + + if ( do_mynnedmf ) then + + ! add boundary layer clouds - Note: now the temperature-dependent sorting of + ! ice and water subgrid-scale clouds is done inside the MYNN-EDMF + + do k = 1, levs + do i = 1, im + + !if (imp_physics == imp_physics_gfdl) then + ! ! only complement the GFDL cloud fractions + ! if (clouds1(i,k) < 0.01 .and. cldfra_bl(i,k) > 0.01) then + ! clouds1(i,k) = cldfra_bl(i,k) + ! endif + !else + clouds1(i,k) = cldfra_bl(i,k) + !endif + + !if( qr(i,k) > 1.0e-7 .OR. qs(i,k) > 1.0e-7.or.qci_conv(i,k)>1.0e-7)THEN + !Keep Xu-RandalL clouds fraction - do not overwrite + !else + ! clouds1(i,k) = cldfra_bl(i,k) + !endif + + if (qc(i,k) < 1.e-6 .and. cldfra_bl(i,k)>0.001) then + qc(i,k) = qc_bl(i,k)*cldfra_bl(i,k) + if (nint(slmsk(i)) == 1) then !land + if(qc(i,k)>1.E-8)clouds3(i,k)=5.4 !eff radius cloud water (microns) + else + !eff radius cloud water (microns), from Miles et al. + if(qc(i,k)>1.E-8)clouds3(i,k)=9.6 + endif + !calculate the liquid water path using additional BL clouds + clouds2(i,k) = max(0.0, qc(i,k) * gfac * delp(i,k)) endif - endif + if (qi(i,k) < 1.e-8 .and. cldfra_bl(i,k)>0.001) then + qi(i,k) = qi_bl(i,k)*cldfra_bl(i,k) + Tc = T3D(i,k) - 273.15 + !iwc = qi(i,k)*1.0e6*rho(i,k) + if (nint(slmsk(i)) == 1) then !land + !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) + if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + else + if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 8b) + !IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) + endif + !calculate the ice water path using additional BL clouds + clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) + endif + + enddo enddo - enddo - endif + + elseif (imp_physics /= imp_physics_gfdl) then + + ! Non-MYNN cloud fraction AND non-GFDL microphysics, since bith + ! have their own cloud fractions. In this case, we resort to + ! Xu-Randall (1996). + ! cloud fraction = + ! {1-exp[-100.0*qc/((1-RH)*qsat)**0.49]}*RH**0.25 + do k = 1, levs + do i = 1, im + if ( qi(i,k) > 1E-7 .OR. qc(i,k) > 1E-7 ) then + + es = min( p3d(i,k), fpvs( t3d(i,k) ) ) ! fpvs and prsl in pa + qsat = max( QMIN, eps * es / (p3d(i,k) + epsm1*es) ) + rhgrid = max( 0., min( 0.95, qv(i,k)/qsat ) ) + h2oliq = qc(i,k) + qi(i,k) ! g/kg + clwt = 1.0e-6 * (p3d(i,k)*0.00001) + + if (h2oliq > clwt) then + onemrh= max( 1.e-10, 1.0-rhgrid ) + tem1 = min(max((onemrh*qsat)**0.49,0.0001),1.0) !jhan + tem1 = 100.0 / tem1 + value = max( min( tem1*(h2oliq), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhgrid) ) + + clouds1(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + + !es = min( p3d(i,k), fpvs( t3d(i,k) ) ) ! fpvs and prsl in pa + !qsat = max( QMIN, eps * es / (p3d(i,k) + epsm1*es) ) + !rhgrid = max( 0., min( 0.95, qv(i,k)/qsat ) ) + !h2oliq=1000.0*( qc(i,k) + qi(i,k) ) ! g/kg + !clouds1(i,k)=(1.-exp(-coef_alph*h2oliq/ & + ! & ((1.-rhgrid)*qsat*1000.0)**coef_gamm))*(rhgrid**coef_p) + !clouds1(i,k)=max(0.0,MIN(1.,clouds1(i,k))) + endif + enddo + enddo + + endif ! end MYNN or OTHER choice for background clouds fractions + + ! At this point, we have cloud properties for all non-deep convective clouds. + ! So now we add the convective clouds, + + if (imfdeepcnv == imfdeepcnv_gf) then + do k = 1, levs + do i = 1, im + !if ( qci_conv(i,k) > 0. .AND. (qi(i,k) < 1E-7 .AND. qc(i,k) < 1E-7 ) ) then + if ( qci_conv(i,k) > 0. ) then + !Partition the convective clouds into water & ice according to a linear + qc(i,k) = qc(i,k)+qci_conv(i,k)*(min(1., max(0., (T3D(i,k)-244.)/25.))) + qi(i,k) = qi(i,k)+qci_conv(i,k)*(1. - min(1., max(0., (T3D(i,k)-244.)/25.))) + + Tc = T3D(i,k) - 273.15 + + if (nint(slmsk(i)) == 1) then !land + if(qc(i,k)>1.E-8)clouds3(i,k)=5.4 !eff radius cloud water (microns) + !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos) + if(qi(i,k)>1.e-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + else + !eff radius cloud water (microns), from Miles et al. + if(qc(i,k)>1.E-8)clouds3(i,k)=9.6 + !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) + if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + endif + + ! Xu-Randall (1996) cloud fraction + es = min( p3d(i,k), fpvs( t3d(i,k) ) ) ! fpvs and prsl in pa + qsat = max( QMIN, eps * es / (p3d(i,k) + epsm1*es) ) + rhgrid = max( 0., min( 0.95, qv(i,k)/qsat ) ) + h2oliq = qc(i,k) + qi(i,k) ! g/kg + clwt = 1.0e-6 * (p3d(i,k)*0.00001) + + if (h2oliq > clwt) then + onemrh= max( 1.e-10, 1.0-rhgrid ) + tem1 = min(max((onemrh*qsat)**0.49,0.0001),1.0) !jhan + tem1 = 100.0 / tem1 + value = max( min( tem1*(h2oliq), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhgrid) ) + + clouds1(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + else + clouds1(i,k) = 0.0 + endif + !print*,"XuRandla- cf:",clouds1(i,k)," rh:",rhgrid," qt:",h2oliq + !print*,"XuRandlb- clwt:",clwt," qsat:",qsat," p:",p3d(i,k) + endif + enddo + enddo + endif ! imfdeepcnv_gf + + endif ! kdt > 1 + !> - Compute SFC/low/middle/high cloud top pressure for each cloud domain for given latitude. do i =1, im diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index 79691920d..fff8013c9 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -61,6 +61,15 @@ kind = kind_phys intent = inout optional = F +[qv] + 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 [T3D] standard_name = air_temperature long_name = layer mean air temperature @@ -70,6 +79,15 @@ kind = kind_phys intent = in optional = F +[P3D] + 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 [qr] standard_name = rain_water_mixing_ratio long_name = moist (dry+vapor, no condensates) mixing ratio of rain water @@ -298,6 +316,38 @@ 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_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_wsm6] + standard_name = flag_for_wsm6_microphysics_scheme + long_name = choice of WSM6 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 From 72ac01d95f651e82c5c70d51f203d1a83854ae89 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Thu, 4 Jun 2020 22:05:29 +0000 Subject: [PATCH 133/141] updating comment to provide more general meaning --- physics/module_SGSCloud_RadPre.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index 4fb967ab0..f38625509 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -140,7 +140,7 @@ subroutine sgscloud_radpre_run( & enddo enddo - else ! kdt > 1 or restart + else ! timestep > 1 or restart ! Back-up microphysics cloud information: do k = 1, levs @@ -293,7 +293,7 @@ subroutine sgscloud_radpre_run( & enddo endif ! imfdeepcnv_gf - endif ! kdt > 1 + endif ! timestep > 1 !> - Compute SFC/low/middle/high cloud top pressure for each cloud domain for given latitude. From 8fd1674e67e6e60360393fbf1907c958f113ace2 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Thu, 4 Jun 2020 23:03:05 +0000 Subject: [PATCH 134/141] remove progcld6 and thompson & wsm6 flags --- physics/GFS_rrtmg_pre.F90 | 2 +- physics/module_SGSCloud_RadPre.F90 | 5 +- physics/module_SGSCloud_RadPre.meta | 16 -- physics/radiation_clouds.f | 300 +--------------------------- 4 files changed, 3 insertions(+), 320 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 413b532b4..42411c88f 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -65,7 +65,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input & progcld1, progcld3, & & progcld2, & & progcld4, progcld5, & - & progcld6, progclduni + & progclduni use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & & profsw_type, NBDSW use module_radlw_parameters, only: topflw_type, sfcflw_type, & diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index f38625509..eacfcded7 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -49,8 +49,6 @@ subroutine sgscloud_radpre_run( & nlay, plyr, xlat, dz,de_lgth, & cldsa,mtopa,mbota, & imp_physics, imp_physics_gfdl,& - imp_physics_thompson, & - imp_physics_wsm6, & errmsg, errflg ) ! should be moved to inside the mynn: @@ -67,8 +65,7 @@ subroutine sgscloud_radpre_run( & ! Interface variables real (kind=kind_phys), parameter :: gfac=1.0e5/con_g integer, intent(in) :: im, levs, imfdeepcnv, imfdeepcnv_gf, & - & nlay, imp_physics, imp_physics_wsm6, & - & imp_physics_thompson, imp_physics_gfdl + & nlay, imp_physics, imp_physics_gfdl logical, intent(in) :: flag_init, flag_restart, do_mynnedmf real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc, qi real(kind=kind_phys), dimension(im,levs), intent(inout) :: qr, qs diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index fff8013c9..63d83d349 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -332,22 +332,6 @@ 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 -[imp_physics_wsm6] - standard_name = flag_for_wsm6_microphysics_scheme - long_name = choice of WSM6 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/radiation_clouds.f b/physics/radiation_clouds.f index 176219199..5b4aa54ab 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -243,7 +243,7 @@ module module_radiation_clouds integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & - & cld_init, progcld5, progcld6, progcld4o, gethml + & cld_init, progcld5, progcld4o, gethml ! ================= @@ -2683,304 +2683,6 @@ subroutine progcld5 & end subroutine progcld5 !................................... -!----------------------------------- -!> \ingroup module_radiation_clouds -!! This subroutine computes cloud related quantities using the Thompson -!! cloud microphysics scheme with updated microphysics-cloud-radiation -!! interaction (including subgrid clouds). Adapted from progcld5. - subroutine progcld6 & - & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk,dz,delp, & - & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & - & IX, NLAY, NLP1, & - & uni_cld, lmfshal, lmfdeep2, cldcov, & - & re_cloud,re_ice,re_snow, & - & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: - & ) - -! ================= subprogram documentation block ================ ! -! ! -! subprogram: progcld6 computes cloud related quantities using ! -! the Thompson cloud microphysics scheme with updated microphysics ! -! cloud-radiation interaction (including subgrid clouds). ! -! ! -! abstract: this program computes cloud fractions from cloud ! -! condensates, ! -! and computes the low, mid, high, total and boundary layer cloud ! -! fractions and the vertical indices of low, mid, and high cloud ! -! top and base. the three vertical cloud domains are set up in the ! -! initial subroutine "cld_init". ! -! ! -! usage: call progcld6 ! -! ! -! subprograms called: gethml ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: ibm-sp, sgi ! -! ! -! ! -! ==================== definition of variables ==================== ! -! ! -! input variables: ! -! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! -! plvl (IX,NLP1) : model level pressure in mb (100Pa) ! -! tlyr (IX,NLAY) : model layer mean temperature in k ! -! tvly (IX,NLAY) : model layer virtual temperature in k ! -! qlyr (IX,NLAY) : layer specific humidity in gm/gm ! -! qstl (IX,NLAY) : layer saturate humidity in gm/gm ! -! rhly (IX,NLAY) : layer relative humidity (=qlyr/qstl) ! -! clw (IX,NLAY,ntrac) : layer cloud condensate amount ! -! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! -! range, otherwise see in-line comment ! -! xlon (IX) : grid longitude in radians (not used) ! -! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! -! dz (ix,nlay) : layer thickness (km) ! -! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! -! IX : horizontal dimention ! -! NLAY,NLP1 : vertical layer/level dimensions ! -! uni_cld : logical - true for cloud fraction from shoc ! -! lmfshal : logical - true for mass flux shallow convection ! -! lmfdeep2 : logical - true for mass flux deep convection ! -! cldcov : layer cloud fraction (used when uni_cld=.true. ! -! ! -! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! -! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! -! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! -! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! -! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! -! de_lgth(ix) : clouds decorrelation length (km) ! -! ! -! module variables: ! -! ivflip : control flag of vertical index direction ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! lmfshal : mass-flux shallow conv scheme flag ! -! lmfdeep2 : scale-aware mass-flux deep conv scheme flag ! -! lcrick : control flag for eliminating CRICK ! -! =t: apply layer smoothing to eliminate CRICK ! -! =f: do not apply layer smoothing ! -! lcnorm : control flag for in-cld condensate ! -! =t: normalize cloud condensate ! -! =f: not normalize cloud condensate ! -! ! -! ==================== end of description ===================== ! -! - implicit none - -! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 - integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl - - logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 - - real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, & - & re_cloud, re_ice, re_snow - - real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw - - real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & - & slmsk - -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds - - real (kind=kind_phys), dimension(:,:), intent(out) :: clds - real (kind=kind_phys), dimension(:), intent(out) :: de_lgth - - integer, dimension(:,:), intent(out) :: mtop,mbot - -! --- local variables: - real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - - real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) - - real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & - & tem1, tem2, tem3 - - integer :: i, k, id, nf - -! --- constant values - real (kind=kind_phys), parameter :: xrc3 = 100. - -! -!===> ... begin here -! - do k = 1, NLAY - do i = 1, IX - cldtot(i,k) = 0.0 - cldcnv(i,k) = 0.0 - cwp (i,k) = 0.0 - cip (i,k) = 0.0 - crp (i,k) = 0.0 - csp (i,k) = 0.0 - rew (i,k) = re_cloud(i,k) - rei (i,k) = re_ice(i,k) - rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = re_snow(i,K) -! tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) - clwf(i,k) = 0.0 - enddo - enddo - - do k = 1, NLAY - do i = 1, IX - clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) - & + clw(i,k,ntrw) + clw(i,k,ntgl) - enddo - enddo -!> - Find top pressure for each cloud domain for given latitude. -!! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; -!! i=1,2 are low-lat (<45 degree) and pole regions) - - do i =1, IX - rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range -! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range - enddo - - do id = 1, 4 - tem1 = ptopc(id,2) - ptopc(id,1) - do i =1, IX - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) - enddo - enddo - -!> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . - - do k = 1, NLAY - do i = 1, IX - cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) - cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) - crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) - csp(i,k) = max(0.0, (clw(i,k,ntsw)+clw(i,k,ntgl)) * - & gfac * delp(i,k)) - enddo - enddo - - if (uni_cld) then ! use unified sgs clouds generated outside - do k = 1, NLAY - do i = 1, IX - cldtot(i,k) = cldcov(i,k) - enddo - enddo - - else - -!> - Calculate layer cloud fraction. - - clwmin = 0.0 - - do k = 1, NLAY - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) -! - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan - !if (lmfdeep2) then - ! tem1 = xrc3 / tem1 - !else - tem1 = 100.0 / tem1 - !endif -! - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - - endif ! if (uni_cld) then - - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) < climit) then - cwp(i,k) = 0.0 - cip(i,k) = 0.0 - crp(i,k) = 0.0 - csp(i,k) = 0.0 - endif - enddo - enddo - - if ( lcnorm ) then - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) >= climit) then - tem1 = 1.0 / max(climit2, cldtot(i,k)) - cwp(i,k) = cwp(i,k) * tem1 - cip(i,k) = cip(i,k) * tem1 - crp(i,k) = crp(i,k) * tem1 - csp(i,k) = csp(i,k) * tem1 - endif - enddo - enddo - endif - -! - do k = 1, NLAY - do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) ! added for Thompson - clouds(i,k,7) = rer(i,k) - clouds(i,k,8) = csp(i,k) ! added for Thompson - clouds(i,k,9) = res(i,k) - enddo - enddo - -! --- ... estimate clouds decorrelation length in km -! this is only a tentative test, need to consider change later - - if ( iovr == 3 ) then - do i = 1, ix - de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) - enddo - endif - -!> - Call gethml() to compute low,mid,high,total, and boundary layer -!! cloud fractions and clouds top/bottom layer indices for low, mid, -!! and high clouds. -! --- compute low, mid, high, total, and boundary layer cloud fractions -! and clouds top/bottom layer indices for low, mid, and high clouds. -! The three cloud domain boundaries are defined by ptopc. The cloud -! overlapping method is defined by control flag 'iovr', which may -! be different for lw and sw radiation programs. - - call gethml & -! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & - & IX,NLAY, & -! --- outputs: - & clds, mtop, mbot & - & ) - - -! - return -!................................... - end subroutine progcld6 -!................................... - !> \ingroup module_radiation_clouds !> This subroutine computes cloud related quantities using !! for unified cloud microphysics scheme. From fc9a06dda429f9908e5a136e703a75e3b5b867d7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 4 Jun 2020 21:12:53 -0600 Subject: [PATCH 135/141] Correct typos in comments in physics/module_SGSCloud_RadPre.F90 --- physics/module_SGSCloud_RadPre.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index eacfcded7..a3731c63e 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -20,7 +20,7 @@ end subroutine sgscloud_radpre_finalize !> \ingroup sgscloud_radpre !! This interstitial code adds the subgrid clouds to the resolved-scale clouds !! if there is no resolved-scale clouds in that particular grid box. It can also -!! specify a cloud fraction for resolved-scale clouds, using Wu-Randall (1996), +!! specify a cloud fraction for resolved-scale clouds, using Xu-Randall (1996), !! if desired. !> \section arg_table_sgscloud_radpre_run Argument Table !! \htmlinclude sgscloud_radpre_run.html @@ -202,7 +202,7 @@ subroutine sgscloud_radpre_run( & elseif (imp_physics /= imp_physics_gfdl) then - ! Non-MYNN cloud fraction AND non-GFDL microphysics, since bith + ! Non-MYNN cloud fraction AND non-GFDL microphysics, since both ! have their own cloud fractions. In this case, we resort to ! Xu-Randall (1996). ! cloud fraction = From 90c83b557752a0bbe1ffbbff32585535130fe082 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 5 Jun 2020 20:02:07 +0000 Subject: [PATCH 136/141] MYNNPBL wrapper update to include all required variables for ocean coupling --- physics/module_MYNNPBL_wrapper.F90 | 74 ++++++++++--- physics/module_MYNNPBL_wrapper.meta | 164 ++++++++++++++++++++++++++-- 2 files changed, 214 insertions(+), 24 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 0e9cb3c4f..3ab44c989 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -37,9 +37,10 @@ end subroutine mynnedmf_wrapper_finalize !! \htmlinclude mynnedmf_wrapper_run.html !! SUBROUTINE mynnedmf_wrapper_run( & - & im,levs, & + & ix,im,levs, & & flag_init,flag_restart,cycling, & - & lssav, ldiag3d, qdiag3d, lsidea,& + & lssav, ldiag3d, qdiag3d, & + & lsidea, cplflx, & & delt,dtf,dx,zorl, & & phii,u,v,omega,t3d, & & qgrs_water_vapor, & @@ -50,12 +51,19 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ozone, & & qgrs_water_aer_num_conc, & & qgrs_ice_aer_num_conc, & - & prsl,exner, & + & del,prsl,exner, & & slmsk,tsurf,qsfc,ps, & - & ust,ch,hflx,qflx, & - & wspd,rb,dtsfc1,dqsfc1, & + & ust,ch,hflx,qflx,wspd,rb, & + & dtsfc1,dqsfc1, & + & dusfc1,dvsfc1, & + & dusfci_diag,dvsfci_diag, & & dtsfci_diag,dqsfci_diag, & + & dusfc_diag,dvsfc_diag, & & dtsfc_diag,dqsfc_diag, & + & dusfci_cpl,dvsfci_cpl, & + & dtsfci_cpl,dqsfci_cpl, & + & dusfc_cpl,dvsfc_cpl, & + & dtsfc_cpl,dqsfc_cpl, & & recmol, & & qke,qke_adv,Tsq,Qsq,Cov, & & el_pbl,sh3d,exch_h,exch_m, & @@ -171,6 +179,8 @@ SUBROUTINE mynnedmf_wrapper_run( & integer, intent(out) :: errflg LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea, qdiag3d + LOGICAL, INTENT(IN) :: cplflx + ! NAMELIST OPTIONS (INPUT): LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect, ltaerosol, & lprnt, do_mynnsfclay, cycling @@ -204,7 +214,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !MYNN-1D REAL(kind=kind_phys), intent(in) :: delt, dtf - INTEGER, intent(in) :: im, levs + INTEGER, intent(in) :: im, ix, levs LOGICAL, intent(in) :: flag_init, flag_restart INTEGER :: initflag, k, i INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & @@ -231,7 +241,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & sub_thl,sub_sqv,det_thl,det_sqv real(kind=kind_phys), dimension(im,levs), intent(in) :: & & u,v,omega,t3d, & - & exner,prsl, & + & del,exner,prsl, & & qgrs_water_vapor, & & qgrs_liquid_cloud, & & qgrs_ice_cloud, & @@ -272,17 +282,25 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind=kind_phys), dimension(im), intent(inout) :: & & pblh real(kind=kind_phys), dimension(im), intent(out) :: & - & ch,dtsfc1,dqsfc1, & + & ch,dtsfc1,dqsfc1,dusfc1,dvsfc1, & & dtsfci_diag,dqsfci_diag,dtsfc_diag,dqsfc_diag, & + & dusfci_diag,dvsfci_diag,dusfc_diag,dvsfc_diag, & & maxMF - integer, dimension(im), intent(inout) :: & - & kpbl,nupdraft,ktop_plume + integer, dimension(im), intent(inout) :: & + & kpbl,nupdraft,ktop_plume + + real(kind=kind_phys), dimension(im), intent(inout) :: & + & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl + real(kind=kind_phys), dimension(im), intent(out) :: & + & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL real, dimension(im) :: & & WSTAR,DELTA,qcg,hfx,qfx,rmol,xland, & & uoce,voce,vdfg,znt,ts + real, dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1 + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -474,12 +492,33 @@ SUBROUTINE mynnedmf_wrapper_run( & delta(i)=0.0 qcg(i)=0.0 - dtsfc1(i)=hfx(i) - dqsfc1(i)=qfx(i)*XLV - dtsfci_diag(i)=dtsfc1(i) - dqsfci_diag(i)=dqsfc1(i) - dtsfc_diag(i)=dtsfc_diag(i) + dtsfc1(i)*delt - dqsfc_diag(i)=dqsfc_diag(i) + dqsfc1(i)*delt + dtsfc1(i) = hfx(i) + dqsfc1(i) = qfx(i)*XLV + dusfc1(i) = -1.*rho(i,1)*ust(i)*ust(i)*u(i,1)/wspd(i) + dvsfc1(i) = -1.*rho(i,1)*ust(i)*ust(i)*v(i,1)/wspd(i) + + !BWG: diagnostic surface fluxes for scalars & momentum + dtsfci_diag(i) = dtsfc1(i) + dqsfci_diag(i) = dqsfc1(i) + dtsfc_diag(i) = dtsfc_diag(i) + dtsfc1(i)*delt + dqsfc_diag(i) = dqsfc_diag(i) + dqsfc1(i)*delt + dusfci_diag(i) = dusfc1(i) + dvsfci_diag(i) = dvsfc1(i) + dusfc_diag(i) = dusfc_diag(i) + dusfci_diag(i)*delt + dvsfc_diag(i) = dvsfc_diag(i) + dvsfci_diag(i)*delt + + ! BWG: Coupling insertion + if(cplflx) then + dusfci_cpl(i) = dusfci_diag(i) + dvsfci_cpl(i) = dvsfci_diag(i) + dtsfci_cpl(i) = dtsfci_diag(i) + dqsfci_cpl(i) = dqsfci_diag(i) + + dusfc_cpl(i) = dusfc_cpl(i) + dusfci_cpl(i)*delt + dvsfc_cpl(i) = dvsfc_cpl(i) + dvsfci_cpl(i)*delt + dtsfc_cpl(i) = dtsfc_cpl(i) + dtsfci_cpl(i)*delt + dqsfc_cpl(i) = dqsfc_cpl(i) + dqsfci_cpl(i)*delt + endif znt(i)=zorl(i)*0.01 !cm -> m? if (do_mynnsfclay) then @@ -782,7 +821,8 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo endif endif - + + if (lprnt) then print* print*,"===Finished with mynn_bl_driver; output:" diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 31ebcde74..6952fd7fd 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -27,10 +27,17 @@ intent = out optional = F -##################################################################### [ccpp-arg-table] name = mynnedmf_wrapper_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 @@ -101,6 +108,14 @@ type = logical intent = in optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F [delt] standard_name = time_step_for_physics long_name = time step for physics @@ -254,6 +269,15 @@ 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 @@ -327,8 +351,8 @@ intent = out optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward sensible heat flux reduced by surface roughness + 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 @@ -336,8 +360,8 @@ intent = in optional = F [qflx] - standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward latent heat flux reduced by surface roughness + 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 @@ -380,6 +404,42 @@ kind = kind_phys intent = out optional = F +[dusfc1] + standard_name = instantaneous_surface_x_momentum_flux + long_name = surface momentum flux in the x-direction valid for current call + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc1] + standard_name = instantaneous_surface_y_momentum_flux + long_name = surface momentum flux in the y-direction valid for current call + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfci_diag] + standard_name = instantaneous_surface_x_momentum_flux_for_diag + long_name = instantaneous sfc x momentum flux multiplied by timestep + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfci_diag] + standard_name = instantaneous_surface_y_momentum_flux_for_diag + long_name = instantaneous sfc y momentum flux multiplied by timestep + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [dtsfci_diag] standard_name = instantaneous_surface_upward_sensible_heat_flux_for_diag long_name = instantaneous sfc sensible heat flux multiplied by timestep @@ -398,6 +458,24 @@ kind = kind_phys intent = out optional = F +[dusfc_diag] + standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc x momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvsfc_diag] + standard_name = cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc y momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [dtsfc_diag] standard_name = cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc sensible heat flux multiplied by timestep @@ -405,7 +483,7 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [dqsfc_diag] standard_name = cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep @@ -414,7 +492,79 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = out + intent = inout + optional = F +[dusfci_cpl] + standard_name = instantaneous_surface_x_momentum_flux_for_coupling + long_name = instantaneous sfc u momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvsfci_cpl] + standard_name = instantaneous_surface_y_momentum_flux_for_coupling + long_name = instantaneous sfc v momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtsfci_cpl] + standard_name = instantaneous_surface_upward_sensible_heat_flux_for_coupling + long_name = instantaneous sfc sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqsfci_cpl] + standard_name = instantaneous_surface_upward_latent_heat_flux_for_coupling + long_name = instantaneous sfc latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dusfc_cpl] + standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc u momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvsfc_cpl] + standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc v momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtsfc_cpl] + standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc sensible heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqsfc_cpl] + standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc latent heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout optional = F [recmol] standard_name = reciprocal_of_obukhov_length From 45e6b4eed472969034c3510e29102fbe051f1638 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 5 Jun 2020 20:33:58 +0000 Subject: [PATCH 137/141] Removing del and ix. using the *_reduced_by_... versions of hflx and qflx. --- physics/module_MYNNPBL_wrapper.F90 | 8 ++++---- physics/module_MYNNPBL_wrapper.meta | 25 ++++--------------------- 2 files changed, 8 insertions(+), 25 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 3ab44c989..3752f632b 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -37,7 +37,7 @@ end subroutine mynnedmf_wrapper_finalize !! \htmlinclude mynnedmf_wrapper_run.html !! SUBROUTINE mynnedmf_wrapper_run( & - & ix,im,levs, & + & im,levs, & & flag_init,flag_restart,cycling, & & lssav, ldiag3d, qdiag3d, & & lsidea, cplflx, & @@ -51,7 +51,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ozone, & & qgrs_water_aer_num_conc, & & qgrs_ice_aer_num_conc, & - & del,prsl,exner, & + & prsl,exner, & & slmsk,tsurf,qsfc,ps, & & ust,ch,hflx,qflx,wspd,rb, & & dtsfc1,dqsfc1, & @@ -214,7 +214,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !MYNN-1D REAL(kind=kind_phys), intent(in) :: delt, dtf - INTEGER, intent(in) :: im, ix, levs + INTEGER, intent(in) :: im, levs LOGICAL, intent(in) :: flag_init, flag_restart INTEGER :: initflag, k, i INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & @@ -241,7 +241,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & sub_thl,sub_sqv,det_thl,det_sqv real(kind=kind_phys), dimension(im,levs), intent(in) :: & & u,v,omega,t3d, & - & del,exner,prsl, & + & exner,prsl, & & qgrs_water_vapor, & & qgrs_liquid_cloud, & & qgrs_ice_cloud, & diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 6952fd7fd..c577b2563 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -30,14 +30,6 @@ [ccpp-arg-table] name = mynnedmf_wrapper_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 @@ -269,15 +261,6 @@ 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 @@ -351,8 +334,8 @@ intent = out optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux - long_name = kinematic surface upward sensible heat flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 dimensions = (horizontal_dimension) type = real @@ -360,8 +343,8 @@ intent = in optional = F [qflx] - standard_name = kinematic_surface_upward_latent_heat_flux - long_name = kinematic surface upward latent heat flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 dimensions = (horizontal_dimension) type = real From 840f13500d01f71232276613de295a91bdc010c2 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 5 Jun 2020 21:01:12 +0000 Subject: [PATCH 138/141] Removing the im dimension specification of the *_cpl arrays, and making them all inout. Note that the meta file already had them as inout. --- physics/module_MYNNPBL_wrapper.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 3752f632b..413db8b62 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -289,9 +289,9 @@ SUBROUTINE mynnedmf_wrapper_run( & integer, dimension(im), intent(inout) :: & & kpbl,nupdraft,ktop_plume - real(kind=kind_phys), dimension(im), intent(inout) :: & + real(kind=kind_phys), dimension(:), intent(inout) :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl - real(kind=kind_phys), dimension(im), intent(out) :: & + real(kind=kind_phys), dimension(:), intent(inout) :: & & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL From 755de19e649a07d6beb060b35a13946192789c90 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 5 Jun 2020 21:41:13 +0000 Subject: [PATCH 139/141] Updates to MYNN-EDMF --- physics/module_bl_mynn.F90 | 309 ++++++++++++++++++++----------------- 1 file changed, 169 insertions(+), 140 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index edc5d4a1e..2c1ce9fe0 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -459,7 +459,7 @@ MODULE module_bl_mynn !> @{ SUBROUTINE mym_initialize ( & & kts,kte, & - & dz, zw, & + & dz, dx, zw, & & u, v, thl, qw, & ! & ust, rmo, pmz, phh, flt, flq, & & zi, theta, sh, & @@ -476,7 +476,7 @@ SUBROUTINE mym_initialize ( & INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf LOGICAL, INTENT(IN) :: INITIALIZE_QKE ! REAL, INTENT(IN) :: ust, rmo, pmz, phh, flt, flq - REAL, INTENT(IN) :: ust, rmo, Psig_bl + REAL, INTENT(IN) :: ust, rmo, Psig_bl, dx REAL, DIMENSION(kts:kte), INTENT(in) :: dz REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,cldfra_bl1D,& @@ -546,7 +546,7 @@ SUBROUTINE mym_initialize ( & !> - call mym_length() to calculate the master length scale. CALL mym_length ( & & kts,kte, & - & dz, zw, & + & dz, dx, zw, & & rmo, flt, flq, & & vt, vq, & & u, v, qke, & @@ -791,7 +791,7 @@ END SUBROUTINE mym_level2 !! This subroutine calculates the mixing lengths. SUBROUTINE mym_length ( & & kts,kte, & - & dz, zw, & + & dz, dx, zw, & & rmo, flt, flq, & & vt, vq, & & u1, v1, qke, & @@ -813,7 +813,7 @@ SUBROUTINE mym_length ( & INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf REAL, DIMENSION(kts:kte), INTENT(in) :: dz REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, INTENT(in) :: rmo,flt,flq,Psig_bl + REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,dx REAL, DIMENSION(kts:kte), INTENT(IN) :: u1,v1,qke,vt,vq,cldfra_bl1D,& edmf_w1,edmf_a1,edmf_qc1 REAL, DIMENSION(kts:kte), INTENT(out) :: qkw, el @@ -1042,7 +1042,7 @@ SUBROUTINE mym_length ( & Ugrid = sqrt(u1(kts)**2 + v1(kts)**2) cns = 3.5 * (1.0 - MIN(MAX(Ugrid - Uonset, 0.0)/10.0, 1.0)) alp1 = 0.23 - alp2 = 0.30 + alp2 = 0.30 + 0.3*MIN(MAX((dx - 3000.)/10000., 0.0), 1.0) alp3 = 2.0 alp4 = 20. !10. alp5 = alp2 !like alp2, but for free atmosphere @@ -1543,7 +1543,7 @@ END SUBROUTINE boulac_length SUBROUTINE mym_turbulence ( & & kts,kte, & & levflag, & - & dz, zw, & + & dz, dx, zw, & & u, v, thl, ql, qw, & & qke, tsq, qsq, cov, & & vt, vq, & @@ -1571,7 +1571,7 @@ SUBROUTINE mym_turbulence ( & INTEGER, INTENT(IN) :: levflag,bl_mynn_mixlength,bl_mynn_edmf REAL, DIMENSION(kts:kte), INTENT(in) :: dz REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,Psig_shcu + REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,Psig_shcu,dx REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,& &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1,edmf_qc1,& &TKEprodTD @@ -1632,7 +1632,7 @@ SUBROUTINE mym_turbulence ( & ! CALL mym_length ( & & kts,kte, & - & dz, zw, & + & dz, dx, zw, & & rmo, flt, flq, & & vt, vq, & & u, v, qke, & @@ -1894,14 +1894,6 @@ SUBROUTINE mym_turbulence ( & gamv = 0.0 END IF ! -! Add stochastic perturbation of prandtl number limit - if (spp_pbl==1) then - prlimit = MIN(MAX(1.,2.5 + 5.0*rstoch_col(k)), 10.) - IF(sm(k) > sh(k)*Prlimit) THEN - sm(k) = sh(k)*Prlimit - ENDIF - ENDIF -! ! Add min background stability function (diffusivity) within model levels ! with active plumes and low cloud fractions. cldavg = 0.5*(cldfra_bl1D(k-1) + cldfra_bl1D(k)) @@ -2701,11 +2693,11 @@ SUBROUTINE mym_condensation (kts,kte, & !CLOUD WATER AND ICE IF (q1k < 0.) THEN !unstaurated ql_water = sgm(k)*EXP(1.2*q1k-1) -! ql_ice = sgm(k)*EXP(0.9*q1k-2.6) + ql_ice = sgm(k)*EXP(1.2*q1k-1.) !Reduce ice mixing ratios in the upper troposphere - low_weight = MIN(MAX(p(k)-40000.0, 0.0),40000.0)/40000.0 - ql_ice = low_weight * sgm(k)*EXP(1.1*q1k-1.6) & !low-lev - + (1.-low_weight) * sgm(k)*EXP(1.1*q1k-2.8)!upper-lev +! low_weight = MIN(MAX(p(k)-40000.0, 0.0),40000.0)/40000.0 +! ql_ice = low_weight * sgm(k)*EXP(1.1*q1k-1.6) & !low-lev +! + (1.-low_weight) * sgm(k)*EXP(1.1*q1k-2.8)!upper-lev ELSE IF (q1k > 2.) THEN !supersaturated ql_water = sgm(k)*q1k ql_ice = MIN(80.*qv(k),0.1)*sgm(k)*q1k @@ -2889,7 +2881,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & !! grav_settling = 0 otherwise ! thl - liquid water potential temperature ! qw - total water -! dfm,dfh,dfq - as above +! dfm,dfh,dfq - diffusivities i.e., dfh(k) = elq*sh(k) / dzk ! flt - surface flux of thl ! flq - surface flux of qw @@ -2915,7 +2907,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & REAL, DIMENSION(kts:kte) :: dtz,vt,vq,dfhc,dfmc !Kh for clouds (Pr < 2) REAL, DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqw2,qni2,qnc2, & !AFTER MIXING qnwfa2,qnifa2,ozone2 - REAL, DIMENSION(kts:kte) :: zfac,plumeKh + REAL, DIMENSION(kts:kte) :: zfac,plumeKh,rhoinv REAL, DIMENSION(kts:kte) :: a,b,c,d,x REAL, DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface & khdz, kmdz @@ -2940,28 +2932,31 @@ SUBROUTINE mynn_tendencies(kts,kte, & ENDIF !Prepare "constants" for diffusion equation. - !khdz = rho*Kh/dz - dtz(kts)=delt/dz(kts) - kh=dfh(kts)*dz(kts) - km=dfm(kts)*dz(kts) - rhoz(kts)=rho(kts) - khdz(kts)=rhoz(kts)*kh/dz(kts) - kmdz(kts)=rhoz(kts)*km/dz(kts) + !khdz = rho*Kh/dz = rho*dfh + dtz(kts) =delt/dz(kts) + rhoz(kts) =rho(kts) + rhoinv(kts)=1./rho(kts) + khdz(kts) =rhoz(kts)*dfh(kts) + kmdz(kts) =rhoz(kts)*dfm(kts) DO k=kts+1,kte - dtz(k)=delt/dz(k) - rhoz(k)=(rho(k)*dz(k-1) + rho(k-1)*dz(k))/(dz(k-1)+dz(k)) + dtz(k) =delt/dz(k) + rhoz(k) =(rho(k)*dz(k-1) + rho(k-1)*dz(k))/(dz(k-1)+dz(k)) + rhoz(k) = MAX(rhoz(k),1E-4) + rhoinv(k)=1./MAX(rho(k),1E-4) + dzk = 0.5 *( dz(k)+dz(k-1) ) + khdz(k) = rhoz(k)*dfh(k) + kmdz(k) = rhoz(k)*dfm(k) + ENDDO + khdz(kte+1)=rhoz(kte+1)*dfh(kte) + kmdz(kte+1)=rhoz(kte+1)*dfm(kte) - dzk = 0.5 *( dz(k)+dz(k-1) ) - kh = dfh(k)*dzk - km = dfm(k)*dzk - khdz(k)= rhoz(k)*kh/dzk - kmdz(k)= rhoz(k)*km/dzk + !stability criteria for mf + DO k=kts+1,kte-1 + khdz(k) = MAX(khdz(k), 0.5*rho(k)* s_aw(k)) + khdz(k) = MAX(khdz(k), -0.5*rho(k)*(s_aw(k)-s_aw(k+1))) + kmdz(k) = MAX(kmdz(k), 0.5*rho(k)* s_aw(k)) + kmdz(k) = MAX(kmdz(k), -0.5*rho(k)*(s_aw(k)-s_aw(k+1))) ENDDO - rhoz(kte+1)=rho(kte) - kh=dfh(kte)*dz(kte) - km=dfm(kte)*dz(kte) - khdz(kte+1)=rhoz(kte+1)*kh/dz(kte) - kmdz(kte+1)=rhoz(kte+1)*km/dz(kte) !!============================================ !! u @@ -2969,25 +2964,41 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(1)=0. - b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff - c(1)=-dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff - d(1)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + & - sub_u(k)*delt + det_u(k)*delt +! a(1)=0. +! b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff +! c(1)=-dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff +! d(1)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + & +! sub_u(k)*delt + det_u(k)*delt +! +! DO k=kts+1,kte-1 +! a(k)= - dtz(k)*dfm(k) + 0.5*dtz(k)*s_aw(k)*onoff +! b(k)=1. + dtz(k)*(dfm(k)+dfm(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff +! c(k)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff +! d(k)=u(k) + dtz(k)*(s_awu(k)-s_awu(k+1))*onoff + & +! sub_u(k)*delt + det_u(k)*delt +! ENDDO -!JOE - tend test -! a(k)=0. -! b(k)=1.+dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! c(k)=-dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(k)=u(k)*(1.-ust**2/wspd*dtz(k)) + & -! dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff +!rho-weighted: + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(kmdz(k+1)+ust**2/wspd)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff + d(k)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + & + & sub_u(k)*delt + det_u(k)*delt + +!!JOE - tend test +!! a(k)=0. +!! b(k)=1.+dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff +!! c(k) =-dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff +!! d(k)=u(k)*(1.-ust**2/wspd*dtz(k)) + & +!! dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff DO k=kts+1,kte-1 - a(k)= - dtz(k)*dfm(k) + 0.5*dtz(k)*s_aw(k)*onoff - b(k)=1. + dtz(k)*(dfm(k)+dfm(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff - c(k)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*onoff + b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff d(k)=u(k) + dtz(k)*(s_awu(k)-s_awu(k+1))*onoff + & - sub_u(k)*delt + det_u(k)*delt + & sub_u(k)*delt + det_u(k)*delt ENDDO !! no flux at the top @@ -3009,7 +3020,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=u(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) + CALL tridiag3(kte,a,b,c,d,x) DO k=kts,kte ! du(k)=(d(k-kts+1)-u(k))/delt @@ -3022,26 +3033,42 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(1)=0. - b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff - c(1)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff +! a(1)=0. +! b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff +! c(1)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff !! d(1)=v(k) - d(1)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + & - sub_v(k)*delt + det_v(k)*delt +! d(1)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + & +! sub_v(k)*delt + det_v(k)*delt +! +! DO k=kts+1,kte-1 +! a(k)= - dtz(k)*dfm(k) + 0.5*dtz(k)*s_aw(k)*onoff +! b(k)=1. + dtz(k)*(dfm(k)+dfm(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff +! c(k)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff +! d(k)=v(k) + dtz(k)*(s_awv(k)-s_awv(k+1))*onoff + & +! sub_v(k)*delt + det_v(k)*delt +! ENDDO -!JOE - tend test -! a(k)=0. -! b(k)=1.+dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! c(k)= -dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(k)=v(k)*(1.-ust**2/wspd*dtz(k)) + & -! dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff +!rho-weighted: + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(kmdz(k+1)+ust**2/wspd)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff + d(k)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + & + & sub_v(k)*delt + det_v(k)*delt + +!!JOE - tend test +!! a(k)=0. +!! b(k)=1.+dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff +!! c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff +!! d(k)=v(k)*(1.-ust**2/wspd*dtz(k)) + & +!! dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff DO k=kts+1,kte-1 - a(k)= - dtz(k)*dfm(k) + 0.5*dtz(k)*s_aw(k)*onoff - b(k)=1. + dtz(k)*(dfm(k)+dfm(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff - c(k)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*onoff + b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff d(k)=v(k) + dtz(k)*(s_awv(k)-s_awv(k+1))*onoff + & - sub_v(k)*delt + det_v(k)*delt + & sub_v(k)*delt + det_v(k)*delt ENDDO !! no flux at the top @@ -3063,7 +3090,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=v(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) + CALL tridiag3(kte,a,b,c,d,x) DO k=kts,kte ! dv(k)=(d(k-kts+1)-v(k))/delt @@ -3093,19 +3120,19 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! ENDDO !rho-weighted: - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt - dtz(k)*s_awthl(k+1) + & & diss_heat(k)*delt*dheat_opt + sub_thl(k)*delt + det_thl(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=thl(k) + tcd(k)*delt + dtz(k)*(s_awthl(k)-s_awthl(k+1)) + & - & diss_heat(k)*delt*dheat_opt + & + & + diss_heat(k)*delt*dheat_opt + & & sub_thl(k)*delt + det_thl(k)*delt ENDDO @@ -3161,16 +3188,16 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! ENDDO !rho-weighted: - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=sqw(k) + dtz(k)*flq + qcd(k)*delt - dtz(k)*s_awqt(k+1) DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=sqw(k) + qcd(k)*delt + dtz(k)*(s_awqt(k)-s_awqt(k+1)) ENDDO @@ -3226,17 +3253,17 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! ENDDO !rho-weighted: - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=sqc(k) + dtz(k)*flqc + qcd(k)*delt - dtz(k)*s_awqc(k+1) + & & det_sqc(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=sqc(k) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + & & det_sqc(k)*delt ENDDO @@ -3283,17 +3310,17 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! ENDDO !rho-weighted: - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*s_awqv(k+1) + & & sub_sqv(k)*delt + det_sqv(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) d(k)=sqv(k) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + & & sub_sqv(k)*delt + det_sqv(k)*delt ENDDO @@ -3348,15 +3375,15 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! ENDDO !rho-weighted: - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - c(k)= -dtz(k)*khdz(k+1)/rho(k) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) d(k)=sqi(k) DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) - c(k)= -dtz(k)*khdz(k+1)/rho(k) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) d(k)=sqi(k) ENDDO @@ -3398,16 +3425,16 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qni(k) - dtz(k)*s_awqni(k+1)*nonloc DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*nonloc + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qni(k) + dtz(k)*(s_awqni(k)-s_awqni(k+1))*nonloc ENDDO @@ -3439,16 +3466,16 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnc(k) - dtz(k)*s_awqnc(k+1)*nonloc DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*nonloc + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnc(k) + dtz(k)*(s_awqnc(k)-s_awqnc(k+1))*nonloc ENDDO @@ -3479,17 +3506,17 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))/rho(k) - & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) - & & 0.5*dtz(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnwfa(k) - dtz(k)*s_awqnwfa(k+1)*nonloc DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*nonloc + b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnwfa(k) + dtz(k)*(s_awqnwfa(k)-s_awqnwfa(k+1))*nonloc ENDDO @@ -3521,17 +3548,17 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))/rho(k) - & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) - & & 0.5*dtz(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnifa(k) - dtz(k)*s_awqnifa(k+1)*nonloc DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*nonloc + b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnifa(k) + dtz(k)*(s_awqnifa(k)-s_awqnifa(k+1))*nonloc ENDDO @@ -3562,15 +3589,15 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts !rho-weighted: - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - c(k)= -dtz(k)*khdz(k+1)/rho(k) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) d(k)=ozone(k) DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) - c(k)= -dtz(k)*khdz(k+1)/rho(k) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) d(k)=ozone(k) ENDDO @@ -4440,7 +4467,8 @@ SUBROUTINE mynn_bl_driver( & !! within mym_initialize(): mym_level2() and mym_length(). CALL mym_initialize ( & &kts,kte, & - &dz1, zw, u1, v1, thl, sqv, & + &dz1, dx(i,j), zw, & + &u1, v1, thl, sqv, & &PBLH(i,j), th1, sh, & &ust(i,j), rmol(i,j), & &el, Qke1, Tsq1, Qsq1, Cov1, & @@ -4816,7 +4844,7 @@ SUBROUTINE mynn_bl_driver( & !More strict limits over land to reduce stable-layer mixouts if ((xland(i,j)-1.5).GE.0)THEN ! WATER - radsum=MIN(radsum,120.0) + radsum=MIN(radsum,90.0) bfx0 = max(radsum/rho1(k)/cp,0.) else ! LAND radsum=MIN(0.25*radsum,30.0)!practically turn off over land @@ -4871,7 +4899,7 @@ SUBROUTINE mynn_bl_driver( & &qnc1,qni1,qnwfa1,qnifa1, & &ex1,Vt,Vq,sgm, & &ust(i,j),flt,flq,flqv,flqc, & - &PBLH(i,j),KPBL(i,j),DX(i,j), & + &PBLH(i,j),KPBL(i,j),DX(i,j), & &xland(i,j),th_sfc, & ! now outputs - tendencies ! &,dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf & @@ -4908,7 +4936,8 @@ SUBROUTINE mynn_bl_driver( & !! to carry out successive claculations. CALL mym_turbulence ( & &kts,kte,levflag, & - &dz1, zw, u1, v1, thl, sqc, sqw, & + &dz1, DX(i,j), zw, & + &u1, v1, thl, sqc, sqw, & &qke1, tsq1, qsq1, cov1, & &vt, vq, & &rmol(i,j), flt, flq, & @@ -5875,7 +5904,7 @@ SUBROUTINE DMP_mf( & !w-dependency for entrainment a la Tian and Kuang (2016) !ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.9)*l) wmin = 0.3 + l*0.0005 !* MAX(pblh-ZW(k+1), 0.0)/pblh - ENT(k,i) = 0.31/(MIN(MAX(UPW(K-1,I),wmin),1.9)*l) + ENT(k,i) = 0.33/(MIN(MAX(UPW(K-1,I),wmin),1.9)*l) !Entrainment from Negggers (2015, JAMES) !ENT(k,i) = 0.02*l**-0.35 - 0.0009 !Minimum background entrainment From 49b7f3ca7757efde79f8480d906f8cc4457045dd Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 5 Jun 2020 23:26:07 +0000 Subject: [PATCH 140/141] Update to MYNN sfc layer scheme --- physics/module_MYNNSFC_wrapper.F90 | 21 +- physics/module_MYNNSFC_wrapper.meta | 68 ++++ physics/module_sf_mynn.F90 | 525 ++++++++++++++++++++++++++-- 3 files changed, 574 insertions(+), 40 deletions(-) diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 5693c49a8..b2eaed414 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -19,14 +19,19 @@ end subroutine mynnsfc_wrapper_finalize !>\defgroup gsd_mynn_sfc GSD MYNN Surface Layer Scheme Module !> \brief This scheme (1) performs pre-mynnsfc work, (2) runs the mynn sfc layer scheme, and (3) performs post-mynnsfc work +#if 0 !! \section arg_table_mynnsfc_wrapper_run Argument Table !! \htmlinclude mynnsfc_wrapper_run.html !! +#endif !###=================================================================== SUBROUTINE mynnsfc_wrapper_run( & & im,levs, & & itimestep,iter, & & flag_init,flag_restart,lsm, & + & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) + & z0pert,ztpert, & !intent(in) + & redrag,sfc_z0_type, & !intent(in) & delt,dx, & & u, v, t3d, qvsh, qc, prsl, phii, & & exner, ps, PBLH, slmsk, & @@ -101,6 +106,15 @@ SUBROUTINE mynnsfc_wrapper_run( & & iz0tlnd = 0, & & isfflx = 1 + integer, intent(in) :: ivegsrc + integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean + logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) + +!Input data + integer, dimension(im), intent(in) :: vegtype + real(kind=kind_phys), dimension(im), intent(in) :: & + & sigmaf,shdmax,z0pert,ztpert + !MYNN-1D REAL :: delt INTEGER :: im, levs @@ -235,8 +249,11 @@ SUBROUTINE mynnsfc_wrapper_run( & CP=cp,G=g,ROVCP=rcp,R=r_d,XLV=xlv, & SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0, & EP1=ep_1,EP2=ep_2,KARMAN=karman, & - ISFFLX=isfflx,isftcflx=isftcflx,LSM=lsm, & - iz0tlnd=iz0tlnd,itimestep=itimestep,iter=iter, & + ISFFLX=isfflx,isftcflx=isftcflx,LSM=lsm,iz0tlnd=iz0tlnd, & + & sigmaf=sigmaf,vegtype=vegtype,shdmax=shdmax,ivegsrc=ivegsrc, & !intent(in) + & z0pert=z0pert,ztpert=ztpert, & !intent(in) + & redrag=redrag,sfc_z0_type=sfc_z0_type, & !intent(in) + itimestep=itimestep,iter=iter, & wet=wet, dry=dry, icy=icy, & !intent(in) tskin_ocn=tskin_ocn, tskin_lnd=tskin_lnd, tskin_ice=tskin_ice, & !intent(in) tsurf_ocn=tsurf_ocn, tsurf_lnd=tsurf_lnd, tsurf_ice=tsurf_ice, & !intent(in) diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 61ddb4fd0..73bf1a462 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -57,6 +57,74 @@ type = integer intent = in optional = F +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[shdmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractnl cover of green veg + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[z0pert] + standard_name = perturbation_of_momentum_roughness_length + long_name = perturbation of momentum roughness length + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ztpert] + standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio + long_name = perturbation of heat to momentum roughness length ratio + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[redrag] + standard_name = flag_for_reduced_drag_coefficient_over_sea + long_name = flag for reduced drag coefficient over sea + units = flag + dimensions = () + type = logical + intent = in + optional = F +[sfc_z0_type] + standard_name = flag_for_surface_roughness_option_over_ocean + long_name = surface roughness options over ocean + units = flag + dimensions = () + type = integer + intent = in + optional = F [delt] standard_name = time_step_for_physics long_name = time step for physics diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 73ef5e1fb..777a3d53f 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -26,20 +26,22 @@ MODULE module_sf_mynn ! roughness lengths (defaults are recommended): ! ! LAND only: -! "iz0tlnd" namelist option is used to select the following options: +! "iz0tlnd" namelist option is used to select the following momentum options: ! (default) =0: Zilitinkevich (1995); Czil now set to 0.085 ! =1: Czil_new (modified according to Chen & Zhang 2008) ! =2: Modified Yang et al (2002, 2008) - generalized for all landuse ! =3: constant zt = z0/7.4 (original form; Garratt 1992) +! =4: GFS - taken from sfc_diff.f, for comparison/testing ! ! WATER only: -! "isftcflx" namelist option is used to select the following options: +! "isftcflx" namelist option is used to select the following scalar options: ! (default) =0: z0, zt, and zq from the COARE algorithm. Set COARE_OPT (below) to ! 3.0 (Fairall et al. 2003, default) ! 3.5 (Edson et al 2013) ! =1: z0 from Davis et al (2008), zt & zq from COARE 3.0/3.5 ! =2: z0 from Davis et al (2008), zt & zq from Garratt (1992) ! =3: z0 from Taylor and Yelland (2004), zt and zq from COARE 3.0/3.5 +! =4: GFS - taken from sfc_diff.f, for comparison/testing ! ! SNOW/ICE only: ! Andreas (2002) snow/ice parameterization for thermal and @@ -78,6 +80,9 @@ MODULE module_sf_mynn & EP_1 => con_fvirt, & & EP_2 => con_eps +!use subroutines from sfc_diff: +! USE sfc_diff, only: znot_t_v6, znot_t_v7, znot_m_v6, znot_m_v7 + !------------------------------------------------------------------- IMPLICIT NONE !------------------------------------------------------------------- @@ -99,6 +104,7 @@ MODULE module_sf_mynn REAL, PARAMETER :: onethird = 1./3. REAL, PARAMETER :: sqrt3 = 1.7320508075688773 REAL, PARAMETER :: atan1 = 0.785398163397 !in radians + REAL, PARAMETER :: log01=log(0.01), log05=log(0.05), log07=log(0.07) REAL, PARAMETER :: SNOWZ0=0.011 REAL, PARAMETER :: COARE_OPT=3.0 ! 3.0 or 3.5 !For debugging purposes: @@ -141,6 +147,9 @@ SUBROUTINE SFCLAY_mynn( & CP,G,ROVCP,R,XLV, & !in SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, & !in ISFFLX,isftcflx,lsm,iz0tlnd, & !in + & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) + & z0pert,ztpert, & !intent(in) + & redrag,sfc_z0_type, & !intent(in) itimestep,iter, & !in wet, dry, icy, & !intent(in) tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) @@ -271,11 +280,18 @@ SUBROUTINE SFCLAY_mynn( & REAL, INTENT(IN) :: SVP1,SVP2,SVP3,SVPT0 REAL, INTENT(IN) :: EP1,EP2,KARMAN REAL, INTENT(IN) :: CP,G,ROVCP,R,XLV !,DX -!NAMELIST OPTIONS: +!NAMELIST/CONFIGURATION OPTIONS: INTEGER, INTENT(IN) :: ISFFLX, LSM INTEGER, OPTIONAL, INTENT(IN) :: ISFTCFLX, IZ0TLND INTEGER, OPTIONAL, INTENT(IN) :: spp_pbl - + integer, intent(in) :: ivegsrc + integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean + logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) + +!Input data + integer, dimension(ims:ime), intent(in) :: vegtype + real, dimension(ims:ime), intent(in) :: & + & sigmaf,shdmax,z0pert,ztpert !=================================== ! 3D VARIABLES !=================================== @@ -432,7 +448,11 @@ SUBROUTINE SFCLAY_mynn( & XLAND(ims,j),DX(ims,j), & CP,G,ROVCP,R,XLV,SVP1,SVP2,SVP3,SVPT0, & EP1,EP2,KARMAN, & - ISFFLX,isftcflx,iz0tlnd,itimestep,iter, & + ISFFLX,isftcflx,iz0tlnd, & + & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) + & z0pert,ztpert, & !intent(in) + & redrag,sfc_z0_type, & !intent(in) + itimestep,iter, & wet, dry, icy, & !intent(in) tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) @@ -479,7 +499,11 @@ SUBROUTINE SFCLAY1D_mynn( & PSFCPA,PBLH,MAVAIL,XLAND,DX, & CP,G,ROVCP,R,XLV,SVP1,SVP2,SVP3,SVPT0, & EP1,EP2,KARMAN, & - ISFFLX,isftcflx,iz0tlnd,itimestep,iter, & + ISFFLX,isftcflx,iz0tlnd, & + & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) + & z0pert,ztpert, & !intent(in) + & redrag,sfc_z0_type, & !intent(in) + itimestep,iter, & wet, dry, icy, & !intent(in) tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) @@ -529,6 +553,14 @@ SUBROUTINE SFCLAY1D_mynn( & INTEGER, INTENT(IN) :: ISFFLX INTEGER, OPTIONAL, INTENT(IN ) :: ISFTCFLX, IZ0TLND INTEGER, INTENT(IN) :: spp_pbl + integer, intent(in) :: ivegsrc + integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean + logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) + +!Input data + integer, dimension(ims:ime), intent(in) :: vegtype + real, dimension(ims:ime), intent(in) :: & + & sigmaf,shdmax,z0pert,ztpert !----------------------------- ! 1D ARRAYS @@ -837,7 +869,7 @@ SUBROUTINE SFCLAY1D_mynn( & ! Mahrt and Sun low-res correction - modified for water points (halved) ! (for 13 km ~ 0.18 m/s; for 3 km == 0 m/s) !-------------------------------------------------------- - VSGD = MIN( 0.16 * (max(dx(i)/5000.-1.,0.))**onethird , 0.25) + VSGD = MIN( 0.25 * (max(dx(i)/5000.-1.,0.))**onethird , 0.5) WSPD_ocn=SQRT(WSPD(I)*WSPD(I)+WSTAR(I)*WSTAR(I)+vsgd*vsgd) WSPD_ocn=MAX(WSPD_ocn,wmin) !-------------------------------------------------------- @@ -968,44 +1000,41 @@ SUBROUTINE SFCLAY1D_mynn( & !-------------------------------------- ! WATER !-------------------------------------- - ! CALCULATE z0 (znt) - !-------------------------------------- - IF (debug_code >= 1) THEN - write(*,*)"=============Input to ZNT over water:" - write(*,*)"u*:",UST_ocn(i)," wspd=",WSPD(i)," visc=",visc," za=",ZA(I) - ENDIF - IF ( PRESENT(ISFTCFLX) ) THEN - IF ( ISFTCFLX .EQ. 0 ) THEN - IF (COARE_OPT .EQ. 3.0) THEN - !COARE 3.0 (MISLEADING SUBROUTINE NAME) - CALL charnock_1955(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) - ELSE - !COARE 3.5 - CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) + if (sfc_z0_type >= 0) then ! Avoid calculation is using wave model + ! CALCULATE z0 (znt) + !-------------------------------------- + IF (debug_code >= 1) THEN + write(*,*)"=============Input to ZNT over water:" + write(*,*)"u*:",UST_ocn(i)," wspd=",WSPD(i)," visc=",visc," za=",ZA(I) + ENDIF + IF ( PRESENT(ISFTCFLX) ) THEN + IF ( ISFTCFLX .EQ. 0 ) THEN + IF (COARE_OPT .EQ. 3.0) THEN + !COARE 3.0 (MISLEADING SUBROUTINE NAME) + CALL charnock_1955(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) + ELSE + !COARE 3.5 + CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) + ENDIF + ELSEIF ( ISFTCFLX .EQ. 1 .OR. ISFTCFLX .EQ. 2 ) THEN + CALL davis_etal_2008(ZNT_ocn(i),UST_ocn(i)) + ELSEIF ( ISFTCFLX .EQ. 3 ) THEN + CALL Taylor_Yelland_2001(ZNT_ocn(i),UST_ocn(i),WSPD(i)) + ELSEIF ( ISFTCFLX .EQ. 4 ) THEN + !GFS surface layer scheme + CALL GFS_z0_ocn(ZNT_ocn(i),UST_ocn(i),WSPD(i),ZA(I),sfc_z0_type,redrag) ENDIF - ELSEIF ( ISFTCFLX .EQ. 1 .OR. ISFTCFLX .EQ. 2 ) THEN - CALL davis_etal_2008(ZNT_ocn(i),UST_ocn(i)) - ELSEIF ( ISFTCFLX .EQ. 3 ) THEN - CALL Taylor_Yelland_2001(ZNT_ocn(i),UST_ocn(i),WSPD(i)) - ELSEIF ( ISFTCFLX .EQ. 4 ) THEN + ELSE + !DEFAULT TO COARE 3.0/3.5 IF (COARE_OPT .EQ. 3.0) THEN - !COARE 3.0 (MISLEADING SUBROUTINE NAME) + !COARE 3.0 CALL charnock_1955(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) ELSE !COARE 3.5 CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) ENDIF ENDIF - ELSE - !DEFAULT TO COARE 3.0/3.5 - IF (COARE_OPT .EQ. 3.0) THEN - !COARE 3.0 - CALL charnock_1955(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) - ELSE - !COARE 3.5 - CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) - ENDIF - ENDIF + endif !-end wave model check ! add stochastic perturbation of ZNT if (spp_pbl==1) then @@ -1061,6 +1090,10 @@ SUBROUTINE SFCLAY1D_mynn( & CALL fairall_etal_2014(ZT_ocn(i),ZQ_ocn(i),restar,UST_ocn(i),visc,& rstoch1D(i),spp_pbl) ENDIF + ELSEIF ( ISFTCFLX .EQ. 4 ) THEN + !GFS zt formulation + CALL GFS_zt_ocn(ZT_ocn(i),ZNTstoch_ocn(i),restar,WSPD(i),ZA(i),sfc_z0_type) + ZQ_ocn(i)=ZT_ocn(i) ENDIF ELSE !DEFAULT TO COARE 3.0/3.5 @@ -1089,6 +1122,10 @@ SUBROUTINE SFCLAY1D_mynn( & IF (dry(I)) THEN + if ( IZ0TLND .EQ. 4 ) then + CALL GFS_z0_lnd(ZNT_lnd(i),shdmax(i),ZA(i),vegtype(i),ivegsrc,z0pert(i)) + endif + ! add stochastic perturbaction of ZNT if (spp_pbl==1) then ZNTstoch_lnd(I) = MAX(ZNT_lnd(I) + ZNT_lnd(I)*1.0*rstoch1D(i), 1e-6) @@ -1118,6 +1155,10 @@ SUBROUTINE SFCLAY1D_mynn( & ELSEIF ( IZ0TLND .EQ. 3 ) THEN !Original MYNN in WRF-ARW used this form: CALL garratt_1992(ZT_lnd(i),ZQ_lnd(i),ZNTSTOCH_lnd(i),restar,1.0) + ELSEIF ( IZ0TLND .EQ. 4 ) THEN + !GFS: + CALL GFS_zt_lnd(ZT_lnd(i),ZNTSTOCH_lnd(i),sigmaf(i),ztpert(i),UST_lnd(i)) + ZQ_lnd(i)=ZT_lnd(i) ENDIF ELSE !DEFAULT TO ZILITINKEVICH @@ -1136,7 +1177,7 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF !end land point - IF (icy(I)) THEN + IF (icy(I) .OR. snowh_lnd(i) > 50.) THEN ! add stochastic perturbaction of ZNT if (spp_pbl==1) then @@ -2423,6 +2464,414 @@ SUBROUTINE Yang_2008(Z_0,Zt,Zq,ustar,tstar,qst,Ren,visc) END SUBROUTINE Yang_2008 !-------------------------------------------------------------------- +! Taken from the GFS (sfc_diff.f) for comparison + SUBROUTINE GFS_z0_lnd(z0max,shdmax,z1,vegtype,ivegsrc,z0pert) + + REAL, INTENT(OUT) :: z0max + REAL, INTENT(IN) :: shdmax,z1,z0pert + INTEGER, INTENT(IN):: vegtype,ivegsrc + REAL :: tem1, tem2 + +! z0max = max(1.0e-6, min(0.01 * z0max, z1)) +!already converted into meters in the wrapper + z0max = max(1.0e-6, min(z0max, z1)) +!** xubin's new z0 over land + tem1 = 1.0 - shdmax + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 + + if( ivegsrc == 1 ) then + + if (vegtype == 10) then + z0max = exp( tem2*log01 + tem1*log07 ) + elseif (vegtype == 6) then + z0max = exp( tem2*log01 + tem1*log05 ) + elseif (vegtype == 7) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max = 0.01 + elseif (vegtype == 16) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max = 0.01 + else + z0max = exp( tem2*log01 + tem1*log(z0max) ) + endif + + elseif (ivegsrc == 2 ) then + + if (vegtype == 7) then + z0max = exp( tem2*log01 + tem1*log07 ) + elseif (vegtype == 8) then + z0max = exp( tem2*log01 + tem1*log05 ) + elseif (vegtype == 9) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max = 0.01 + elseif (vegtype == 11) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max = 0.01 + else + z0max = exp( tem2*log01 + tem1*log(z0max) ) + endif + + endif + +! mg, sfc-perts: add surface perturbations to z0max over land + if (z0pert /= 0.0 ) then + z0max = z0max * (10.**z0pert) + endif + + z0max = max(z0max, 1.0e-6) + + END SUBROUTINE GFS_z0_lnd +!-------------------------------------------------------------------- +! Taken from the GFS (sfc_diff.f) for comparison + SUBROUTINE GFS_zt_lnd(ztmax,z0max,sigmaf,ztpert,ustar_lnd) + + REAL, INTENT(OUT) :: ztmax + REAL, INTENT(IN) :: z0max,sigmaf,ztpert,ustar_lnd + REAL :: czilc, tem1, tem2 + REAL, PARAMETER :: ca = 0.4 + +! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil + czilc = 0.8 + + tem1 = 1.0 - sigmaf + ztmax = z0max*exp( - tem1*tem1 & + & * czilc*ca*sqrt(ustar_lnd*(0.01/1.5e-05))) +! +! czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) +! ztmax = z0max * exp( - czilc * ca & +! & * 258.2 * sqrt(ustar_lnd*z0max) ) + + +! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land + if (ztpert /= 0.0) then + ztmax = ztmax * (10.**ztpert) + endif + ztmax = max(ztmax, 1.0e-6) + + END SUBROUTINE GFS_zt_lnd +!-------------------------------------------------------------------- + SUBROUTINE GFS_z0_ocn(z0rl_ocn,ustar_ocn,WSPD,z1,sfc_z0_type,redrag) + + REAL, INTENT(OUT) :: z0rl_ocn + REAL, INTENT(INOUT):: ustar_ocn + REAL, INTENT(IN) :: wspd,z1 + LOGICAL, INTENT(IN):: redrag + INTEGER, INTENT(IN):: sfc_z0_type + REAL :: z0,z0max,wind10m + REAL, PARAMETER :: charnock = 0.014, z0s_max=.317e-2 + +! z0 = 0.01 * z0rl_ocn +!Already converted to meters in the wrapper + z0 = z0rl_ocn + z0max = max(1.0e-6, min(z0,z1)) + ustar_ocn = sqrt(g * z0 / charnock) + wind10m = wspd*log(10./1e-4)/log(z1/1e-4) + !wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) +! + if (sfc_z0_type >= 0) then + if (sfc_z0_type == 0) then + z0 = (charnock / g) * ustar_ocn * ustar_ocn + +! mbek -- toga-coare flux algorithm +! z0 = (charnock / g) * ustar(i)*ustar(i) + arnu/ustar(i) +! new implementation of z0 +! cc = ustar(i) * z0 / rnu +! pp = cc / (1. + cc) +! ff = g * arnu / (charnock * ustar(i) ** 3) +! z0 = arnu / (ustar(i) * ff ** pp) + + if (redrag) then + !z0rl_ocn = 100.0 * max(min(z0, z0s_max), 1.e-7) + z0rl_ocn = max(min(z0, z0s_max), 1.e-7) + else + !z0rl_ocn = 100.0 * max(min(z0,.1), 1.e-7) + z0rl_ocn = 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 = 100.0 * z0 ! cm + elseif (sfc_z0_type == 7) then ! wang + call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m + !z0rl_ocn = 100.0 * z0 ! cm + else + z0rl_ocn = 1.0e-6 + endif + + endif + + END SUBROUTINE GFS_z0_ocn +!-------------------------------------------------------------------- + SUBROUTINE GFS_zt_ocn(ztmax,z0rl_ocn,restar,WSPD,z1,sfc_z0_type) + + REAL, INTENT(OUT) :: ztmax + REAL, INTENT(IN) :: wspd,z1,z0rl_ocn,restar + INTEGER, INTENT(IN):: sfc_z0_type + REAL :: z0,z0max,wind10m,rat,ustar_ocn + REAL, PARAMETER :: charnock = 0.014, z0s_max=.317e-2 + +! z0 = 0.01 * z0rl_ocn +!Already converted to meters in the wrapper + z0 = z0rl_ocn + z0max = max(1.0e-6, min(z0,z1)) + ustar_ocn = sqrt(g * z0 / charnock) + wind10m = wspd*log(10./1e-4)/log(z1/1e-4) + +!** test xubin's new z0 + +! ztmax = z0max + +!input restar = max(ustar_ocn(i)*z0max*visi, 0.000001) + +! restar = log(restar) +! restar = min(restar,5.) +! restar = max(restar,-5.) +! rat = aa1 + (bb1 + cc1*restar) * restar +! rat = rat / (1. + (bb2 + cc2*restar) * restar)) +! rat taken from zeng, zhao and dickinson 1997 + + rat = min(7.0, 2.67 * sqrt(sqrt(restar)) - 2.57) + ztmax = max(z0max * exp(-rat), 1.0e-6) +! + if (sfc_z0_type == 6) then + 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 + write(0,*)'no option for sfc_z0_type=',sfc_z0_type + stop + endif + + END SUBROUTINE GFS_zt_ocn +!-------------------------------------------------------------------- +!! add fitted z0,zt curves for hurricane application (used in HWRF/HMON) +!! Weiguo Wang, 2019-0425 + + SUBROUTINE znot_m_v6(uref, znotm) + use machine , only : kind_phys + IMPLICIT NONE +! Calculate areodynamical roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) +! For high winds, try to fit available observational data +! +! Bin Liu, NOAA/NCEP/EMC 2017 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + REAL(kind=kind_phys), INTENT(IN) :: uref + REAL(kind=kind_phys), INTENT(OUT):: znotm + real(kind=kind_phys), parameter :: p13 = -1.296521881682694e-02,& + & p12 = 2.855780863283819e-01, p11 = -1.597898515251717e+00,& + & p10 = -8.396975715683501e+00, & + + & p25 = 3.790846746036765e-10, p24 = 3.281964357650687e-09,& + & p23 = 1.962282433562894e-07, p22 = -1.240239171056262e-06,& + & p21 = 1.739759082358234e-07, p20 = 2.147264020369413e-05,& + + & p35 = 1.840430200185075e-07, p34 = -2.793849676757154e-05,& + & p33 = 1.735308193700643e-03, p32 = -6.139315534216305e-02,& + & p31 = 1.255457892775006e+00, p30 = -1.663993561652530e+01,& + + & p40 = 4.579369142033410e-04 + + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp(p10 + uref * (p11 + uref * (p12 + uref*p13))) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p20 + uref * (p21 + uref * (p22 + uref * (p23 & + & + uref * (p24 + uref * p25)))) + elseif (uref > 15.7 .and. uref <= 53.0) then + znotm = exp( p30 + uref * (p31 + uref * (p32 + uref * (p33 & + & + uref * (p34 + uref * p35))))) + elseif ( uref > 53.0) then + znotm = p40 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_m_v6 +!-------------------------------------------------------------------- + SUBROUTINE znot_t_v6(uref, znott) + + IMPLICIT NONE +! Calculate scalar roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +! +! Bin Liu, NOAA/NCEP/EMC 2017 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znott + real, parameter :: p00 = 1.100000000000000e-04,& + & p15 = -9.144581627678278e-10, p14 = 7.020346616456421e-08,& + & p13 = -2.155602086883837e-06, p12 = 3.333848806567684e-05,& + & p11 = -2.628501274963990e-04, p10 = 8.634221567969181e-04,& + + & p25 = -8.654513012535990e-12, p24 = 1.232380050058077e-09,& + & p23 = -6.837922749505057e-08, p22 = 1.871407733439947e-06,& + & p21 = -2.552246987137160e-05, p20 = 1.428968311457630e-04,& + + & p35 = 3.207515102100162e-12, p34 = -2.945761895342535e-10,& + & p33 = 8.788972147364181e-09, p32 = -3.814457439412957e-08,& + & p31 = -2.448983648874671e-06, p30 = 3.436721779020359e-05,& + + & p45 = -3.530687797132211e-11, p44 = 3.939867958963747e-09,& + & p43 = -1.227668406985956e-08, p42 = -1.367469811838390e-05,& + & p41 = 5.988240863928883e-04, p40 = -7.746288511324971e-03,& + + & p56 = -1.187982453329086e-13, p55 = 4.801984186231693e-11,& + & p54 = -8.049200462388188e-09, p53 = 7.169872601310186e-07,& + & p52 = -3.581694433758150e-05, p51 = 9.503919224192534e-04,& + & p50 = -1.036679430885215e-02, & + + & p60 = 4.751256171799112e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p10 + uref * (p11 + uref * (p12 + uref * (p13 & + & + uref * (p14 + uref * p15)))) + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p20 + uref * (p21 + uref * (p22 + uref * (p23 & + & + uref * (p24 + uref * p25)))) + elseif (uref > 21.6 .and. uref <= 42.2) then + znott = p30 + uref * (p31 + uref * (p32 + uref * (p33 & + & + uref * (p34 + uref * p35)))) + elseif ( uref > 42.2 .and. uref <= 53.3) then + znott = p40 + uref * (p41 + uref * (p42 + uref * (p43 & + & + uref * (p44 + uref * p45)))) + elseif ( uref > 53.3 .and. uref <= 80.0) then + znott = p50 + uref * (p51 + uref * (p52 + uref * (p53 & + & + uref * (p54 + uref * (p55 + uref * p56))))) + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_t_v6 + +!------------------------------------------------------------------- + + SUBROUTINE znot_m_v7(uref, znotm) + + IMPLICIT NONE +! Calculate areodynamical roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) +! For high winds, try to fit available observational data +! Comparing to znot_t_v6, slightly decrease Cd for higher wind speed +! +! Bin Liu, NOAA/NCEP/EMC 2018 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znotm + + real, parameter :: p13 = -1.296521881682694e-02,& + & p12 = 2.855780863283819e-01, p11 = -1.597898515251717e+00,& + & p10 = -8.396975715683501e+00,& + + & p25 = 3.790846746036765e-10, p24 = 3.281964357650687e-09,& + & p23 = 1.962282433562894e-07, p22 = -1.240239171056262e-06,& + & p21 = 1.739759082358234e-07, p20 = 2.147264020369413e-05,& + + & p35 = 1.897534489606422e-07, p34 = -3.019495980684978e-05,& + & p33 = 1.931392924987349e-03, p32 = -6.797293095862357e-02,& + & p31 = 1.346757797103756e+00, p30 = -1.707846930193362e+01,& + + & p40 = 3.371427455376717e-04 + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp( p10 + uref * (p11 + uref * (p12 + uref * p13))) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p20 + uref * (p21 + uref * (p22 + uref * (p23 & + & + uref * (p24 + uref * p25)))) + elseif (uref > 15.7 .and. uref <= 53.0) then + znotm = exp( p30 + uref * (p31 + uref * (p32 + uref * (p33 & + & + uref * (p34 + uref * p35))))) + elseif ( uref > 53.0) then + znotm = p40 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_m_v7 +!-------------------------------------------------------------------- + SUBROUTINE znot_t_v7(uref, znott) + + IMPLICIT NONE +! Calculate scalar roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +! To be compatible with the slightly decreased Cd for higher wind speed +! +! Bin Liu, NOAA/NCEP/EMC 2018 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znott + + real, parameter :: p00 = 1.100000000000000e-04, & + + & p15 = -9.193764479895316e-10, p14 = 7.052217518653943e-08,& + & p13 = -2.163419217747114e-06, p12 = 3.342963077911962e-05,& + & p11 = -2.633566691328004e-04, p10 = 8.644979973037803e-04,& + + & p25 = -9.402722450219142e-12, p24 = 1.325396583616614e-09,& + & p23 = -7.299148051141852e-08, p22 = 1.982901461144764e-06,& + & p21 = -2.680293455916390e-05, p20 = 1.484341646128200e-04,& + + & p35 = 7.921446674311864e-12, p34 = -1.019028029546602e-09,& + & p33 = 5.251986927351103e-08, p32 = -1.337841892062716e-06,& + & p31 = 1.659454106237737e-05, p30 = -7.558911792344770e-05,& + + & p45 = -2.694370426850801e-10, p44 = 5.817362913967911e-08,& + & p43 = -5.000813324746342e-06, p42 = 2.143803523428029e-04,& + & p41 = -4.588070983722060e-03, p40 = 3.924356617245624e-02,& + + & p56 = -1.663918773476178e-13, p55 = 6.724854483077447e-11,& + & p54 = -1.127030176632823e-08, p53 = 1.003683177025925e-06,& + & p52 = -5.012618091180904e-05, p51 = 1.329762020689302e-03,& + & p50 = -1.450062148367566e-02, p60 = 6.840803042788488e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p10 + uref * (p11 + uref * (p12 + uref * (p13 & + & + uref * (p14 + uref * p15)))) + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p20 + uref * (p21 + uref * (p22 + uref * (p23 & + & + uref * (p24 + uref * p25)))) + elseif (uref > 21.6 .and. uref <= 42.6) then + znott = p30 + uref * (p31 + uref * (p32 + uref * (p33 & + & + uref * (p34 + uref * p35)))) + elseif ( uref > 42.6 .and. uref <= 53.0) then + znott = p40 + uref * (p41 + uref * (p42 + uref * (p43 & + & + uref * (p44 + uref * p45)))) + elseif ( uref > 53.0 .and. uref <= 80.0) then + znott = p50 + uref * (p51 + uref * (p52 + uref * (p53 & + & + uref * (p54 + uref * (p55 + uref * p56))))) + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_t_v7 + +!-------------------------------------------------------------------- !>\ingroup module_sf_mynn_mod !> This is taken from Andreas (2002; J. of Hydromet) and !! Andreas et al. (2005; BLM). From 43821e3e426bc12950c91e370add48743bb7e901 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Mon, 8 Jun 2020 21:19:34 +0000 Subject: [PATCH 141/141] 2 small cosmetic updates, no impact on model behavior. --- physics/module_MYNNPBL_wrapper.meta | 1 + physics/module_MYNNSFC_wrapper.F90 | 2 -- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index c577b2563..1ab7af8b4 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -27,6 +27,7 @@ intent = out optional = F +##################################################################### [ccpp-arg-table] name = mynnedmf_wrapper_run type = scheme diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index b2eaed414..d14932e07 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -19,11 +19,9 @@ end subroutine mynnsfc_wrapper_finalize !>\defgroup gsd_mynn_sfc GSD MYNN Surface Layer Scheme Module !> \brief This scheme (1) performs pre-mynnsfc work, (2) runs the mynn sfc layer scheme, and (3) performs post-mynnsfc work -#if 0 !! \section arg_table_mynnsfc_wrapper_run Argument Table !! \htmlinclude mynnsfc_wrapper_run.html !! -#endif !###=================================================================== SUBROUTINE mynnsfc_wrapper_run( & & im,levs, &