From f2a2331406680b4b21b83d96f696e3f0bc4586ac Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Tue, 2 Jul 2024 04:32:53 -0600 Subject: [PATCH 1/4] starting to add 4.49 --- src/grib2_all_tables_module.F90 | 111 +++++++++++++++++++++++++++++++- 1 file changed, 110 insertions(+), 1 deletion(-) diff --git a/src/grib2_all_tables_module.F90 b/src/grib2_all_tables_module.F90 index a222491..f020aad 100644 --- a/src/grib2_all_tables_module.F90 +++ b/src/grib2_all_tables_module.F90 @@ -2390,7 +2390,7 @@ subroutine g2sec4_temp46(icatg, iparm, aer_type, typ_intvl_size, ipdstmpl46(35) = time_inc_betwn_succ_fld ! value = 0 ! end subroutine g2sec4_temp46 - !> + !> This subroutine returns the Grib2 Section 4 Template 4.0 list for given keys !> PDT 4.48 - Analysis or forecast at a horizontal level or in a !> horizontal layer at a point in time for aerosol. @@ -2500,6 +2500,115 @@ subroutine g2sec4_temp48(icatg, iparm, aer_type, typ_intvl_size, ipdstmpl48(26) = scaled_val2 ! end subroutine g2sec4_temp48 + !> This subroutine returns the Grib2 Section 4 Template 4.0 list for given keys + !> PDT 4.48 - Analysis or forecast at a horizontal level or in a + !> horizontal layer at a point in time for aerosol. + !> + !> @param[in] icatg - Parameter category (see Code table 4.1) + !> @param[in] iparm - Parameter number (see Code table 4.2) + !> @param[in] aer_type - Aetosol type (see Code table 4.233) + !> @param[in] typ_intvl_size - Type of interval for first and second size (see Code table 4.91) + !> @param[in] scale_fac1_size - Scale factor of first size + !> @param[in] scale_val1_size - Scale value of first size in meters + !> @param[in] scale_fac2_size - Scale factor of second size + !> @param[in] scale_val2_size - Scale value of second size in meters + !> @param[in] typ_intvl_wavelength - Type of interval for first and second wavelength (see Code table 4.91) + !> @param[in] scale_fac1_wavelength - Scale factor of first wavelength + !> @param[in] scale_val1_wavelength - Scale value of first wavelength in meters + !> @param[in] scale_fac2_wavelength - Scale factor of second wavelength + !> @param[in] scale_val2_wavelength - Scale value of second wavelength in meters + !> @param[in] typ_gen_proc_key - Type of generating process (see Code table 4.3) + !> @param[in] gen_proc_or_mod_key - Analysis or forecast generating process identified (see Code ON388 Table A) + !> @param[in] hrs_obs_cutoff - Hours of observational data cutoff after reference time (see Note) + !> @param[in] min_obs_cutoff - Minutes of observational data cutoff after reference time (see Note) + !> @param[in] unit_of_time_key - Indicator of unit of time range (see Code table 4.4) + !> @param[in] fcst_time - Forecast time in units defined by octet 18 + !> @param[in] lvl_type1 - Type of first fixed surface (see Code table 4.5) + !> @param[in] scale_fac1 - Scale factor of first fixed surface + !> @param[in] scaled_val1 - Scaled value of first fixed surface + !> @param[in] lvl_type2 - Type of second fixed surfaced (see Code table 4.5) + !> @param[in] scale_fac2 - Scale factor of second fixed surface + !> @param[in] scaled_val2 - Scaled value of second fixed surfaces + !> @param[out] ipdstmpl48 - GRIB2 PDS Template 4.48 listing + !> + !> @author Edward Hartnett @date 2024-07-02 + subroutine g2sec4_temp49(icatg, iparm, aer_type, typ_intvl_size, & + scale_fac1_size, scale_val1_size, scale_fac2_size, & + scale_val2_size, typ_intvl_wavelength, & + scale_fac1_wavelength, scale_val1_wavelength, & + scale_fac2_wavelength, scale_val2_wavelength, & + typ_gen_proc_key, gen_proc_or_mod_key, & + hrs_obs_cutoff, min_obs_cutoff, & + unit_of_time_key, fcst_time, lvl_type1, scale_fac1, & + scaled_val1, lvl_type2, scale_fac2, scaled_val2, & + ipdstmpl48) + integer(4), intent(in) :: icatg, iparm, hrs_obs_cutoff, min_obs_cutoff, & + scale_fac1_size, scale_fac2_size, scale_fac1_wavelength, & + scale_fac2_wavelength, & + fcst_time, scale_fac1, scaled_val1, & + scale_fac2, scaled_val2 + real, intent(in) :: scale_val1_size, scale_val2_size, scale_val1_wavelength, & + scale_val2_wavelength + ! + character(len=*), intent(in) :: aer_type, typ_intvl_size, & + typ_intvl_wavelength, typ_gen_proc_key, & + gen_proc_or_mod_key, unit_of_time_key, lvl_type1, lvl_type2 + ! + integer(4), intent(inout) :: ipdstmpl48(26) + ! + !local vars + integer(4) :: value, ierr + integer(4) :: bckgnd_gen_proc_id ! defined by the center + ! + bckgnd_gen_proc_id=0 ! defined by the center + ! + ipdstmpl48(1) = icatg + ipdstmpl48(2) = iparm + ! + call get_g2_typeofaerosol(aer_type, value, ierr) + ipdstmpl48(3) = value + ! + call get_g2_typeofintervals(typ_intvl_size, value, ierr) + ipdstmpl48(4) = value + ipdstmpl48(5) = scale_fac1_size + ipdstmpl48(6) = nint(scale_val1_size) + ipdstmpl48(7) = scale_fac2_size + ipdstmpl48(8) = nint(scale_val2_size) + ! + call get_g2_typeofintervals(typ_intvl_wavelength, value, ierr) + ipdstmpl48(9) = value + ipdstmpl48(10) = scale_fac1_wavelength + ipdstmpl48(11) = nint(scale_val1_wavelength) + ipdstmpl48(12) = scale_fac2_wavelength + ipdstmpl48(13) = nint(scale_val2_wavelength) + ! + call get_g2_typeofgenproc(typ_gen_proc_key, value, ierr) + ipdstmpl48(14) = value + ! + ipdstmpl48(15) = bckgnd_gen_proc_id + ! + call get_g2_on388genproc(gen_proc_or_mod_key, value, ierr) + ipdstmpl48(16) = value + ! + ipdstmpl48(17) = hrs_obs_cutoff + ipdstmpl48(18) = min_obs_cutoff + ! + call get_g2_unitoftimerange(unit_of_time_key, value, ierr) + ipdstmpl48(19) = value + ipdstmpl48(20) = fcst_time + ! + call get_g2_fixedsurfacetypes(lvl_type1, value, ierr) + ipdstmpl48(21) = value + ipdstmpl48(22) = scale_fac1 + ipdstmpl48(23) = scaled_val1 + ! + call get_g2_fixedsurfacetypes(lvl_type2, value, ierr) + ipdstmpl48(24) = value + ! + ipdstmpl48(25) = scale_fac2 + ipdstmpl48(26) = scaled_val2 + ! + end subroutine g2sec4_temp49 ! ! !> This subroutine returns the corresponding GRIB2 type of From dc1714de190acbc6ed0efca7da21c27117a84e3c Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Tue, 2 Jul 2024 04:33:47 -0600 Subject: [PATCH 2/4] starting to add 4.49 --- tests/test_all_table_other.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/tests/test_all_table_other.F90 b/tests/test_all_table_other.F90 index 3b01aae..53fd54a 100644 --- a/tests/test_all_table_other.F90 +++ b/tests/test_all_table_other.F90 @@ -21,6 +21,9 @@ program test_all_table_other integer :: ipdstmpl48(26) integer :: ipdstmpl48_expected(26) = (/ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 10, 0, & 12, 15, 16, 13, 18, 20, 20, 21, 100, 22, 23 /) + integer :: ipdstmpl49(26) + integer :: ipdstmpl49_expected(26) = (/ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 10, 0, & + 12, 15, 16, 13, 18, 20, 20, 21, 100, 22, 23 /) integer :: ifield5(16) integer :: ifield5_expected(16) = (/ 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) integer :: ifield5_0(5) @@ -78,6 +81,15 @@ program test_all_table_other if (ipdstmpl48(i) .ne. ipdstmpl48_expected(i)) stop 6 end do + print *, 'testing g2sec4_temp49' + call g2sec4_temp49(0, 1, 'methane', 'greater_than_first_limit', 4, 5.0, 6, 7.0, & + 'greater_or_equal_first_limit', 9, 10., 11, 12., 'prob_wt_fcst', 'prob_st_surg', 15, 16, & + 'second', 18, 'isothermal', 20, 21, 'isobaric_sfc', 22, 23, ipdstmpl49) + do i = 1, 26 + !print *, ipdstmpl49(i) + if (ipdstmpl49(i) .ne. ipdstmpl49_expected(i)) stop 6 + end do + print *, 'testing g2sec5_temp0' call g2sec5_temp0(0, 1, 2, ifield5_0) do i = 1, 5 From 55dffdc0e9e920148838796dfcadf2b9522976e2 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Tue, 2 Jul 2024 04:45:37 -0600 Subject: [PATCH 3/4] starting to add 4.49 --- src/grib2_all_tables_module.F90 | 108 +++++++++++++++++--------------- tests/test_all_table_other.F90 | 12 ++-- 2 files changed, 63 insertions(+), 57 deletions(-) diff --git a/src/grib2_all_tables_module.F90 b/src/grib2_all_tables_module.F90 index f020aad..a590679 100644 --- a/src/grib2_all_tables_module.F90 +++ b/src/grib2_all_tables_module.F90 @@ -2500,9 +2500,12 @@ subroutine g2sec4_temp48(icatg, iparm, aer_type, typ_intvl_size, ipdstmpl48(26) = scaled_val2 ! end subroutine g2sec4_temp48 - !> This subroutine returns the Grib2 Section 4 Template 4.0 list for given keys - !> PDT 4.48 - Analysis or forecast at a horizontal level or in a - !> horizontal layer at a point in time for aerosol. + + !> This subroutine returns the Grib2 Section 4 Template 4.0 list for + !> given keys PDT 4.49 - Individual Ensemble Forecast, Control and + !> Perturbed, at a horizontal level or in a horizontal layer at a + !> point in time for Optical Properties of Aerosol for Optical + !> Properties of Aerosol. !> !> @param[in] icatg - Parameter category (see Code table 4.1) !> @param[in] iparm - Parameter number (see Code table 4.2) @@ -2529,7 +2532,7 @@ end subroutine g2sec4_temp48 !> @param[in] lvl_type2 - Type of second fixed surfaced (see Code table 4.5) !> @param[in] scale_fac2 - Scale factor of second fixed surface !> @param[in] scaled_val2 - Scaled value of second fixed surfaces - !> @param[out] ipdstmpl48 - GRIB2 PDS Template 4.48 listing + !> @param[out] ipdstmpl49 - GRIB2 PDS Template 4.48 listing !> !> @author Edward Hartnett @date 2024-07-02 subroutine g2sec4_temp49(icatg, iparm, aer_type, typ_intvl_size, & @@ -2541,7 +2544,8 @@ subroutine g2sec4_temp49(icatg, iparm, aer_type, typ_intvl_size, hrs_obs_cutoff, min_obs_cutoff, & unit_of_time_key, fcst_time, lvl_type1, scale_fac1, & scaled_val1, lvl_type2, scale_fac2, scaled_val2, & - ipdstmpl48) + ipdstmpl49) + integer(4), intent(in) :: icatg, iparm, hrs_obs_cutoff, min_obs_cutoff, & scale_fac1_size, scale_fac2_size, scale_fac1_wavelength, & scale_fac2_wavelength, & @@ -2549,68 +2553,70 @@ subroutine g2sec4_temp49(icatg, iparm, aer_type, typ_intvl_size, scale_fac2, scaled_val2 real, intent(in) :: scale_val1_size, scale_val2_size, scale_val1_wavelength, & scale_val2_wavelength - ! + character(len=*), intent(in) :: aer_type, typ_intvl_size, & typ_intvl_wavelength, typ_gen_proc_key, & gen_proc_or_mod_key, unit_of_time_key, lvl_type1, lvl_type2 - ! - integer(4), intent(inout) :: ipdstmpl48(26) - ! + + integer(4), intent(inout) :: ipdstmpl49(29) + !local vars integer(4) :: value, ierr integer(4) :: bckgnd_gen_proc_id ! defined by the center - ! + bckgnd_gen_proc_id=0 ! defined by the center - ! - ipdstmpl48(1) = icatg - ipdstmpl48(2) = iparm - ! + + ipdstmpl49(1) = icatg + ipdstmpl49(2) = iparm + call get_g2_typeofaerosol(aer_type, value, ierr) - ipdstmpl48(3) = value - ! + ipdstmpl49(3) = value + call get_g2_typeofintervals(typ_intvl_size, value, ierr) - ipdstmpl48(4) = value - ipdstmpl48(5) = scale_fac1_size - ipdstmpl48(6) = nint(scale_val1_size) - ipdstmpl48(7) = scale_fac2_size - ipdstmpl48(8) = nint(scale_val2_size) - ! + ipdstmpl49(4) = value + ipdstmpl49(5) = scale_fac1_size + ipdstmpl49(6) = nint(scale_val1_size) + ipdstmpl49(7) = scale_fac2_size + ipdstmpl49(8) = nint(scale_val2_size) + call get_g2_typeofintervals(typ_intvl_wavelength, value, ierr) - ipdstmpl48(9) = value - ipdstmpl48(10) = scale_fac1_wavelength - ipdstmpl48(11) = nint(scale_val1_wavelength) - ipdstmpl48(12) = scale_fac2_wavelength - ipdstmpl48(13) = nint(scale_val2_wavelength) - ! + ipdstmpl49(9) = value + ipdstmpl49(10) = scale_fac1_wavelength + ipdstmpl49(11) = nint(scale_val1_wavelength) + ipdstmpl49(12) = scale_fac2_wavelength + ipdstmpl49(13) = nint(scale_val2_wavelength) + call get_g2_typeofgenproc(typ_gen_proc_key, value, ierr) - ipdstmpl48(14) = value - ! - ipdstmpl48(15) = bckgnd_gen_proc_id - ! + ipdstmpl49(14) = value + + ipdstmpl49(15) = bckgnd_gen_proc_id + call get_g2_on388genproc(gen_proc_or_mod_key, value, ierr) - ipdstmpl48(16) = value - ! - ipdstmpl48(17) = hrs_obs_cutoff - ipdstmpl48(18) = min_obs_cutoff - ! + ipdstmpl49(16) = value + + ipdstmpl49(17) = hrs_obs_cutoff + ipdstmpl49(18) = min_obs_cutoff + call get_g2_unitoftimerange(unit_of_time_key, value, ierr) - ipdstmpl48(19) = value - ipdstmpl48(20) = fcst_time - ! + ipdstmpl49(19) = value + ipdstmpl49(20) = fcst_time + call get_g2_fixedsurfacetypes(lvl_type1, value, ierr) - ipdstmpl48(21) = value - ipdstmpl48(22) = scale_fac1 - ipdstmpl48(23) = scaled_val1 - ! + ipdstmpl49(21) = value + ipdstmpl49(22) = scale_fac1 + ipdstmpl49(23) = scaled_val1 + call get_g2_fixedsurfacetypes(lvl_type2, value, ierr) - ipdstmpl48(24) = value - ! - ipdstmpl48(25) = scale_fac2 - ipdstmpl48(26) = scaled_val2 - ! + ipdstmpl49(24) = value + + ipdstmpl49(25) = scale_fac2 + ipdstmpl49(26) = scaled_val2 + ipdstmpl49(27) = 0 + ipdstmpl49(28) = 0 + ipdstmpl49(29) = 0 + end subroutine g2sec4_temp49 - ! - ! + !> This subroutine returns the corresponding GRIB2 type of !> ensemble forecast value for a given short key name based on Table 4.6 !> diff --git a/tests/test_all_table_other.F90 b/tests/test_all_table_other.F90 index 53fd54a..7358ff7 100644 --- a/tests/test_all_table_other.F90 +++ b/tests/test_all_table_other.F90 @@ -21,9 +21,9 @@ program test_all_table_other integer :: ipdstmpl48(26) integer :: ipdstmpl48_expected(26) = (/ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 10, 0, & 12, 15, 16, 13, 18, 20, 20, 21, 100, 22, 23 /) - integer :: ipdstmpl49(26) - integer :: ipdstmpl49_expected(26) = (/ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 10, 0, & - 12, 15, 16, 13, 18, 20, 20, 21, 100, 22, 23 /) + integer :: ipdstmpl49(29) + integer :: ipdstmpl49_expected(29) = (/ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 10, 0, & + 12, 15, 16, 13, 18, 20, 20, 21, 100, 22, 23, 0, 0, 0 /) integer :: ifield5(16) integer :: ifield5_expected(16) = (/ 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) integer :: ifield5_0(5) @@ -85,9 +85,9 @@ program test_all_table_other call g2sec4_temp49(0, 1, 'methane', 'greater_than_first_limit', 4, 5.0, 6, 7.0, & 'greater_or_equal_first_limit', 9, 10., 11, 12., 'prob_wt_fcst', 'prob_st_surg', 15, 16, & 'second', 18, 'isothermal', 20, 21, 'isobaric_sfc', 22, 23, ipdstmpl49) - do i = 1, 26 - !print *, ipdstmpl49(i) - if (ipdstmpl49(i) .ne. ipdstmpl49_expected(i)) stop 6 + do i = 1, 29 + print *, ipdstmpl49(i) + if (ipdstmpl49(i) .ne. ipdstmpl49_expected(i)) stop 65 end do print *, 'testing g2sec5_temp0' From eb61eca45729c048d711765334d7885bbcbb9101 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Tue, 2 Jul 2024 05:18:37 -0600 Subject: [PATCH 4/4] working on 4.49 --- src/grib2_all_tables_module.F90 | 18 +++++++++++++----- tests/test_all_table_other.F90 | 3 ++- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/grib2_all_tables_module.F90 b/src/grib2_all_tables_module.F90 index a590679..a6a78e9 100644 --- a/src/grib2_all_tables_module.F90 +++ b/src/grib2_all_tables_module.F90 @@ -2532,7 +2532,10 @@ end subroutine g2sec4_temp48 !> @param[in] lvl_type2 - Type of second fixed surfaced (see Code table 4.5) !> @param[in] scale_fac2 - Scale factor of second fixed surface !> @param[in] scaled_val2 - Scaled value of second fixed surfaces - !> @param[out] ipdstmpl49 - GRIB2 PDS Template 4.48 listing + !> @param[in] type_ens_fcst_key Type of ensemble forecast (see Code table 4.6) + !> @param[in] perturb_num Perturbation ensemble number + !> @param[in] num_fcst_ens number of forecasts in ensemble + !> @param[out] ipdstmpl49 - GRIB2 PDS Template 4.49 listing !> !> @author Edward Hartnett @date 2024-07-02 subroutine g2sec4_temp49(icatg, iparm, aer_type, typ_intvl_size, & @@ -2544,6 +2547,7 @@ subroutine g2sec4_temp49(icatg, iparm, aer_type, typ_intvl_size, hrs_obs_cutoff, min_obs_cutoff, & unit_of_time_key, fcst_time, lvl_type1, scale_fac1, & scaled_val1, lvl_type2, scale_fac2, scaled_val2, & + type_ens_fcst_key, perturb_num, num_fcst_ens, & ipdstmpl49) integer(4), intent(in) :: icatg, iparm, hrs_obs_cutoff, min_obs_cutoff, & @@ -2551,12 +2555,14 @@ subroutine g2sec4_temp49(icatg, iparm, aer_type, typ_intvl_size, scale_fac2_wavelength, & fcst_time, scale_fac1, scaled_val1, & scale_fac2, scaled_val2 + integer(4),intent(in) :: perturb_num, num_fcst_ens real, intent(in) :: scale_val1_size, scale_val2_size, scale_val1_wavelength, & scale_val2_wavelength character(len=*), intent(in) :: aer_type, typ_intvl_size, & typ_intvl_wavelength, typ_gen_proc_key, & - gen_proc_or_mod_key, unit_of_time_key, lvl_type1, lvl_type2 + gen_proc_or_mod_key, unit_of_time_key, lvl_type1, lvl_type2, & + type_ens_fcst_key integer(4), intent(inout) :: ipdstmpl49(29) @@ -2611,9 +2617,11 @@ subroutine g2sec4_temp49(icatg, iparm, aer_type, typ_intvl_size, ipdstmpl49(25) = scale_fac2 ipdstmpl49(26) = scaled_val2 - ipdstmpl49(27) = 0 - ipdstmpl49(28) = 0 - ipdstmpl49(29) = 0 + + call get_g2_typeofensfcst(type_ens_fcst_key, value, ierr) + ipdstmpl49(27) = value + ipdstmpl49(28) = perturb_num + ipdstmpl49(29) = num_fcst_ens end subroutine g2sec4_temp49 diff --git a/tests/test_all_table_other.F90 b/tests/test_all_table_other.F90 index 7358ff7..19f5ecd 100644 --- a/tests/test_all_table_other.F90 +++ b/tests/test_all_table_other.F90 @@ -84,7 +84,8 @@ program test_all_table_other print *, 'testing g2sec4_temp49' call g2sec4_temp49(0, 1, 'methane', 'greater_than_first_limit', 4, 5.0, 6, 7.0, & 'greater_or_equal_first_limit', 9, 10., 11, 12., 'prob_wt_fcst', 'prob_st_surg', 15, 16, & - 'second', 18, 'isothermal', 20, 21, 'isobaric_sfc', 22, 23, ipdstmpl49) + 'second', 18, 'isothermal', 20, 21, 'isobaric_sfc', 22, 23, & + 'unpert_hi_res_ctrl_fcst', 0, 0, ipdstmpl49) do i = 1, 29 print *, ipdstmpl49(i) if (ipdstmpl49(i) .ne. ipdstmpl49_expected(i)) stop 65