Soil Water Balance (SWB2)
Loading...
Searching...
No Matches
proj4_support.F90
Go to the documentation of this file.
1module proj4_support
2
3 use iso_c_binding
4 use exceptions
5 use fstring, only : right, left, squote, whitespace
6 use fstring_list, only : fstring_list_t, create_list
7 implicit none
8
9 private
10
11 public :: create_attributes_from_proj4_string
12
13contains
14
15 subroutine create_attributes_from_proj4_string( proj4_string, attribute_name_list, &
16 attribute_value_list )
17
18 character (len=*), intent(in) :: proj4_string
19 type ( fstring_list_t), intent(out) :: attribute_name_list
20 type (fstring_list_t), intent(out) :: attribute_value_list
21
22
23 ! [ LOCALS ]
24 type (fstring_list_t) :: proj4_list
25 integer (c_int) :: indx
26 character (len=256) :: temp_string
27 character (len=:), allocatable :: valuestring
28 character (len=:), allocatable :: namestring
29 character (len=:), allocatable :: standard_parallels
30 character (len=:), allocatable :: proj4_string_local
31
32 proj4_string_local = proj4_string
33
34 proj4_list = create_list( proj4_string_local, delimiter_chr=whitespace )
35
36 do indx=1, proj4_list%count
37
38 temp_string = proj4_list%get( indx )
39 namestring = left( string=temp_string, substring="=" )
40 valuestring = right( string=temp_string, substring="=" )
41
42 select case ( namestring )
43 case ( "+proj" )
44
45 call attribute_name_list%append("grid_mapping_name")
46 select case ( valuestring )
47 case ( "latlon", "lonlat", "latlong", "longlat" )
48 call attribute_value_list%append("latitude_longitude")
49 call attribute_name_list%append("units")
50 call attribute_value_list%append("decimal_degrees")
51 case ( "aea" )
52 call attribute_value_list%append("albers_conical_equal_area")
53 case ( "aeqd" )
54 call attribute_value_list%append("azimuthal_equidistant")
55 case ( "tmerc" )
56 call attribute_value_list%append("transverse_mercator")
57 case ( "merc" )
58 call attribute_value_list%append("mercator")
59 case ( "cea" )
60 call attribute_value_list%append("lambert_cylindrical_equal_area")
61 case ( "lcc" )
62 call attribute_value_list%append("lambert_conformal_conic")
63 case ( "utm" )
64 call attribute_value_list%append("universal_transverse_mercator")
65 case default
66 call attribute_value_list%append("unknown")
67 end select
68
69 case ( "+datum" )
70
71 call attribute_name_list%append("datum")
72 call attribute_value_list%append( valuestring )
73
74 case ( "+ellps")
75
76 call attribute_name_list%append("spheroid")
77 call attribute_value_list%append( valuestring )
78
79 select case ( valuestring )
80
81 case ( "GRS80", "grs80" )
82
83 call attribute_name_list%append("semi_major_axis")
84 call attribute_value_list%append( "6378137.0" )
85
86 call attribute_name_list%append("inverse_flattening")
87 call attribute_value_list%append( "298.257222101" )
88
89 case ( "WGS84", "wgs84" )
90
91 call attribute_name_list%append("semi_major_axis")
92 call attribute_value_list%append( "6378137.0" )
93
94 call attribute_name_list%append("inverse_flattening")
95 call attribute_value_list%append( "298.257223563" )
96
97 case ( "clrk66", "CLRK66" )
98
99 call attribute_name_list%append("semi_major_axis")
100 call attribute_value_list%append( "6378206.0" )
101
102 call attribute_name_list%append("inverse_flattening")
103 call attribute_value_list%append( "294.98" )
104
105 case ( "sphere" )
106
107 call attribute_name_list%append("semi_major_axis")
108 call attribute_value_list%append( "6370997.0" )
109
110 call attribute_name_list%append("semi_minor_axis")
111 call attribute_value_list%append( "6370997.0" )
112
113 end select
114
115 case ( "+lon_0" )
116
117 call attribute_name_list%append("longitude_of_central_meridian")
118 call attribute_value_list%append( valuestring )
119
120 case ( "+lat_0" )
121
122 call attribute_name_list%append("latitude_of_projection_origin")
123 call attribute_value_list%append( valuestring )
124
125 case ( "+x_0" )
126
127 call attribute_name_list%append("false_easting")
128 call attribute_value_list%append( valuestring )
129
130 case ( "+y_0" )
131
132 call attribute_name_list%append("false_northing")
133 call attribute_value_list%append( valuestring )
134
135 case ( "+lat_1" )
136
137 !call attribute_name_list%append("latitude_of_first_standard_parallel")
138 !call attribute_name_list%append("standard_parallel_1")
139 !call attribute_value_list%append( valuestring )
140 standard_parallels = valuestring
141
142 case ( "+lat_2" )
143
144 !call attribute_name_list%append("latitude_of_second_standard_parallel")
145 standard_parallels = standard_parallels//' , '//trim(valuestring)
146
147 call attribute_name_list%append("standard_parallel")
148 call attribute_value_list%append( standard_parallels )
149
150 case ( "+a" )
151
152 call attribute_name_list%append("semi_major_axis")
153 call attribute_value_list%append( valuestring )
154
155 case ( "+b" )
156
157 call attribute_name_list%append("semi_minor_axis")
158 call attribute_value_list%append( valuestring )
159
160 case ( "+R" )
161
162 call attribute_name_list%append("earth_radius")
163 call attribute_value_list%append( valuestring )
164
165 case ( "+rf" )
166
167 call attribute_name_list%append("inverse_flattening")
168 call attribute_value_list%append( valuestring )
169
170 case ( "+k", "+k_0" )
171
172 call attribute_name_list%append("scale_factor_at_central_meridian")
173 call attribute_value_list%append( valuestring )
174
175 case ( "+units" )
176
177 call attribute_name_list%append("units")
178
179 select case ( valuestring )
180
181 case ( "m" )
182 call attribute_value_list%append( "meter" )
183
184 case ( "us-ft" )
185 call attribute_value_list%append( "US_surveyors_foot" )
186
187 case ( "ft" )
188 call attribute_value_list%append( "international_foot" )
189
190 case default
191 call attribute_value_list%append( valuestring )
192
193 end select
194
195 case ( "+zone" )
196
197 call attribute_name_list%append("UTM_zone")
198 call attribute_value_list%append( valuestring )
199
200 case default
201
202 end select
203
204 enddo
205
206
207 end subroutine create_attributes_from_proj4_string
208
209
210end module proj4_support
fstring_list::create_list
Definition fstring_list.F90:114
fstring_list
Definition fstring_list.F90:1
fstring::whitespace
character(len=2), parameter, public whitespace
Definition fstring.F90:172
proj4_support
Definition proj4_support.F90:1
proj4_support::create_attributes_from_proj4_string
subroutine, public create_attributes_from_proj4_string(proj4_string, attribute_name_list, attribute_value_list)
Definition proj4_support.F90:17
fstring_list::fstring_list_t
Definition fstring_list.F90:21