Skip to content

Commit

Permalink
starting to add 4.49
Browse files Browse the repository at this point in the history
  • Loading branch information
@edwardhartnett
edwardhartnett committed Jul 2, 2024
1 parent dc1714d commit 55dffdc
Show file tree
Hide file tree
Showing 2 changed files with 63 additions and 57 deletions.
108 changes: 57 additions & 51 deletions src/grib2_all_tables_module.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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, &
Expand All @@ -2541,76 +2544,79 @@ 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, &
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)
!

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
!>
Expand Down
12 changes: 6 additions & 6 deletions tests/test_all_table_other.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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'
Expand Down

0 comments on commit 55dffdc

Please sign in to comment.