-
Notifications
You must be signed in to change notification settings - Fork 17
/
Copy pathg2png.F90
137 lines (124 loc) · 5.12 KB
/
g2png.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
!> @file
!> @brief Pack/unpack a data field into PNG image format, defined in
!> [Data Representation Template
!> 5.40](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-40.shtml).
!> @author Stephen Gilbert @date 2002-12-21
!> Pack a data field into PNG image format, defined in [Data
!> Representation Template
!> 5.41](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-41.shtml).
!>
!> After the data field is scaled, and the reference value is
!> subtracted out, it is treated as a grayscale image and passed to a
!> PNG encoder. It also fills in GRIB2 Data Representation Template
!> 5.41 or 5.40010 with the appropriate values.
!>
!> @param[in] fld Contains the data values to pack.
!> @param[in] width number of points in the x direction.
!> @param[in] height number of points in the y direction.
!> @param[inout] idrstmpl Contains the array of values for Data
!> Representation Template 5.2 or 5.3.
!> - idrstmpl(1) Reference value - ignored on input.
!> - idrstmpl(2) Binary Scale Factor.
!> - idrstmpl(3) Decimal Scale Factor.
!> - idrstmpl(4) Number of bits containing each grayscale pixel value.
!> - idrstmpl(5) Original field type, currently set = 0 on output
!> Data values assumed to be reals.
!> - idrstmpl(6) = 0 use lossless compression; = 1 use lossy compression.
!> - idrstmpl(7) Desired compression ratio, if idrstmpl(6)=1.
!> @param[out] cpack The packed data field (character*1 array)
!> @param[out] lcpack The length of packed field cpack.
!>
!> @author Stephen Gilbert @date 2002-12-21
subroutine pngpack(fld, width, height, idrstmpl, cpack, lcpack)
use, intrinsic :: iso_c_binding, only: c_size_t
implicit none
integer, intent(in) :: width, height
real, intent(in) :: fld(width * height)
character(len = 1), intent(out) :: cpack(*)
integer, intent(inout) :: idrstmpl(*)
integer, intent(out) :: lcpack
integer(c_size_t) :: width_c, height_c
integer :: ret
interface
function g2c_pngpackd(fld, width, height, idrstmpl, cpack, lcpack) bind(c)
use, intrinsic :: iso_c_binding
real(kind=c_double), intent(in):: fld(*)
integer(c_size_t), value, intent(in) :: width, height
integer(c_int), intent(inout) :: idrstmpl(*)
character(kind=c_char), intent(out) :: cpack(*)
integer(c_int), intent(out) :: lcpack
integer(c_int) :: g2c_pngpackd
end function g2c_pngpackd
function g2c_pngpackf(fld, width, height, idrstmpl, cpack, lcpack) bind(c)
use, intrinsic :: iso_c_binding
real(kind=c_float), intent(in):: fld(*)
integer(c_size_t), value, intent(in) :: width, height
integer(c_int), intent(inout) :: idrstmpl(*)
character(kind=c_char), intent(out) :: cpack(*)
integer(c_int), intent(out) :: lcpack
integer(c_int) :: g2c_pngpackf
end function g2c_pngpackf
end interface
width_c = width
height_c = height
#if KIND==4
ret = g2c_pngpackf(fld, width_c, height_c, idrstmpl, cpack, lcpack)
#else
ret = g2c_pngpackd(fld, width_c, height_c, idrstmpl, cpack, lcpack)
#endif
end subroutine pngpack
!> Unpack a data field with PNG, defined in [Data Representation
!> Template
!> 5.40](https://www.nco.ncep.noaa.gov/pmb/docs/grib2/grib2_doc/grib2_temp5-40.shtml).
!>
!> This subroutine unpacks a data field that was packed into a
!> PNG image format using info from the GRIB2 Data Representation
!> Template 5.40 or 5.40000.
!>
!> @param[in] cpack The packed data field (character*1 array).
!> @param[in] len length of packed field cpack().
!> @param[in] idrstmpl Contains the array of values for Data
!> Representation Template 5.40 or 5.40000.
!> @param[in] ndpts The number of data values to unpack.
!> @param[out] fld Contains the unpacked data values.
!>
!> @author Stephen Gilbert @date 2000-06-21
subroutine pngunpack(cpack, len, idrstmpl, ndpts, fld)
use, intrinsic :: iso_c_binding, only: c_size_t
implicit none
character(len = 1), intent(in) :: cpack(len)
integer, intent(in) :: ndpts, len
integer, intent(in) :: idrstmpl(*)
real, intent(out) :: fld(ndpts)
integer(c_size_t) :: ndpts_c, len_c
integer :: ret
interface
function g2c_pngunpackd(cpack, len, idrstmpl, ndpts, fld) bind(c)
use, intrinsic :: iso_c_binding
implicit none
integer(c_size_t), value, intent(in) :: len
integer(c_size_t), value, intent(in) :: ndpts
character(kind=c_char), intent(in) :: cpack(*)
integer(c_int), intent(in) :: idrstmpl(*)
real(kind=c_double), intent(out) :: fld(*)
integer(c_int) :: g2c_pngunpackd
end function g2c_pngunpackd
function g2c_pngunpackf(cpack, len, idrstmpl, ndpts, fld) bind(c)
use, intrinsic :: iso_c_binding
implicit none
integer(c_size_t), value, intent(in) :: len
integer(c_size_t), value, intent(in) :: ndpts
character(kind=c_char), intent(in) :: cpack(*)
integer(c_int), intent(in) :: idrstmpl(*)
real(kind=c_float), intent(out) :: fld(*)
integer(c_int) :: g2c_pngunpackf
end function g2c_pngunpackf
end interface
len_c = len
ndpts_c = ndpts
#if KIND==4
ret = g2c_pngunpackf(cpack, len_c, idrstmpl, ndpts_c, fld)
#else
ret = g2c_pngunpackd(cpack, len_c, idrstmpl, ndpts_c, fld)
#endif
end subroutine pngunpack