Skip to content

Commit 04b84c5

Browse files
edwardhartnettedwardhartnett
committed
merged
2 parents 0479f92 + e4b40fe commit 04b84c5

9 files changed

+266
-286
lines changed

‎src/CMakeLists.txt

+4-4
Original file line numberDiff line numberDiff line change
@@ -10,10 +10,10 @@ gb_info.F90 getdim.F90 getfield.F90 getgb2.F90 getgb2l.F90 getgb2p.F90
1010
getgb2r.F90 getgb2rp.F90 g2index.F90 getlocal.F90 getpoly.F90
1111
gettemplates.F90 gf_free.F90 gf_getfld.F90 g2unpack.F90 gribcreate.F90
1212
gribend.F90 gribinfo.F90 ${CMAKE_CURRENT_BINARY_DIR}/gribmod.F90
13-
gridtemplates.F90 intmath.F90 jpcpack.F90 jpcunpack.F90 misspack.F90
14-
mkieee.F90 pack_gp.f params_ecmwf.F90 params.F90 pdstemplates.F90
15-
pngpack.F90 pngunpack.F90 putgb2.F90 rdieee.F90 realloc.F90 reduce.f
16-
simpack.F90 simunpack.F90 skgb.F90 specpack.F90 specunpack.F90)
13+
gridtemplates.F90 intmath.F90 g2jpc.F90 misspack.F90 mkieee.F90
14+
pack_gp.f params_ecmwf.F90 params.F90 pdstemplates.F90 g2png.F90
15+
putgb2.F90 rdieee.F90 realloc.F90 reduce.f g2sim.F90 skgb.F90
16+
g2spec.F90)
1717

1818
# This function calls NCEPLIBS-w3emc.
1919
if (BUILD_WITH_W3EMC)

‎src/jpcpack.F90 ‎src/g2jpc.F90

+65-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
!> @file
2-
!> @brief Pack a data field into a JPEG2000 code stream as defined in
2+
!> @brief Pack/unpack a data field into a JPEG2000 code stream as defined in
33
!> [Data Representation Template
44
!> 5.40](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-40.shtml).
55
!> @author Stephen Gilbert @date 2002-12-17
@@ -156,3 +156,67 @@ end function enc_jpeg2000
156156
if (idrstmpl(6) .eq. 0) idrstmpl(7) = 255 ! lossy not used
157157

158158
end subroutine
159+
160+
!> Unpack a data field from a JPEG2000 code stream as defined in
161+
!> [Data Representation Template
162+
!> 5.40](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-40.shtml).
163+
!>
164+
!> This subroutine unpacks a data field that was packed into a
165+
!> JPEG2000 code stream using info from the GRIB2 Data Representation
166+
!> Template 5.40 or 5.40000.
167+
!>
168+
!> @param[in] cpack The packed data field (character*1 array).
169+
!> @param[in] len length of packed field cpack().
170+
!> @param[in] idrstmpl Array of values for Data Representation
171+
!> Template 5.40 or 5.40000.
172+
!> @param[in] ndpts The number of data values to unpack.
173+
!> @param[out] fld Contains the unpacked data values.
174+
!>
175+
!> @author Stephen Gilbert @date 2002-12-17
176+
subroutine jpcunpack(cpack,len,idrstmpl,ndpts,fld)
177+
implicit none
178+
179+
character(len=1),intent(in) :: cpack(len)
180+
integer,intent(in) :: ndpts,len
181+
integer,intent(in) :: idrstmpl(*)
182+
real,intent(out) :: fld(ndpts)
183+
184+
integer :: ifld(ndpts)
185+
integer(4) :: ieee
186+
integer(8) :: len8
187+
real :: ref,bscale,dscale
188+
integer :: nbits, j, iret
189+
190+
interface
191+
function dec_jpeg2000(cin, len, ifld) &
192+
bind(c, name="g2c_dec_jpeg2000")
193+
use iso_c_binding
194+
character(kind = c_char), intent(in) :: cin(*)
195+
integer(c_size_t), value, intent(in) :: len
196+
integer(c_int), intent(inout) :: ifld(*)
197+
integer(c_int) :: dec_jpeg2000
198+
end function dec_jpeg2000
199+
end interface
200+
201+
ieee = idrstmpl(1)
202+
call rdieee(ieee,ref,1)
203+
bscale = 2.0**real(idrstmpl(2))
204+
dscale = 10.0**real(-idrstmpl(3))
205+
nbits = idrstmpl(4)
206+
207+
! if nbits equals 0, we have a constant field where the reference value
208+
! is the data value at each gridpoint
209+
if (nbits.ne.0) then
210+
! call g2_gbytesc(cpack,ifld,0,nbits,0,ndpts)
211+
len8 = len
212+
iret=dec_jpeg2000(cpack,len8,ifld)
213+
do j=1,ndpts
214+
fld(j)=((real(ifld(j))*bscale)+ref)*dscale
215+
enddo
216+
else
217+
do j=1,ndpts
218+
fld(j)=ref
219+
enddo
220+
endif
221+
222+
end subroutine jpcunpack

