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