scale_cubedsphere_coord_cnv Module Reference
Module common / Coordinate conversion with cubed-sphere projection. More...
Data Types | |
| interface | cubedspherecoordcnv_cs2localorthvec_alpha |
| interface | cubedspherecoordcnv_localorth2csvec_alpha |
Functions/Subroutines | |
| subroutine, public | cubedspherecoordcnv_cs2lonlatpos (panelid, alpha, beta, gam, np, lon, lat) |
| Calculate longitude and latitude coordinates from local coordinates using the central angles in an equiangular gnomonic cubed-sphere projection. | |
| subroutine, public | cubedspherecoordcnv_cs2lonlatvec (panelid, alpha, beta, gam, np, vecalpha, vecbeta, veclon, veclat, lat, gpu_async_id) |
| Convert the components of a vector in local coordinates with an equiangular gnomonic cubed-sphere projection to those in longitude and latitude coordinates. | |
| subroutine, public | cubedspherecoordcnv_lonlat2cspos (panelid, lon, lat, np, alpha, beta) |
| Calculate local coordinates using the central angles in an equiangular gnomonic cubed-sphere projection from longitude and latitude coordinates. | |
| subroutine, public | cubedspherecoordcnv_lonlat2csvec (panelid, alpha, beta, gam, np, veclon, veclat, vecalpha, vecbeta, lat, gpu_async_id) |
| Convert the components of a vector in longitude and latitude coordinates to those in local coordinates with an equiangular gnomonic cubed-sphere projection. | |
| subroutine, public | cubedspherecoordcnv_cs2cartpos (panelid, alpha, beta, gam, np, x, y, z) |
| Calculate the Cartesian coordinates from local coordinates using the central angles in an equiangular gnomonic cubed-sphere projection. | |
| subroutine, public | cubedspherecoordcnv_cart2csvec (panelid, alpha, beta, gam, np, vec_x, vec_y, vec_z, vecalpha, vecbeta) |
| Convert the components of a vector in local coordinates with an equiangular gnomonic cubed-sphere projection to those in the Cartesian coordinates. | |
| subroutine, public | cubedspherecoordcnv_getmetric (alpha, beta, np, radius, g_ij, gij, gsqrt) |
| Calculate the metrics associated with an equiangular gnomonic cubed-sphere projection to those in longitude and latitude coordinates. | |
Detailed Description
Module common / Coordinate conversion with cubed-sphere projection.
- Description
- A module to provide coordinate conversions with an equiangular gnomonic cubed-sphere projection
- Reference
- Nair et al. 2015: A Discontinuous Galerkin Transport Scheme on the Cubed Sphere. Monthly Weather Review, 133, 814–828. (Appendix A)
- Yin et al. 2017: Parallel numerical simulation of the thermal convection in the Earth’s outer core on the cubed-sphere. Geophysical Journal International, 209, 1934–1954. (Appendix A)
Function/Subroutine Documentation
◆ cubedspherecoordcnv_cs2lonlatpos()
| subroutine, public scale_cubedsphere_coord_cnv::cubedspherecoordcnv_cs2lonlatpos | ( | integer, intent(in) | panelid, |
| real(rp), dimension(np), intent(in) | alpha, | ||
| real(rp), dimension (np), intent(in) | beta, | ||
| real(rp), dimension(np), intent(in) | gam, | ||
| integer, intent(in) | np, | ||
| real(rp), dimension(np), intent(out) | lon, | ||
| real(rp), dimension(np), intent(out) | lat ) |
Calculate longitude and latitude coordinates from local coordinates using the central angles in an equiangular gnomonic cubed-sphere projection.
- Parameters
-
[in] panelid Panel ID of cubed-sphere coordinates [in] np Array size [in] alpha Local coordinate using the central angles [rad] [in] beta Local coordinate using the central angles [rad] [in] gam A factor of r/a [out] lon Longitude coordinate [rad] [out] lat Latitude coordinate [rad]
Definition at line 86 of file scale_cubedsphere_coord_cnv.F90.
91 implicit none
92
93 integer, intent(in) :: panelID !< Panel ID of cubed-sphere coordinates
94 integer, intent(in) :: Np !< Array size
95 real(RP), intent(in) :: alpha(Np) !< Local coordinate using the central angles [rad]
96 real(RP), intent(in) :: beta (Np) !< Local coordinate using the central angles [rad]
97 real(RP), intent(in) :: gam(Np) !< A factor of r/a
98 real(RP), intent(out) :: lon(Np) !< Longitude coordinate [rad]
99 real(RP), intent(out) :: lat(Np) !< Latitude coordinate [rad]
100
101 real(RP) :: CartPos(Np,3)
102 real(RP) :: GeogPos(Np,3)
103
104 integer :: p
105 !-----------------------------------------------------------------------------
106
107 select case( panelid )
108 case( 1, 2, 3, 4 )
109 !$omp parallel do
110 !$acc parallel loop present(alpha, beta, lon, lat)
111 do p=1, np
112 lon(p) = alpha(p) + 0.5_rp * pi * dble(panelid - 1)
113 lat(p) = atan( tan( beta(p) ) * cos( alpha(p) ) )
114
115 if ( lon(p) < 0.0_rp ) lon(p) = lon(p) + 2.0_rp * pi
116 end do
117 !$omp end parallel do
118 case(5, 6)
119 !$acc data create(CartPos, GeogPos) present(alpha, beta, gam, lon, lat)
120 call cubedspherecoordcnv_cs2cartpos( panelid, alpha, beta, gam, np, & ! (in)
121 cartpos(:,1), cartpos(:,2), cartpos(:,3) ) ! (out)
122
124 geogpos(:,:) ) ! (out)
125
126 !$omp parallel do
127 !$acc parallel loop
128 do p=1, np
129 lon(p) = geogpos(p,1)
130 lat(p) = geogpos(p,2)
131
132 if ( alpha(p) < 0.0_rp ) lon(p) = lon(p) + 2.0_rp * pi
133 end do
134 !$omp end parallel do
135 !$acc end data
136 case default
137 log_error("CubedSphereCoordCnv_CS2LonLatPos",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
138 call prc_abort
139 end select
140
141 return
Module common / Coordinate conversion with a geographic coordinate.
Definition scale_geographic_coord_cnv.F90:9
subroutine, public geographiccoordcnv_orth_to_geo_pos(orth_p, np, geo_p)
Definition scale_geographic_coord_cnv.F90:44
References cubedspherecoordcnv_cs2cartpos(), and scale_geographic_coord_cnv::geographiccoordcnv_orth_to_geo_pos().
Referenced by scale_mesh_cubedspheredom2d::meshcubedspheredom2d_setuplocaldom(), scale_mesh_cubedspheredom3d::meshcubedspheredom3d_init(), mod_mkinit_util::mkinitutil_calc_cosinebell_global(), and mod_mkinit_util::mkinitutil_galerkinprojection_global().
◆ cubedspherecoordcnv_cs2lonlatvec()
| subroutine, public scale_cubedsphere_coord_cnv::cubedspherecoordcnv_cs2lonlatvec | ( | integer, intent(in) | panelid, |
| real(rp), dimension(np), intent(in) | alpha, | ||
| real(rp), dimension (np), intent(in) | beta, | ||
| real(rp), dimension(np), intent(in) | gam, | ||
| integer, intent(in) | np, | ||
| real(dp), dimension(np), intent(in) | vecalpha, | ||
| real(dp), dimension (np), intent(in) | vecbeta, | ||
| real(rp), dimension(np), intent(out) | veclon, | ||
| real(rp), dimension(np), intent(out) | veclat, | ||
| real(rp), dimension(np), intent(in), optional | lat, | ||
| integer, intent(in), optional | gpu_async_id ) |
Convert the components of a vector in local coordinates with an equiangular gnomonic cubed-sphere projection to those in longitude and latitude coordinates.
- Parameters
-
[in] panelid Panel ID of cubed-sphere coordinates [in] np Array size [in] alpha Local coordinate using the central angles [rad] [in] beta Local coordinate using the central angles [rad] [in] gam A factor of RPlanet / r [in] vecalpha A component of vector in the alpha-coordinate [in] vecbeta A component of vector in the beta-coordinate [out] veclon A component of vector in the longitude-coordinate [out] veclat A component of vector in the latitude-coordinate [in] lat latitude [rad] [in] gpu_async_id GPU asynchronous ID
Definition at line 147 of file scale_cubedsphere_coord_cnv.F90.
152
153 use scale_const, only: &
154 eps => const_eps
155 implicit none
156
157 integer, intent(in) :: panelID !< Panel ID of cubed-sphere coordinates
158 integer, intent(in) :: Np !< Array size
159 real(RP), intent(in) :: alpha(Np) !< Local coordinate using the central angles [rad]
160 real(RP), intent(in) :: beta (Np) !< Local coordinate using the central angles [rad]
161 real(RP), intent(in) :: gam(Np) !< A factor of RPlanet / r
162 real(DP), intent(in) :: VecAlpha(Np) !< A component of vector in the alpha-coordinate
163 real(DP), intent(in) :: VecBeta (Np) !< A component of vector in the beta-coordinate
164 real(RP), intent(out) :: VecLon(Np) !< A component of vector in the longitude-coordinate
165 real(RP), intent(out) :: VecLat(Np) !< A component of vector in the latitude-coordinate
166 real(RP), intent(in), optional :: lat(Np) !< latitude [rad]
167 integer, intent(in), optional :: gpu_async_id !< GPU asynchronous ID
168
169 integer :: p
170 real(RP) :: X ,Y, del2
171 real(RP) :: s
172
173 real(RP) :: radius
174 real(RP) :: cos_Lat(Np)
175
176 integer :: gpu_async_id_
177 !-----------------------------------------------------------------------------
178
179#ifdef _OPENACC
180 if (present(gpu_async_id)) then
181 gpu_async_id_ = gpu_async_id
182 else
183 gpu_async_id_ = acc_async_sync
184 end if
185#endif
186
187 !$acc data create(cos_Lat) present(alpha, beta, gam, VecLon, VecLat, VecAlpha, VecBeta)
188
189 if (present(lat)) then
190 !$omp parallel do
191 !$acc parallel loop
192 do p=1, np
193 cos_lat(p) = cos(lat(p))
194 end do
195 end if
196
197 select case( panelid )
198 case( 1, 2, 3, 4 )
199 if (.not. present(lat)) then
200 !$omp parallel do
201 !$acc parallel loop async(gpu_async_id_)
202 do p=1, np
203 cos_lat(p) = cos( atan( tan( beta(p) ) * cos( alpha(p) ) ) )
204 end do
205 end if
206
207 !$omp parallel do private( X, Y, del2, radius )
208 !$acc parallel loop async(gpu_async_id_)
209 do p=1, np
210 x = tan( alpha(p) )
211 y = tan( beta(p) )
212 del2 = 1.0_rp + x**2 + y**2
213 radius = rplanet * gam(p)
214
215 veclon(p) = vecalpha(p) * cos_lat(p) * radius
216 veclat(p) = ( - x * y * vecalpha(p) + ( 1.0_rp + y**2 ) * vecbeta(p) ) &
217 * radius * sqrt( 1.0_rp + x**2 ) / del2
218 end do
219 case ( 5 )
220 s = 1.0_rp
221 case ( 6 )
222 s = - 1.0_rp
223 case default
224 log_error("CubedSphereCoordCnv_CS2LonLatVec",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
225 call prc_abort
226 end select
227
228 select case( panelid )
229 case( 5, 6 )
230 !$omp parallel do private( X, Y, del2, radius )
231 !$acc parallel loop async(gpu_async_id_)
232 do p=1, np
233 x = tan( alpha(p) )
234 y = tan( beta(p) )
235 del2 = 1.0_rp + x**2 + y**2
236 radius = s * rplanet * gam(p)
237
238 if (.not. present(lat)) then
239 cos_lat(p) = cos( atan( sign(1.0_rp, s) / max( sqrt( x**2 + y**2 ), eps ) ) )
240 end if
241
242 veclon(p) = (- y * ( 1.0_rp + x**2 ) * vecalpha(p) + x * ( 1.0_rp + y**2 ) * vecbeta(p) ) &
243 * radius / max( x**2 + y**2, eps ) * cos_lat(p)
244 veclat(p) = (- x * ( 1.0_rp + x**2 ) * vecalpha(p) - y * ( 1.0_rp + y**2 ) * vecbeta(p) ) &
245 * radius / ( del2 * ( max( sqrt( x**2 + y**2 ), eps ) ) )
246 end do
247 end select
248
249 !$acc end data
250
251 return
Referenced by scale_atm_phy_tb_dgm_globalsmg::atm_phy_tb_dgm_globalsmg_cal_grad(), mod_atmos_mesh_gm::atmosmeshgm_init(), and mod_ocean_mesh_gm::oceanmeshgm_init().
◆ cubedspherecoordcnv_lonlat2cspos()
| subroutine, public scale_cubedsphere_coord_cnv::cubedspherecoordcnv_lonlat2cspos | ( | integer, intent(in) | panelid, |
| real(rp), dimension(np), intent(in) | lon, | ||
| real(rp), dimension(np), intent(in) | lat, | ||
| integer, intent(in) | np, | ||
| real(rp), dimension(np), intent(out) | alpha, | ||
| real(rp), dimension (np), intent(out) | beta ) |
Calculate local coordinates using the central angles in an equiangular gnomonic cubed-sphere projection from longitude and latitude coordinates.
- Parameters
-
[in] panelid Panel ID of cubed-sphere coordinates [in] np Array size [in] lon Longitude coordinate [rad] [in] lat Latitude coordinate [rad] [out] alpha Local coordinate using the central angles [rad] [out] beta Local coordinate using the central angles [rad]
Definition at line 257 of file scale_cubedsphere_coord_cnv.F90.
260
261 implicit none
262 integer, intent(in) :: panelID !< Panel ID of cubed-sphere coordinates
263 integer, intent(in) :: Np !< Array size
264 real(RP), intent(in) :: lon(Np) !< Longitude coordinate [rad]
265 real(RP), intent(in) :: lat(Np) !< Latitude coordinate [rad]
266 real(RP), intent(out) ::alpha(Np) !< Local coordinate using the central angles [rad]
267 real(RP), intent(out) ::beta (Np) !< Local coordinate using the central angles [rad]
268
269 integer :: p
270 real(RP) :: tan_lat
271 real(RP) :: lon_(Np)
272 !-----------------------------------------------------------------------------
273
274 !$acc data create(lon_) present(lon, lat, alpha, beta)
275
276 select case(panelid)
277 case ( 1, 2, 3, 4 )
278 !$omp parallel
279 if ( panelid == 1 ) then
280 !$omp do
281 !$acc parallel loop
282 do p=1, np
283 if ( lon(p) >= 2.0_rp * pi - 0.25_rp * pi ) then
284 lon_(p) = lon(p) - 2.0_rp * pi
285 else
286 lon_(p) = lon(p)
287 end if
288 end do
289 else
290 !$omp do
291 !$acc parallel loop
292 do p=1, np
293 if ( lon(p) < 0.0_rp ) then
294 lon_(p) = lon(p) + 2.0_rp * pi
295 else
296 lon_(p) = lon(p)
297 end if
298 end do
299 end if
300 !$omp do
301 !$acc parallel loop
302 do p=1, np
303 alpha(p) = lon_(p) - 0.5_rp * pi * ( dble(panelid) - 1.0_rp )
304 beta(p) = atan( tan(lat(p)) / cos(alpha(p)) )
305 end do
306 !$omp end parallel
307 case ( 5 )
308 !$omp parallel private(tan_lat)
309 !$omp do
310 !$acc parallel loop
311 do p=1, np
312 tan_lat = tan(lat(p))
313 alpha(p) = + atan( sin(lon(p)) / tan_lat )
314 beta(p) = - atan( cos(lon(p)) / tan_lat )
315 end do
316 !$omp end parallel
317 case ( 6 )
318 !$omp parallel private(tan_lat)
319 !$omp do
320 !$acc parallel loop
321 do p=1, np
322 tan_lat = tan(lat(p))
323 alpha(p) = - atan( sin(lon(p)) / tan_lat )
324 beta(p) = - atan( cos(lon(p)) / tan_lat )
325 end do
326 !$omp end parallel
327 case default
328 log_error("CubedSphereCoordCnv_LonLat2CSPos",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
329 call prc_abort
330 end select
331
332 !$acc end data
333 return
Referenced by scale_meshutil_cubedsphere2d::meshutilcubedsphere2d_getpanelid().
◆ cubedspherecoordcnv_lonlat2csvec()
| subroutine, public scale_cubedsphere_coord_cnv::cubedspherecoordcnv_lonlat2csvec | ( | integer, intent(in) | panelid, |
| real(rp), dimension(np), intent(in) | alpha, | ||
| real(rp), dimension (np), intent(in) | beta, | ||
| real(rp), dimension(np), intent(in) | gam, | ||
| integer, intent(in) | np, | ||
| real(dp), dimension(np), intent(in) | veclon, | ||
| real(dp), dimension(np), intent(in) | veclat, | ||
| real(dp), dimension(np), intent(out) | vecalpha, | ||
| real(dp), dimension (np), intent(out) | vecbeta, | ||
| real(rp), dimension(np), intent(in), optional | lat, | ||
| integer, intent(in), optional | gpu_async_id ) |
Convert the components of a vector in longitude and latitude coordinates to those in local coordinates with an equiangular gnomonic cubed-sphere projection.
- Parameters
-
[in] panelid Panel ID of cubed-sphere coordinates [in] np Array size [in] alpha Local coordinate using the central angles [rad] [in] beta Local coordinate using the central angles [rad] [in] gam A factor of RPlanet / r [in] veclon A component of vector in the longitude-coordinate [in] veclat A component of vector in the latitude-coordinate [out] vecalpha A component of vector in the alpha-coordinate [out] vecbeta A component of vector in the beta-coordinate [in] lat latitude [rad] [in] gpu_async_id GPU asynchronous ID for OpenACC operations
Definition at line 339 of file scale_cubedsphere_coord_cnv.F90.
344
345 implicit none
346
347 integer, intent(in) :: panelID !< Panel ID of cubed-sphere coordinates
348 integer, intent(in) :: Np !< Array size
349 real(RP), intent(in) :: alpha(Np) !< Local coordinate using the central angles [rad]
350 real(RP), intent(in) :: beta (Np) !< Local coordinate using the central angles [rad]
351 real(RP), intent(in) :: gam(Np) !< A factor of RPlanet / r
352 real(DP), intent(in) :: VecLon(Np) !< A component of vector in the longitude-coordinate
353 real(DP), intent(in) :: VecLat(Np) !< A component of vector in the latitude-coordinate
354 real(DP), intent(out) :: VecAlpha(Np) !< A component of vector in the alpha-coordinate
355 real(DP), intent(out) :: VecBeta (Np) !< A component of vector in the beta-coordinate
356 real(RP), intent(in), optional :: lat(Np) !< latitude [rad]
357 integer, intent(in), optional :: gpu_async_id !< GPU asynchronous ID for OpenACC operations
358
359 integer :: p
360 real(RP) :: X ,Y, del2
361 real(RP) :: s
362
363 real(RP) :: radius
364 real(RP) :: cos_Lat(Np)
365 real(RP) :: VecLon_ov_cosLat
366
367 integer :: gpu_async_id_
368 !-----------------------------------------------------------------------------
369
370#ifdef _OPENACC
371 if (present(gpu_async_id)) then
372 gpu_async_id_ = gpu_async_id
373 else
374 gpu_async_id_ = acc_async_sync
375 end if
376#endif
377
378 !$acc data create(cos_Lat) present(alpha, beta, gam, VecLon, VecLat, VecAlpha, VecBeta)
379
380 if (present(lat)) then
381 !$omp parallel do
382 !$acc parallel loop async(gpu_async_id_)
383 do p=1, np
384 cos_lat(p) = cos(lat(p))
385 end do
386 end if
387
388 select case( panelid )
389 case( 1, 2, 3, 4 )
390 if (.not. present(lat)) then
391 !$omp parallel do
392 !$acc parallel loop async(gpu_async_id_)
393 do p=1, np
394 cos_lat(p) = cos( atan( tan( beta(p) ) * cos( alpha(p) ) ) )
395 end do
396 end if
397
398 !$omp parallel do private( X, Y, del2, radius, VecLon_ov_cosLat )
399 !$acc parallel loop async(gpu_async_id_)
400 do p=1, np
401 x = tan( alpha(p) )
402 y = tan( beta(p) )
403 del2 = 1.0_rp + x**2 + y**2
404 radius = rplanet * gam(p)
405 veclon_ov_coslat = veclon(p) / cos_lat(p)
406
407 vecalpha(p) = veclon_ov_coslat / radius
408 vecbeta(p) = ( x * y * veclon_ov_coslat + del2 / sqrt( 1.0_rp + x**2 ) * veclat(p) ) &
409 / ( radius * (1.0_rp + y**2) )
410 end do
411 case ( 5 )
412 s = 1.0_rp
413 case ( 6 )
414 s = -1.0_rp
415 case default
416 log_error("CubedSphereCoordCnv_LonLat2CSVec",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
417 call prc_abort
418 end select
419
420 select case( panelid )
421 case( 5, 6 )
422 !$omp parallel do private( X, Y, del2, radius, VecLon_ov_cosLat )
423 !$acc parallel loop async(gpu_async_id_)
424 do p=1, np
425 x = tan( alpha(p) )
426 y = tan( beta(p) )
427 del2 = 1.0_rp + x**2 + y**2
428 radius = s * rplanet * gam(p)
429
430 if (.not. present(lat)) then
431 cos_lat(p) = cos( atan( s / sqrt(max(x**2 + y**2, eps)) ) )
432 end if
433 veclon_ov_coslat = veclon(p) / cos_lat(p)
434
435 vecalpha(p) = (- y * veclon_ov_coslat - del2 * x / sqrt( max(del2 - 1.0_rp,eps)) * veclat(p)) &
436 / ( radius * ( 1.0_rp + x**2 ) )
437 vecbeta(p) = ( x * veclon_ov_coslat - del2 * y / sqrt( max(del2 - 1.0_rp,eps)) * veclat(p)) &
438 / ( radius * ( 1.0_rp + y**2 ) )
439 end do
440 end select
441
442 !$acc end data
443
444 return
◆ cubedspherecoordcnv_cs2cartpos()
| subroutine, public scale_cubedsphere_coord_cnv::cubedspherecoordcnv_cs2cartpos | ( | integer, intent(in) | panelid, |
| real(rp), dimension(np), intent(in) | alpha, | ||
| real(rp), dimension (np), intent(in) | beta, | ||
| real(rp), dimension(np), intent(in) | gam, | ||
| integer, intent(in) | np, | ||
| real(rp), dimension(np), intent(out) | x, | ||
| real(rp), dimension(np), intent(out) | y, | ||
| real(rp), dimension(np), intent(out) | z ) |
Calculate the Cartesian coordinates from local coordinates using the central angles in an equiangular gnomonic cubed-sphere projection.
- Parameters
-
[in] panelid Panel ID of cubed-sphere coordinates [in] np Array size [in] alpha Local coordinate using the central angles [rad] [in] beta Local coordinate using the central angles [rad] [in] gam A factor of r/a [out] x x-coordinate in the Cartesian coordinate [out] y y-coordinate in the Cartesian coordinate [out] z z-coordinate in the Cartesian coordinate
Definition at line 450 of file scale_cubedsphere_coord_cnv.F90.
453
454 implicit none
455 integer, intent(in) :: panelID !< Panel ID of cubed-sphere coordinates
456 integer, intent(in) :: Np !< Array size
457 real(RP), intent(in) :: alpha(Np) !< Local coordinate using the central angles [rad]
458 real(RP), intent(in) :: beta (Np) !< Local coordinate using the central angles [rad]
459 real(RP), intent(in) :: gam(Np) !< A factor of r/a
460 real(RP), intent(out) :: X(Np) !< x-coordinate in the Cartesian coordinate
461 real(RP), intent(out) :: Y(Np) !< y-coordinate in the Cartesian coordinate
462 real(RP), intent(out) :: Z(Np) !< z-coordinate in the Cartesian coordinate
463
464 integer :: p
465 real(RP) :: x1, x2, fac
466
467 !-----------------------------------------------------------------------------
468
469 select case(panelid)
470 case(1)
471 !$omp parallel do private(x1, x2, fac)
472 !$acc parallel loop present(alpha, beta, gam, X, Y, Z)
473 do p=1, np
474 x1 = tan( alpha(p) )
475 x2 = tan( beta(p) )
476 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
477 x(p) = fac
478 y(p) = fac * x1
479 z(p) = fac * x2
480 end do
481 case(2)
482 !$omp parallel do private(x1, x2, fac)
483 !$acc parallel loop present(alpha, beta, gam, X, Y, Z)
484 do p=1, np
485 x1 = tan( alpha(p) )
486 x2 = tan( beta(p) )
487 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
488 x(p) = - fac * x1
489 y(p) = fac
490 z(p) = fac * x2
491 end do
492 case(3)
493 !$omp parallel do private(x1, x2, fac)
494 !$acc parallel loop present(alpha, beta, gam, X, Y, Z)
495 do p=1, np
496 x1 = tan( alpha(p) )
497 x2 = tan( beta(p) )
498 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
499 x(p) = - fac
500 y(p) = - fac * x1
501 z(p) = fac * x2
502 end do
503 case(4)
504 !$omp parallel do private(x1, x2, fac)
505 !$acc parallel loop present(alpha, beta, gam, X, Y, Z)
506 do p=1, np
507 x1 = tan( alpha(p) )
508 x2 = tan( beta(p) )
509 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
510 x(p) = fac * x1
511 y(p) = - fac
512 z(p) = fac * x2
513 end do
514 case(5)
515 !$omp parallel do private(x1, x2, fac)
516 !$acc parallel loop present(alpha, beta, gam, X, Y, Z)
517 do p=1, np
518 x1 = tan( alpha(p) )
519 x2 = tan( beta(p) )
520 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
521 x(p) = - fac * x2
522 y(p) = fac * x1
523 z(p) = fac
524 end do
525 case(6)
526 !$omp parallel do private(x1, x2, fac)
527 !$acc parallel loop present(alpha, beta, gam, X, Y, Z)
528 do p=1, np
529 x1 = tan( alpha(p) )
530 x2 = tan( beta(p) )
531 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
532 x(p) = fac * x2
533 y(p) = fac * x1
534 z(p) = - fac
535 end do
536 case default
537 log_error("CubedSphereCoordCnv_CS2CartPos",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
538 call prc_abort
539 end select
540
541 return
Referenced by cubedspherecoordcnv_cs2lonlatpos().
◆ cubedspherecoordcnv_cart2csvec()
| subroutine, public scale_cubedsphere_coord_cnv::cubedspherecoordcnv_cart2csvec | ( | integer, intent(in) | panelid, |
| real(rp), dimension(np), intent(in) | alpha, | ||
| real(rp), dimension (np), intent(in) | beta, | ||
| real(rp), dimension(np), intent(in) | gam, | ||
| integer, intent(in) | np, | ||
| real(dp), dimension(np), intent(in) | vec_x, | ||
| real(dp), dimension(np), intent(in) | vec_y, | ||
| real(dp), dimension(np), intent(in) | vec_z, | ||
| real(rp), dimension(np), intent(out) | vecalpha, | ||
| real(rp), dimension (np), intent(out) | vecbeta ) |
Convert the components of a vector in local coordinates with an equiangular gnomonic cubed-sphere projection to those in the Cartesian coordinates.
- Parameters
-
[in] panelid Panel ID of cubed-sphere coordinates [in] np Array size [in] alpha Local coordinate using the central angles [rad] [in] beta Local coordinate using the central angles [rad] [in] gam A factor of RPlanet / r [in] vec_x A component of vector in the x-coordinate with the Cartesian coordinate [in] vec_y A component of vector in the y-coordinate with the Cartesian coordinate [in] vec_z A component of vector in the z-coordinate with the Cartesian coordinate [out] vecalpha A component of vector in the alpha-coordinate [out] vecbeta A component of vector in the beta-coordinate
Definition at line 547 of file scale_cubedsphere_coord_cnv.F90.
551
552 implicit none
553
554 integer, intent(in) :: panelID !< Panel ID of cubed-sphere coordinates
555 integer, intent(in) :: Np !< Array size
556 real(RP), intent(in) :: alpha(Np) !< Local coordinate using the central angles [rad]
557 real(RP), intent(in) :: beta (Np) !< Local coordinate using the central angles [rad]
558 real(RP), intent(in) :: gam(Np) !< A factor of RPlanet / r
559 real(DP), intent(in) :: Vec_x(Np) !< A component of vector in the x-coordinate with the Cartesian coordinate
560 real(DP), intent(in) :: Vec_y(Np) !< A component of vector in the y-coordinate with the Cartesian coordinate
561 real(DP), intent(in) :: Vec_z(Np) !< A component of vector in the z-coordinate with the Cartesian coordinate
562 real(RP), intent(out) :: VecAlpha(Np) !< A component of vector in the alpha-coordinate
563 real(RP), intent(out) :: VecBeta (Np) !< A component of vector in the beta-coordinate
564
565 integer :: p
566 real(RP) :: x1, x2, fac
567 real(RP) :: r_sec2_alpha, r_sec2_beta
568 !-----------------------------------------------------------------------------
569
570 select case( panelid )
571 case(1)
572 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
573 !$acc parallel loop present(alpha, beta, gam, Vec_x, Vec_y, Vec_z, VecAlpha, VecBeta)
574 do p=1, np
575 x1 = tan( alpha(p) )
576 x2 = tan( beta(p) )
577 r_sec2_alpha = cos(alpha(p))**2
578 r_sec2_beta = cos(beta(p))**2
579 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
580
581 vecalpha(p) = fac * r_sec2_alpha * ( - x1 * vec_x(p) + vec_y(p) )
582 vecbeta(p) = fac * r_sec2_beta * ( - x2 * vec_x(p) + vec_z(p) )
583 end do
584 case(2)
585 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
586 !$acc parallel loop present(alpha, beta, gam, Vec_x, Vec_y, Vec_z, VecAlpha, VecBeta)
587 do p=1, np
588 x1 = tan( alpha(p) )
589 x2 = tan( beta(p) )
590 r_sec2_alpha = cos(alpha(p))**2
591 r_sec2_beta = cos(beta(p))**2
592 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
593
594 vecalpha(p) = - fac * r_sec2_alpha * ( vec_x(p) + x1 * vec_y(p) )
595 vecbeta(p) = fac * r_sec2_beta * ( - x2 * vec_y(p) + vec_z(p) )
596 end do
597 case(3)
598 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
599 !$acc parallel loop present(alpha, beta, gam, Vec_x, Vec_y, Vec_z, VecAlpha, VecBeta)
600 do p=1, np
601 x1 = tan( alpha(p) )
602 x2 = tan( beta(p) )
603 r_sec2_alpha = cos(alpha(p))**2
604 r_sec2_beta = cos(beta(p))**2
605 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
606
607 vecalpha(p) = fac * r_sec2_alpha * ( x1 * vec_x(p) - vec_y(p) )
608 vecbeta(p) = fac * r_sec2_beta * ( x2 * vec_x(p) + vec_z(p) )
609 end do
610 case(4)
611 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
612 !$acc parallel loop present(alpha, beta, gam, Vec_x, Vec_y, Vec_z, VecAlpha, VecBeta)
613 do p=1, np
614 x1 = tan( alpha(p) )
615 x2 = tan( beta(p) )
616 r_sec2_alpha = cos(alpha(p))**2
617 r_sec2_beta = cos(beta(p))**2
618 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
619
620 vecalpha(p) = fac * r_sec2_alpha * ( vec_x(p) + x1 * vec_y(p) )
621 vecbeta(p) = fac * r_sec2_beta * ( x2 * vec_y(p) + vec_z(p) )
622 end do
623 case ( 5 )
624 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
625 !$acc parallel loop present(alpha, beta, gam, Vec_x, Vec_y, Vec_z, VecAlpha, VecBeta)
626 do p=1, np
627 x1 = tan( alpha(p) )
628 x2 = tan( beta(p) )
629 r_sec2_alpha = cos(alpha(p))**2
630 r_sec2_beta = cos(beta(p))**2
631 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
632
633 vecalpha(p) = fac * r_sec2_alpha * ( vec_y(p) - x1 * vec_z(p) )
634 vecbeta(p) = - fac * r_sec2_beta * ( vec_x(p) + x2 * vec_z(p) )
635 end do
636 case ( 6 )
637 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
638 !$acc parallel loop present(alpha, beta, gam, Vec_x, Vec_y, Vec_z, VecAlpha, VecBeta)
639 do p=1, np
640 x1 = tan( alpha(p) )
641 x2 = tan( beta(p) )
642 r_sec2_alpha = cos(alpha(p))**2
643 r_sec2_beta = cos(beta(p))**2
644 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
645
646 vecalpha(p) = fac * r_sec2_alpha * ( vec_y(p) + x1 * vec_z(p) )
647 vecbeta(p) = fac * r_sec2_beta * ( vec_x(p) + x2 * vec_z(p) )
648 end do
649 case default
650 log_error("CubedSphereCoordCnv_Cart2CSVec",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
651 call prc_abort
652 end select
653
654 return
◆ cubedspherecoordcnv_getmetric()
| subroutine, public scale_cubedsphere_coord_cnv::cubedspherecoordcnv_getmetric | ( | real(rp), dimension(np), intent(in) | alpha, |
| real(rp), dimension (np), intent(in) | beta, | ||
| integer, intent(in) | np, | ||
| real(rp), intent(in) | radius, | ||
| real(rp), dimension(np,2,2), intent(out) | g_ij, | ||
| real(rp), dimension (np,2,2), intent(out) | gij, | ||
| real(rp), dimension(np), intent(out) | gsqrt ) |
Calculate the metrics associated with an equiangular gnomonic cubed-sphere projection to those in longitude and latitude coordinates.
- Parameters
-
[in] np Array size [in] alpha Local coordinate using the central angles [rad] [in] beta Local coordinate using the central angles [rad] [in] radius Planetary radius [out] g_ij Horizontal covariant metric tensor [out] gij Horizontal contravariant metric tensor [out] gsqrt Horizontal Jacobian
Definition at line 800 of file scale_cubedsphere_coord_cnv.F90.
803
804 implicit none
805
806 integer, intent(in) :: Np !< Array size
807 real(RP), intent(in) :: alpha(Np) !< Local coordinate using the central angles [rad]
808 real(RP), intent(in) :: beta (Np) !< Local coordinate using the central angles [rad]
809 real(RP), intent(in) :: radius !< Planetary radius
810 real(RP), intent(out) :: G_ij(Np,2,2) !< Horizontal covariant metric tensor
811 real(RP), intent(out) :: GIJ (Np,2,2) !< Horizontal contravariant metric tensor
812 real(RP), intent(out) :: Gsqrt(Np) !< Horizontal Jacobian
813
814 real(RP) :: X, Y
815 real(RP) :: r2
816 real(RP) :: fac
817 real(RP) :: G_ij_(2,2)
818 real(RP) :: GIJ_ (2,2)
819
820 integer :: p
821 real(RP) :: OnePlusX2, OnePlusY2
822 !-----------------------------------------------------------------------------
823
824 !$omp parallel do private( &
825 !$omp X, Y, r2, OnePlusX2, OnePlusY2, fac, &
826 !$omp G_ij_, GIJ_ )
827 !$acc parallel loop private(G_ij_, GIJ_) present(alpha, beta, G_ij, GIJ, Gsqrt)
828 do p=1, np
829 x = tan(alpha(p))
830 y = tan(beta(p))
831 r2 = 1.0_rp + x**2 + y**2
832 oneplusx2 = 1.0_rp + x**2
833 oneplusy2 = 1.0_rp + y**2
834
835 fac = oneplusx2 * oneplusy2 * ( radius / r2 )**2
836 g_ij_(1,1) = fac * oneplusx2
837 g_ij_(1,2) = - fac * (x * y)
838 g_ij_(2,1) = - fac * (x * y)
839 g_ij_(2,2) = fac * oneplusy2
840 g_ij(p,:,:) = g_ij_(:,:)
841
842 gsqrt(p) = radius**2 * oneplusx2 * oneplusy2 / ( r2 * sqrt(r2) )
843
844 fac = 1.0_rp / gsqrt(p)**2
845 gij_(1,1) = fac * g_ij_(2,2)
846 gij_(1,2) = - fac * g_ij_(1,2)
847 gij_(2,1) = - fac * g_ij_(2,1)
848 gij_(2,2) = fac * g_ij_(1,1)
849 gij(p,:,:) = gij_(:,:)
850 end do
851
852 return
Referenced by scale_mesh_cubedspheredom2d::meshcubedspheredom2d_setuplocaldom(), and scale_mesh_cubedspheredom3d::meshcubedspheredom3d_init().
Generated by
1.14.0