‎src/pngpack.F90 ‎src/g2png.F90

+68-2
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
!> @file
2-
!> @brief Pack a data field into PNG image format, defined in [Data Representation
3-
!> Template 5.40](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-40.shtml).
2+
!> @brief Pack/unpack a data field into PNG image format, defined in
3+
!> [Data Representation Template
4+
!> 5.40](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-40.shtml).
45
!> @author Stephen Gilbert @date 2002-12-21
56

67
!> Pack a data field into PNG image format, defined in [Data
@@ -146,3 +147,68 @@ end function enc_png
146147
idrstmpl(5) = 0 ! original data were reals
147148

148149
end subroutine pngpack
150+
151+
!> Unpack a data field with PNG, defined in [Data Representation
152+
!> Template
153+
!> 5.40](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-40.shtml).
154+
!>
155+
!> This subroutine unpacks a data field that was packed into a
156+
!> PNG image format using info from the GRIB2 Data Representation
157+
!> Template 5.40 or 5.40000.
158+
!>
159+
!> @param[in] cpack The packed data field (character*1 array).
160+
!> @param[in] len length of packed field cpack().
161+
!> @param[in] idrstmpl Contains the array of values for Data
162+
!> Representation Template 5.40 or 5.40000.
163+
!> @param[in] ndpts The number of data values to unpack.
164+
!> @param[out] fld Contains the unpacked data values.
165+
!>
166+
!> @author Stephen Gilbert @date 2000-06-21
167+
subroutine pngunpack(cpack, len, idrstmpl, ndpts, fld)
168+
implicit none
169+
170+
character(len = 1), intent(in) :: cpack(len)
171+
integer, intent(in) :: ndpts, len
172+
integer, intent(in) :: idrstmpl(*)
173+
real, intent(out) :: fld(ndpts)
174+
175+
integer :: ifld(ndpts)
176+
character(len = 1), allocatable :: ctemp(:)
177+
integer(4) :: ieee
178+
real :: ref, bscale, dscale
179+
integer :: width, height
180+
integer :: iret, itype, j, nbits
181+
182+
interface
183+
function dec_png(pngbuf, width, height, cout) bind(c, name="dec_png")
184+
use iso_c_binding
185+
character(kind = c_char), intent(in) :: pngbuf(*)
186+
integer(c_int), intent(in) :: width, height
187+
character(kind = c_char), intent(out) :: cout(*)
188+
integer(c_int) :: dec_png
189+
end function dec_png
190+
end interface
191+
192+
ieee = idrstmpl(1)
193+
call rdieee(ieee, ref, 1)
194+
bscale = 2.0**real(idrstmpl(2))
195+
dscale = 10.0**real(-idrstmpl(3))
196+
nbits = idrstmpl(4)
197+
itype = idrstmpl(5)
198+
199+
! If nbits equals 0, we have a constant field where the reference value
200+
! is the data value at each gridpoint.
201+
if (nbits .ne. 0) then
202+
allocate(ctemp(ndpts * 4))
203+
iret = dec_png(cpack, width, height, ctemp)
204+
call g2_gbytesc(ctemp, ifld, 0, nbits, 0, ndpts)
205+
deallocate(ctemp)
206+
do j = 1, ndpts
207+
fld(j) = ((real(ifld(j)) * bscale) + ref) * dscale
208+
enddo
209+
else
210+
do j = 1, ndpts
211+
fld(j) = ref
212+
enddo
213+
endif
214+
end subroutine pngunpack

‎src/simpack.F90 ‎src/g2sim.F90

+49-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
!> @file
2-
!> @brief Pack a data field using simple packing algorithm.
2+
!> @brief Pack/unpack a data field using simple packing algorithm.
33
!> @author Stephen Gilbert @date 2000-06-21
44

55
!> Pack a data field using a simple packing algorithm.
@@ -152,3 +152,51 @@ subroutine simpack(fld,ndpts,idrstmpl,cpack,lcpack)
152152
idrstmpl(5)=0 ! original data were reals
153153

154154
end subroutine simpack
155+
156+
!> Unpack a data field that was packed using a simple packing, [Data
157+
!> Representation Template
158+
!> 5.0](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-0.shtml).
159+
!>
160+
!> @param[in] cpack The packed data field (character*1 array).
161+
!> @param[in] len length of packed field cpack.
162+
!> @param[in] idrstmpl Contains the array of values for Data
163+
!> Representation Template 5.0.
164+
!> @param[in] ndpts The number of data values to unpack.
165+
!> @param[out] fld Contains the unpacked data values.
166+
!>
167+
!> @author Stephen Gilbert @date 2000-06-21
168+
subroutine simunpack(cpack, len, idrstmpl, ndpts, fld)
169+
implicit none
170+
171+
character(len=1), intent(in) :: cpack(len)
172+
integer, intent(in) :: ndpts, len
173+
integer, intent(in) :: idrstmpl(*)
174+
real, intent(out) :: fld(ndpts)
175+
176+
integer :: ifld(ndpts)
177+
integer(4) :: ieee
178+
real :: ref, bscale, dscale
179+
integer :: itype, j, nbits
180+
181+
ieee = idrstmpl(1)
182+
call rdieee(ieee, ref, 1)
183+
bscale = 2.0**real(idrstmpl(2))
184+
dscale = 10.0**real(-idrstmpl(3))
185+
nbits = idrstmpl(4)
186+
itype = idrstmpl(5)
187+
188+
! If nbits equals 0, we have a constant field where the reference value
189+
! is the data value at each gridpoint.
190+
if (nbits .ne. 0) then
191+
call g2_gbytesc(cpack, ifld, 0, nbits, 0, ndpts)
192+
do j=1, ndpts
193+
fld(j) = ((real(ifld(j)) * bscale) + ref) * dscale
194+
enddo
195+
else
196+
!print *, 'unpack ref ', ref
197+
!print *, 'unpack ndpts ', ndpts
198+
do j=1, ndpts
199+
fld(j) = ref
200+
enddo
201+
endif
202+
end subroutine simunpack

‎src/specpack.F90 ‎src/g2spec.F90

+80-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
!> @file
2-
!> @brief Pack a spectral data field using the complex
2+
!> @brief Pack/unpack a spectral data field using the complex
33
!> packing algorithm for spherical harmonic data as defined in
44
!> [Data Representation Template
55
!> 5.51](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-51.shtml).
@@ -104,3 +104,82 @@ subroutine specpack(fld,ndpts,JJ,KK,MM,idrstmpl,cpack,lcpack)
104104
idrstmpl(10)=1 ! Unpacked spectral data is 32-bit IEEE
105105

106106
end subroutine specpack
107+
108+
!> Unpack a spectral data field using the complex packing algorithm
109+
!> for spherical harmonic data, [Data Representation Template
110+
!> 5.51](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-51.shtml).
111+
!>
112+
!> @param[in] cpack The packed data field (character*1 array).
113+
!> @param[in] len length of packed field cpack.
114+
!> @param[in] idrstmpl Contains the array of values for Data
115+
!> Representation Template 5.51.
116+
!> @param[in] ndpts The number of data values in array fld.
117+
!> @param[in] JJ J pentagonal resolution parameter.
118+
!> @param[in] KK K pentagonal resolution parameter.
119+
!> @param[in] MM M pentagonal resolution parameter.
120+
!> @param[out] fld Contains the unpacked data values.
121+
!>
122+
!> @author Stephen Gilbert @date 2002-12-19
123+
subroutine specunpack(cpack,len,idrstmpl,ndpts,JJ,KK,MM,fld)
124+
125+
character(len=1),intent(in) :: cpack(len)
126+
integer,intent(in) :: ndpts,len,JJ,KK,MM
127+
integer,intent(in) :: idrstmpl(*)
128+
real,intent(out) :: fld(ndpts)
129+
130+
integer :: ifld(ndpts),Ts
131+
integer(4) :: ieee
132+
real :: ref,bscale,dscale,unpk(ndpts)
133+
real,allocatable :: pscale(:)
134+
135+
ieee = idrstmpl(1)
136+
call rdieee(ieee,ref,1)
137+
bscale = 2.0**real(idrstmpl(2))
138+
dscale = 10.0**real(-idrstmpl(3))
139+
nbits = idrstmpl(4)
140+
Js=idrstmpl(6)
141+
Ks=idrstmpl(7)
142+
Ms=idrstmpl(8)
143+
Ts=idrstmpl(9)
144+
145+
if (idrstmpl(10).eq.1) then ! unpacked floats are 32-bit IEEE
146+
call rdieee(cpack,unpk,Ts) ! read IEEE unpacked floats
147+
iofst=32*Ts
148+
call g2_gbytesc(cpack,ifld,iofst,nbits,0,ndpts-Ts) ! unpack scaled data
149+
150+
! Calculate Laplacian scaling factors for each possible wave number.
151+
allocate(pscale(JJ+MM))
152+
tscale=real(idrstmpl(5))*1E-6
153+
do n=Js,JJ+MM
154+
pscale(n)=real(n*(n+1))**(-tscale)
155+
enddo
156+
157+
! Assemble spectral coeffs back to original order.
158+
inc=1
159+
incu=1
160+
incp=1
161+
do m=0,MM
162+
Nm=JJ ! triangular or trapezoidal
163+
if (KK .eq. JJ+MM) Nm=JJ+m ! rhombodial
164+
Ns=Js ! triangular or trapezoidal
165+
if (Ks .eq. Js+Ms) Ns=Js+m ! rhombodial
166+
do n=m,Nm
167+
if (n.le.Ns .AND. m.le.Ms) then ! grab unpacked value
168+
fld(inc)=unpk(incu) ! real part
169+
fld(inc+1)=unpk(incu+1) ! imaginary part
170+
inc=inc+2
171+
incu=incu+2
172+
else ! Calc coeff from packed value
173+
fld(inc)=((real(ifld(incp))*bscale)+ref)*dscale*pscale(n) ! real part
174+
fld(inc+1)=((real(ifld(incp+1))*bscale)+ref)*dscale*pscale(n) ! imaginary part
175+
inc=inc+2
176+
incp=incp+2
177+
endif
178+
enddo
179+
enddo
180+
deallocate(pscale)
181+
else
182+
print *,'specunpack: Cannot handle 64 or 128-bit floats.'
183+
fld=0.0
184+
endif
185+
end subroutine specunpack

‎src/jpcunpack.F90

-69
This file was deleted.

0 commit comments

Comments
 (0)