adding PRODUCT DEFINITION TEMPLATE 4.49 (#136)

* starting to add 4.49

* starting to add 4.49

* starting to add 4.49

* working on 4.49

Author: edwardhartnett

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,8 +2500,131 @@ 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.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)
+  !> @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[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,                 &
+       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,         &
+       type_ens_fcst_key, perturb_num, num_fcst_ens, &
+       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,                                        &
+         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, &
+         type_ens_fcst_key
+
+    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
+
+    ipdstmpl49(1) = icatg
+    ipdstmpl49(2) = iparm
+
+    call get_g2_typeofaerosol(aer_type, value, ierr)
+    ipdstmpl49(3) = value
+
+    call get_g2_typeofintervals(typ_intvl_size, value, ierr)
+    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)
+    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)
+    ipdstmpl49(14) = value
+
+    ipdstmpl49(15) = bckgnd_gen_proc_id
+
+    call get_g2_on388genproc(gen_proc_or_mod_key, value, ierr)
+    ipdstmpl49(16) = value
+
+    ipdstmpl49(17) = hrs_obs_cutoff
+    ipdstmpl49(18) = min_obs_cutoff
+
+    call get_g2_unitoftimerange(unit_of_time_key, value, ierr)
+    ipdstmpl49(19) = value
+    ipdstmpl49(20) = fcst_time
+
+    call get_g2_fixedsurfacetypes(lvl_type1, value, ierr)
+    ipdstmpl49(21) = value
+    ipdstmpl49(22) = scale_fac1
+    ipdstmpl49(23) = scaled_val1
+
+    call get_g2_fixedsurfacetypes(lvl_type2, value, ierr)
+    ipdstmpl49(24) = value
+
+    ipdstmpl49(25) = scale_fac2
+    ipdstmpl49(26) = scaled_val2
+    
+    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
+
   !> This subroutine returns the corresponding GRIB2 type of
   !>    ensemble forecast value for a given short key name based on Table 4.6
   !>

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(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)  
@@ -78,6 +81,16 @@ 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, &
+       'unpert_hi_res_ctrl_fcst', 0, 0, ipdstmpl49)
+  do i = 1, 29
+     print *, ipdstmpl49(i)
+     if (ipdstmpl49(i) .ne. ipdstmpl49_expected(i)) stop 65
+  end do
+  
   print *, 'testing g2sec5_temp0'
   call g2sec5_temp0(0, 1, 2, ifield5_0)  
   do i = 1, 5