From 3e2f892fd13c78a7fc11dce946c0eac714b89007 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 30 Aug 2019 16:07:57 -0600 Subject: [PATCH 1/2] add calculation of sncovr to GFS_surface_generic_pre_run (not to init because it was originally done after the call to ccpp_physics_init in FV3GFS_io.F90/sfc_prop_restart_read --- physics/GFS_surface_generic.F90 | 45 ++++++++++++++++++++++++++++----- 1 file changed, 38 insertions(+), 7 deletions(-) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 8acf186c1..c867a50dd 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -21,6 +21,7 @@ end subroutine GFS_surface_generic_pre_finalize !! |----------------|------------------------------------------------------------------------------|------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| !! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | !! | levs | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | +!! | first_time_step | flag_for_first_time_step | flag for first time step for time integration loop (cold/warmstart) | flag | 0 | logical | | in | F | !! | vfrac | vegetation_area_fraction | areal fractional cover of green vegetation | frac | 1 | real | kind_phys | in | F | !! | islmsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | !! | isot | soil_type_dataset_choice | soil type dataset choice | index | 0 | integer | | in | F | @@ -80,22 +81,26 @@ end subroutine GFS_surface_generic_pre_finalize !! | tsfco | sea_surface_temperature | sea surface temperature | K | 1 | real | kind_phys | in | F | !! | fice | sea_ice_concentration | sea-ice concentration [0,1] | frac | 1 | real | kind_phys | in | F | !! | hice | sea_ice_thickness | sea-ice thickness | m | 1 | real | kind_phys | in | F | +!! | weasd | water_equivalent_accumulated_snow_depth | water equiv of acc snow depth over land and sea ice | mm | 1 | real | kind_phys | in | F | +!! | sncovr | surface_snow_area_fraction_over_land | surface snow area fraction | frac | 1 | real | kind_phys | inout | 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 | !! #endif - subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, stype, vtype, slope, & + subroutine GFS_surface_generic_pre_run (im, levs, first_time_step, vfrac, islmsk, isot, ivegsrc, & + stype, vtype, slope, & prsik_1, prslk_1, semis, adjsfcdlw, tsfc, phil, con_g, sigmaf, soiltyp, vegtype, & slopetyp, work3, gabsbdlw, 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, & + dtsfc_cice, dqsfc_cice, tisfc, tsfco, fice, hice, weasd, sncovr, & errmsg, errflg) use machine, only: kind_phys use surface_perturbation, only: cdfnor + use namelist_soilveg, only: salp_data, snupx implicit none @@ -106,8 +111,8 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), intent(in) :: con_g real(kind=kind_phys), dimension(im), intent(in) :: vfrac, stype, vtype, slope, prsik_1, prslk_1, & - semis, adjsfcdlw - real(kind=kind_phys), dimension(im), intent(inout) :: tsfc + semis, adjsfcdlw, weasd + real(kind=kind_phys), dimension(im), intent(inout) :: tsfc, sncovr real(kind=kind_phys), dimension(im,levs), intent(in) :: phil real(kind=kind_phys), dimension(im), intent(inout) :: sigmaf, work3, gabsbdlw, tsurf, zlvl @@ -133,7 +138,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(out) :: xlai1d real(kind=kind_phys), dimension(im), intent(out) :: vegf1d - logical, intent(in) :: cplflx + logical, intent(in) :: cplflx, first_time_step real(kind=kind_phys), dimension(im), intent(in) :: slimskin_cpl logical, dimension(im), intent(inout) :: flag_cice integer, dimension(im), intent(out) :: islmsk_cice @@ -151,14 +156,40 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, integer :: i real(kind=kind_phys) :: onebg real(kind=kind_phys) :: cdfz - + + !--- local variables for sncovr calculation + integer :: vegtyp + logical :: mand + real(kind=kind_phys) :: rsnow, tem + ! Set constants onebg = 1.0/con_g ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) + if (first_time_step) then + if (nint(sncovr(1)) == -9999) then + do i = 1, im + sncovr(i) = 0.0 + if (islmsk(i) > 0) then + ! GJF* this is different than the integer conversion below, but copied from FV3GFS_io.f90. + ! Can this block be moved to after vegetation_type_classification (integer) has been set? *GJF + vegtyp = vtype(i) + if (vegtyp == 0) vegtyp = 7 + rsnow = 0.001*weasd(i)/snupx(vegtyp) + if (0.001*weasd(i) < snupx(vegtyp)) then + sncovr(i) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + else + sncovr(i) = 1.0 + endif + endif + enddo + endif + endif + ! Set initial quantities for stochastic physics deltas if (do_sppt) then dtdtr = 0.0 From 78523cf154a75d74cf587d8f906a2bbab11457a7 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 3 Sep 2019 11:09:51 -0600 Subject: [PATCH 2/2] add calculation of sncovr to GFS_phys_time_vary_run (not to init because it was originally done after the call to ccpp_physics_init in FV3GFS_io.F90/sfc_prop_restart_read); this needs to happen before radition is called --- physics/GFS_phys_time_vary.fv3.F90 | 38 +++++++++++++++++++++---- physics/GFS_surface_generic.F90 | 45 +++++------------------------- 2 files changed, 40 insertions(+), 43 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index f66a43675..8f20300b6 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -22,6 +22,9 @@ module GFS_phys_time_vary use iccn_def, only : ciplin, ccnin, ci_pres use iccninterp, only : read_cidata, setindxci, ciinterpol + + !--- variables needed for calculating 'sncovr' + use namelist_soilveg, only: salp_data, snupx implicit none @@ -329,23 +332,25 @@ end subroutine GFS_phys_time_vary_finalize !! | Data | GFS_data_type_instance_all_blocks | Fortran DDT containing FV3-GFS data | DDT | 1 | GFS_data_type | | inout | F | !! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | !! | nthrds | omp_threads | number of OpenMP threads available for physics schemes | count | 0 | integer | | in | F | +!! | first_time_step | flag_for_first_time_step | flag for first time step for time integration loop (cold/warmstart) | flag | 0 | logical | | 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 | !! !>\section gen_GFS_phys_time_vary_run GFS_phys_time_vary_run General Algorithm !> @{ - subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) + subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, errflg) use mersenne_twister, only: random_setseed, random_number use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type, GFS_data_type - + implicit none ! Interface variables - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_data_type), intent(inout) :: Data(:) type(GFS_control_type), intent(inout) :: Model integer, intent(in) :: nthrds + logical, intent(in) :: first_time_step character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -354,8 +359,8 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - integer :: i, j, k, iseed, iskip, ix, nb, nblks, kdt_rad - real(kind=kind_phys) :: sec_zero + integer :: i, j, k, iseed, iskip, ix, nb, nblks, kdt_rad, vegtyp + real(kind=kind_phys) :: sec_zero, rsnow real(kind=kind_phys) :: wrk(1) real(kind=kind_phys) :: rannie(Model%cny) real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) @@ -508,6 +513,29 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, errmsg, errflg) enddo endif endif + + !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) + if (first_time_step) then + if (nint(Data(1)%Sfcprop%sncovr(1)) == -9999) then + !--- compute sncovr from existing variables + !--- code taken directly from read_fix.f + do nb = 1, nblks + do ix = 1, Model%blksz(nb) + Data(nb)%Sfcprop%sncovr(ix) = 0.0 + if (Data(nb)%Sfcprop%slmsk(ix) > 0.001) then + vegtyp = Data(nb)%Sfcprop%vtype(ix) + if (vegtyp == 0) vegtyp = 7 + rsnow = 0.001*Data(nb)%Sfcprop%weasd(ix)/snupx(vegtyp) + if (0.001*Data(nb)%Sfcprop%weasd(ix) < snupx(vegtyp)) then + Data(nb)%Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + else + Data(nb)%Sfcprop%sncovr(ix) = 1.0 + endif + endif + enddo + enddo + endif + endif end subroutine GFS_phys_time_vary_run !> @} diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index c867a50dd..8acf186c1 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -21,7 +21,6 @@ end subroutine GFS_surface_generic_pre_finalize !! |----------------|------------------------------------------------------------------------------|------------------------------------------------------------------|------------|------|-----------|-----------|--------|----------| !! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | !! | levs | vertical_dimension | number of vertical levels | count | 0 | integer | | in | F | -!! | first_time_step | flag_for_first_time_step | flag for first time step for time integration loop (cold/warmstart) | flag | 0 | logical | | in | F | !! | vfrac | vegetation_area_fraction | areal fractional cover of green vegetation | frac | 1 | real | kind_phys | in | F | !! | islmsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | in | F | !! | isot | soil_type_dataset_choice | soil type dataset choice | index | 0 | integer | | in | F | @@ -81,26 +80,22 @@ end subroutine GFS_surface_generic_pre_finalize !! | tsfco | sea_surface_temperature | sea surface temperature | K | 1 | real | kind_phys | in | F | !! | fice | sea_ice_concentration | sea-ice concentration [0,1] | frac | 1 | real | kind_phys | in | F | !! | hice | sea_ice_thickness | sea-ice thickness | m | 1 | real | kind_phys | in | F | -!! | weasd | water_equivalent_accumulated_snow_depth | water equiv of acc snow depth over land and sea ice | mm | 1 | real | kind_phys | in | F | -!! | sncovr | surface_snow_area_fraction_over_land | surface snow area fraction | frac | 1 | real | kind_phys | inout | 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 | !! #endif - subroutine GFS_surface_generic_pre_run (im, levs, first_time_step, vfrac, islmsk, isot, ivegsrc, & - stype, vtype, slope, & + subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, stype, vtype, slope, & prsik_1, prslk_1, semis, adjsfcdlw, tsfc, phil, con_g, sigmaf, soiltyp, vegtype, & slopetyp, work3, gabsbdlw, 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, weasd, sncovr, & + dtsfc_cice, dqsfc_cice, tisfc, tsfco, fice, hice, & errmsg, errflg) use machine, only: kind_phys use surface_perturbation, only: cdfnor - use namelist_soilveg, only: salp_data, snupx implicit none @@ -111,8 +106,8 @@ subroutine GFS_surface_generic_pre_run (im, levs, first_time_step, vfrac, islmsk real(kind=kind_phys), intent(in) :: con_g real(kind=kind_phys), dimension(im), intent(in) :: vfrac, stype, vtype, slope, prsik_1, prslk_1, & - semis, adjsfcdlw, weasd - real(kind=kind_phys), dimension(im), intent(inout) :: tsfc, sncovr + semis, adjsfcdlw + real(kind=kind_phys), dimension(im), intent(inout) :: tsfc real(kind=kind_phys), dimension(im,levs), intent(in) :: phil real(kind=kind_phys), dimension(im), intent(inout) :: sigmaf, work3, gabsbdlw, tsurf, zlvl @@ -138,7 +133,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, first_time_step, vfrac, islmsk real(kind=kind_phys), dimension(im), intent(out) :: xlai1d real(kind=kind_phys), dimension(im), intent(out) :: vegf1d - logical, intent(in) :: cplflx, first_time_step + 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 @@ -156,40 +151,14 @@ subroutine GFS_surface_generic_pre_run (im, levs, first_time_step, vfrac, islmsk integer :: i real(kind=kind_phys) :: onebg real(kind=kind_phys) :: cdfz - - !--- local variables for sncovr calculation - integer :: vegtyp - logical :: mand - real(kind=kind_phys) :: rsnow, tem - + ! Set constants onebg = 1.0/con_g ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) - if (first_time_step) then - if (nint(sncovr(1)) == -9999) then - do i = 1, im - sncovr(i) = 0.0 - if (islmsk(i) > 0) then - ! GJF* this is different than the integer conversion below, but copied from FV3GFS_io.f90. - ! Can this block be moved to after vegetation_type_classification (integer) has been set? *GJF - vegtyp = vtype(i) - if (vegtyp == 0) vegtyp = 7 - rsnow = 0.001*weasd(i)/snupx(vegtyp) - if (0.001*weasd(i) < snupx(vegtyp)) then - sncovr(i) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) - else - sncovr(i) = 1.0 - endif - endif - enddo - endif - endif - + ! Set initial quantities for stochastic physics deltas if (do_sppt) then dtdtr = 0.0