FE-Project
Loading...
Searching...
No Matches
Data Types | Functions/Subroutines
scale_cubedsphere_coord_cnv Module Reference

module common / Coordinate conversion with a cubed-sphere More...

Data Types

interface  cubedspherecoordcnv_cs2localorthvec_alpha
 
interface  cubedspherecoordcnv_localorth2csvec_alpha
 

Functions/Subroutines

subroutine, public cubedspherecoordcnv_cs2lonlatpos (panelid, alpha, beta, gam, np, lon, lat)
 
subroutine, public cubedspherecoordcnv_cs2lonlatvec (panelid, alpha, beta, gam, np, vecalpha, vecbeta, veclon, veclat, lat)
 
subroutine, public cubedspherecoordcnv_lonlat2cspos (panelid, lon, lat, np, alpha, beta)
 
subroutine, public cubedspherecoordcnv_lonlat2csvec (panelid, alpha, beta, gam, np, veclon, veclat, vecalpha, vecbeta, lat)
 
subroutine, public cubedspherecoordcnv_cs2cartpos (panelid, alpha, beta, gam, np, x, y, z)
 
subroutine, public cubedspherecoordcnv_cart2csvec (panelid, alpha, beta, gam, np, vec_x, vec_y, vec_z, vecalpha, vecbeta)
 
subroutine, public cubedspherecoordcnv_getmetric (alpha, beta, np, radius, g_ij, gij, gsqrt)
 

Detailed Description

module common / Coordinate conversion with a cubed-sphere

Description
Coordinate conversion with a cubed-sphere
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)
Author
Yuta Kawai, Team SCALE

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 )

Definition at line 83 of file scale_cubedsphere_coord_cnv.F90.

86 use scale_geographic_coord_cnv, only: &
87 geographiccoordcnv_orth_to_geo_pos
88 implicit none
89
90 integer, intent(in) :: panelID
91 integer, intent(in) :: Np
92 real(RP), intent(in) :: alpha(Np)
93 real(RP), intent(in) :: beta (Np)
94 real(RP), intent(in) :: gam(Np)
95 real(RP), intent(out) :: lon(Np)
96 real(RP), intent(out) :: lat(Np)
97
98 real(RP) :: CartPos(Np,3)
99 real(RP) :: GeogPos(Np,3)
100
101 integer :: p
102 !-----------------------------------------------------------------------------
103
104 select case( panelid )
105 case( 1, 2, 3, 4 )
106 !$omp parallel
107 !$omp do
108 do p=1, np
109 lon(p) = alpha(p) + 0.5_rp * pi * dble(panelid - 1)
110 lat(p) = atan( tan( beta(p) ) * cos( alpha(p) ) )
111 end do
112 !$omp workshare
113 where( lon(:) < 0.0_rp )
114 lon(:) = lon(:) + 2.0_rp * pi
115 end where
116 !$omp end workshare
117 !$omp end parallel
118 case(5, 6)
119 call cubedspherecoordcnv_cs2cartpos( panelid, alpha, beta, gam, np, & ! (in)
120 cartpos(:,1), cartpos(:,2), cartpos(:,3) ) ! (out)
121
122 call geographiccoordcnv_orth_to_geo_pos( cartpos(:,:), np, & ! (in)
123 geogpos(:,:) ) ! (out)
124
125 !$omp parallel
126 !$omp do
127 do p=1, np
128 lon(p) = geogpos(p,1)
129 lat(p) = geogpos(p,2)
130 end do
131 !$omp workshare
132 where( alpha < 0.0_rp )
133 lon(:) = lon(:) + 2.0_rp * pi
134 end where
135 !$omp end workshare
136 !$omp end parallel
137 case default
138 log_error("CubedSphereCoordCnv_CS2LonLatPos",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
139 call prc_abort
140 end select
141
142 return
scale_geographic_coord_cnv
module common / Coordinate conversion with a geographic coordinate
Definition scale_geographic_coord_cnv.F90:9
scale_geographic_coord_cnv::geographiccoordcnv_orth_to_geo_pos
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 )

Definition at line 146 of file scale_cubedsphere_coord_cnv.F90.

151
152 use scale_const, only: &
153 eps => const_eps
154 implicit none
155
156 integer, intent(in) :: panelID
157 integer, intent(in) :: Np
158 real(RP), intent(in) :: alpha(Np)
159 real(RP), intent(in) :: beta (Np)
160 real(RP), intent(in) :: gam(Np) ! RPlanet / r
161 real(DP), intent(in) :: VecAlpha(Np)
162 real(DP), intent(in) :: VecBeta (Np)
163 real(RP), intent(out) :: VecLon(Np)
164 real(RP), intent(out) :: VecLat(Np)
165 real(RP), intent(in), optional :: lat(Np)
166
167 integer :: p
168 real(RP) :: X ,Y, del2
169 real(RP) :: s
170
171 real(RP) :: radius
172 real(RP) :: cos_Lat(Np)
173 !-----------------------------------------------------------------------------
174
175 if (present(lat)) then
176 !$omp parallel do
177 do p=1, np
178 cos_lat(p) = cos(lat(p))
179 end do
180 end if
181
182 select case( panelid )
183 case( 1, 2, 3, 4 )
184 if (.not. present(lat)) then
185 !$omp parallel do
186 do p=1, np
187 cos_lat(p) = cos( atan( tan( beta(p) ) * cos( alpha(p) ) ) )
188 end do
189 end if
190
191 !$omp parallel do private( X, Y, del2, radius )
192 do p=1, np
193 x = tan( alpha(p) )
194 y = tan( beta(p) )
195 del2 = 1.0_rp + x**2 + y**2
196 radius = rplanet * gam(p)
197
198 veclon(p) = vecalpha(p) * cos_lat(p) * radius
199 veclat(p) = ( - x * y * vecalpha(p) + ( 1.0_rp + y**2 ) * vecbeta(p) ) &
200 * radius * sqrt( 1.0_rp + x**2 ) / del2
201 end do
202 case ( 5 )
203 s = 1.0_rp
204 case ( 6 )
205 s = - 1.0_rp
206 case default
207 log_error("CubedSphereCoordCnv_CS2LonLatVec",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
208 call prc_abort
209 end select
210
211 select case( panelid )
212 case( 5, 6 )
213 !$omp parallel do private( X, Y, del2, radius )
214 do p=1, np
215 x = tan( alpha(p) )
216 y = tan( beta(p) )
217 del2 = 1.0_rp + x**2 + y**2
218 radius = s * rplanet * gam(p)
219
220 if (.not. present(lat)) then
221 cos_lat(p) = cos( atan( sign(1.0_rp, s) / max( sqrt( x**2 + y**2 ), eps ) ) )
222 end if
223
224 veclon(p) = (- y * ( 1.0_rp + x**2 ) * vecalpha(p) + x * ( 1.0_rp + y**2 ) * vecbeta(p) ) &
225 * radius / max( x**2 + y**2, eps ) * cos_lat(p)
226 veclat(p) = (- x * ( 1.0_rp + x**2 ) * vecalpha(p) - y * ( 1.0_rp + y**2 ) * vecbeta(p) ) &
227 * radius / ( del2 * ( max( sqrt( x**2 + y**2 ), eps ) ) )
228 end do
229 end select
230
231 return

Referenced by scale_atm_phy_tb_dgm_globalsmg::atm_phy_tb_dgm_globalsmg_cal_grad(), and mod_atmos_mesh_gm::atmosmeshgm_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 )

Definition at line 235 of file scale_cubedsphere_coord_cnv.F90.

238
239 implicit none
240
241 integer, intent(in) :: panelID
242 integer, intent(in) :: Np
243 real(RP), intent(in) :: lon(Np)
244 real(RP), intent(in) :: lat(Np)
245 real(RP), intent(out) ::alpha(Np)
246 real(RP), intent(out) ::beta (Np)
247
248 integer :: p
249 real(RP) :: tan_lat
250 real(RP) :: lon_(Np)
251 !-----------------------------------------------------------------------------
252
253 select case(panelid)
254 case ( 1, 2, 3, 4 )
255 !$omp parallel
256 if ( panelid == 1 ) then
257 !$omp workshare
258 where (lon(:) >= 2.0_rp * pi - 0.25_rp * pi )
259 lon_(:) = lon(:) - 2.0_rp * pi
260 elsewhere
261 lon_(:) = lon(:)
262 end where
263 !$omp end workshare
264 else
265 !$omp workshare
266 where (lon(:) < 0.0_rp )
267 lon_(:) = lon(:) + 2.0_rp * pi
268 elsewhere
269 lon_(:) = lon(:)
270 end where
271 !$omp end workshare
272 end if
273 !$omp do
274 do p=1, np
275 alpha(p) = lon_(p) - 0.5_rp * pi * ( dble(panelid) - 1.0_rp )
276 beta(p) = atan( tan(lat(p)) / cos(alpha(p)) )
277 end do
278 !$omp end parallel
279 case ( 5 )
280 !$omp parallel private(tan_lat)
281 !$omp do
282 do p=1, np
283 tan_lat = tan(lat(p))
284 alpha(p) = + atan( sin(lon(p)) / tan_lat )
285 beta(p) = - atan( cos(lon(p)) / tan_lat )
286 end do
287 !$omp end parallel
288 case ( 6 )
289 !$omp parallel private(tan_lat)
290 !$omp do
291 do p=1, np
292 tan_lat = tan(lat(p))
293 alpha(p) = - atan( sin(lon(p)) / tan_lat )
294 beta(p) = - atan( cos(lon(p)) / tan_lat )
295 end do
296 !$omp end parallel
297 case default
298 log_error("CubedSphereCoordCnv_LonLat2CSPos",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
299 call prc_abort
300 end select
301
302 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(rp), dimension(np), intent(out) vecalpha,
real(rp), dimension (np), intent(out) vecbeta,
real(rp), dimension(np), intent(in), optional lat )

Definition at line 308 of file scale_cubedsphere_coord_cnv.F90.

313
314 implicit none
315
316 integer, intent(in) :: panelID
317 integer, intent(in) :: Np
318 real(RP), intent(in) :: alpha(Np)
319 real(RP), intent(in) :: beta (Np)
320 real(RP), intent(in) :: gam(Np)
321 real(DP), intent(in) :: VecLon(Np)
322 real(DP), intent(in) :: VecLat(Np)
323 real(RP), intent(out) :: VecAlpha(Np)
324 real(RP), intent(out) :: VecBeta (Np)
325 real(RP), intent(in), optional :: lat(Np)
326
327 integer :: p
328 real(RP) :: X ,Y, del2
329 real(RP) :: s
330
331 real(RP) :: radius
332 real(RP) :: cos_Lat(Np)
333 real(RP) :: VecLon_ov_cosLat
334 !-----------------------------------------------------------------------------
335
336 if (present(lat)) then
337 !$omp parallel do
338 do p=1, np
339 cos_lat(p) = cos(lat(p))
340 end do
341 end if
342
343 select case( panelid )
344 case( 1, 2, 3, 4 )
345 if (.not. present(lat)) then
346 !$omp parallel do
347 do p=1, np
348 cos_lat(p) = cos( atan( tan( beta(p) ) * cos( alpha(p) ) ) )
349 end do
350 end if
351
352 !$omp parallel do private( X, Y, del2, radius, VecLon_ov_cosLat )
353 do p=1, np
354 x = tan( alpha(p) )
355 y = tan( beta(p) )
356 del2 = 1.0_rp + x**2 + y**2
357 radius = rplanet * gam(p)
358 veclon_ov_coslat = veclon(p) / cos_lat(p)
359
360 vecalpha(p) = veclon_ov_coslat / radius
361 vecbeta(p) = ( x * y * veclon_ov_coslat + del2 / sqrt( 1.0_rp + x**2 ) * veclat(p) ) &
362 / ( radius * (1.0_rp + y**2) )
363 end do
364 case ( 5 )
365 s = 1.0_rp
366 case ( 6 )
367 s = -1.0_rp
368 case default
369 log_error("CubedSphereCoordCnv_LonLat2CSVec",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
370 call prc_abort
371 end select
372
373 select case( panelid )
374 case( 5, 6 )
375 !$omp parallel do private( X, Y, del2, radius, VecLon_ov_cosLat )
376 do p=1, np
377 x = tan( alpha(p) )
378 y = tan( beta(p) )
379 del2 = 1.0_rp + x**2 + y**2
380 radius = s * rplanet * gam(p)
381
382 if (.not. present(lat)) then
383 cos_lat(p) = cos( atan( s / sqrt(max(x**2 + y**2, eps)) ) )
384 end if
385 veclon_ov_coslat = veclon(p) / cos_lat(p)
386
387 vecalpha(p) = (- y * veclon_ov_coslat - del2 * x / sqrt( max(del2 - 1.0_rp,eps)) * veclat(p)) &
388 / ( radius * ( 1.0_rp + x**2 ) )
389 vecbeta(p) = ( x * veclon_ov_coslat - del2 * y / sqrt( max(del2 - 1.0_rp,eps)) * veclat(p)) &
390 / ( radius * ( 1.0_rp + y**2 ) )
391 end do
392 end select
393
394 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 )

Definition at line 398 of file scale_cubedsphere_coord_cnv.F90.

401
402 implicit none
403 integer, intent(in) :: panelID
404 integer, intent(in) :: Np
405 real(RP), intent(in) :: alpha(Np)
406 real(RP), intent(in) :: beta (Np)
407 real(RP), intent(in) :: gam(Np)
408 real(RP), intent(out) :: X(Np)
409 real(RP), intent(out) :: Y(Np)
410 real(RP), intent(out) :: Z(Np)
411
412 integer :: p
413 real(RP) :: x1, x2, fac
414
415 !-----------------------------------------------------------------------------
416
417 select case(panelid)
418 case(1)
419 !$omp parallel do private(x1, x2, fac)
420 do p=1, np
421 x1 = tan( alpha(p) )
422 x2 = tan( beta(p) )
423 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
424 x(p) = fac
425 y(p) = fac * x1
426 z(p) = fac * x2
427 end do
428 case(2)
429 !$omp parallel do private(x1, x2, fac)
430 do p=1, np
431 x1 = tan( alpha(p) )
432 x2 = tan( beta(p) )
433 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
434 x(p) = - fac * x1
435 y(p) = fac
436 z(p) = fac * x2
437 end do
438 case(3)
439 !$omp parallel do private(x1, x2, fac)
440 do p=1, np
441 x1 = tan( alpha(p) )
442 x2 = tan( beta(p) )
443 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
444 x(p) = - fac
445 y(p) = - fac * x1
446 z(p) = fac * x2
447 end do
448 case(4)
449 !$omp parallel do private(x1, x2, fac)
450 do p=1, np
451 x1 = tan( alpha(p) )
452 x2 = tan( beta(p) )
453 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
454 x(p) = fac * x1
455 y(p) = - fac
456 z(p) = fac * x2
457 end do
458 case(5)
459 !$omp parallel do private(x1, x2, fac)
460 do p=1, np
461 x1 = tan( alpha(p) )
462 x2 = tan( beta(p) )
463 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
464 x(p) = - fac * x2
465 y(p) = fac * x1
466 z(p) = fac
467 end do
468 case(6)
469 !$omp parallel do private(x1, x2, fac)
470 do p=1, np
471 x1 = tan( alpha(p) )
472 x2 = tan( beta(p) )
473 fac = rplanet * gam(p) / sqrt( 1.0_rp + x1**2 + x2**2 )
474 x(p) = fac * x2
475 y(p) = fac * x1
476 z(p) = - fac
477 end do
478 case default
479 log_error("CubedSphereCoordCnv_CS2CartPos",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
480 call prc_abort
481 end select
482
483 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 )

Definition at line 489 of file scale_cubedsphere_coord_cnv.F90.

493
494 implicit none
495
496 integer, intent(in) :: panelID
497 integer, intent(in) :: Np
498 real(RP), intent(in) :: alpha(Np)
499 real(RP), intent(in) :: beta (Np)
500 real(RP), intent(in) :: gam(Np)
501 real(DP), intent(in) :: Vec_x(Np)
502 real(DP), intent(in) :: Vec_y(Np)
503 real(DP), intent(in) :: Vec_z(Np)
504 real(RP), intent(out) :: VecAlpha(Np)
505 real(RP), intent(out) :: VecBeta (Np)
506
507 integer :: p
508 real(RP) :: x1, x2, fac
509 real(RP) :: r_sec2_alpha, r_sec2_beta
510 !-----------------------------------------------------------------------------
511
512 select case( panelid )
513 case(1)
514 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
515 do p=1, np
516 x1 = tan( alpha(p) )
517 x2 = tan( beta(p) )
518 r_sec2_alpha = cos(alpha(p))**2
519 r_sec2_beta = cos(beta(p))**2
520 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
521
522 vecalpha(p) = fac * r_sec2_alpha * ( - x1 * vec_x(p) + vec_y(p) )
523 vecbeta(p) = fac * r_sec2_beta * ( - x2 * vec_x(p) + vec_z(p) )
524 end do
525 case(2)
526 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
527 do p=1, np
528 x1 = tan( alpha(p) )
529 x2 = tan( beta(p) )
530 r_sec2_alpha = cos(alpha(p))**2
531 r_sec2_beta = cos(beta(p))**2
532 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
533
534 vecalpha(p) = - fac * r_sec2_alpha * ( vec_x(p) + x1 * vec_y(p) )
535 vecbeta(p) = fac * r_sec2_beta * ( - x2 * vec_y(p) + vec_z(p) )
536 end do
537 case(3)
538 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
539 do p=1, np
540 x1 = tan( alpha(p) )
541 x2 = tan( beta(p) )
542 r_sec2_alpha = cos(alpha(p))**2
543 r_sec2_beta = cos(beta(p))**2
544 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
545
546 vecalpha(p) = fac * r_sec2_alpha * ( x1 * vec_x(p) - vec_y(p) )
547 vecbeta(p) = fac * r_sec2_beta * ( x2 * vec_x(p) + vec_z(p) )
548 end do
549 case(4)
550 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
551 do p=1, np
552 x1 = tan( alpha(p) )
553 x2 = tan( beta(p) )
554 r_sec2_alpha = cos(alpha(p))**2
555 r_sec2_beta = cos(beta(p))**2
556 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
557
558 vecalpha(p) = fac * r_sec2_alpha * ( vec_x(p) + x1 * vec_y(p) )
559 vecbeta(p) = fac * r_sec2_beta * ( x2 * vec_y(p) + vec_z(p) )
560 end do
561 case ( 5 )
562 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
563 do p=1, np
564 x1 = tan( alpha(p) )
565 x2 = tan( beta(p) )
566 r_sec2_alpha = cos(alpha(p))**2
567 r_sec2_beta = cos(beta(p))**2
568 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
569
570 vecalpha(p) = fac * r_sec2_alpha * ( vec_y(p) - x1 * vec_z(p) )
571 vecbeta(p) = - fac * r_sec2_beta * ( vec_x(p) + x2 * vec_z(p) )
572 end do
573 case ( 6 )
574 !$omp parallel do private(x1, x2, r_sec2_alpha, r_sec2_beta, fac)
575 do p=1, np
576 x1 = tan( alpha(p) )
577 x2 = tan( beta(p) )
578 r_sec2_alpha = cos(alpha(p))**2
579 r_sec2_beta = cos(beta(p))**2
580 fac = sqrt( 1.0_rp + x1**2 + x2**2 ) / ( rplanet * gam(p) )
581
582 vecalpha(p) = fac * r_sec2_alpha * ( vec_y(p) + x1 * vec_z(p) )
583 vecbeta(p) = fac * r_sec2_beta * ( vec_x(p) + x2 * vec_z(p) )
584 end do
585 case default
586 log_error("CubedSphereCoordCnv_Cart2CSVec",'(a,i2,a)') "panelID ", panelid, " is invalid. Check!"
587 call prc_abort
588 end select
589
590 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 )

Definition at line 725 of file scale_cubedsphere_coord_cnv.F90.

728
729 implicit none
730
731 integer, intent(in) :: Np
732 real(RP), intent(in) :: alpha(Np)
733 real(RP), intent(in) :: beta(Np)
734 real(RP), intent(in) :: radius
735 real(RP), intent(out) :: G_ij(Np,2,2)
736 real(RP), intent(out) :: GIJ (Np,2,2)
737 real(RP), intent(out) :: Gsqrt(Np)
738
739 real(RP) :: X, Y
740 real(RP) :: r2
741 real(RP) :: fac
742 real(RP) :: G_ij_(2,2)
743 real(RP) :: GIJ_ (2,2)
744
745 integer :: p
746 real(RP) :: OnePlusX2, OnePlusY2
747 !-----------------------------------------------------------------------------
748
749 !$omp parallel do private( &
750 !$omp X, Y, r2, OnePlusX2, OnePlusY2, fac, &
751 !$omp G_ij_, GIJ_ )
752 do p=1, np
753 x = tan(alpha(p))
754 y = tan(beta(p))
755 r2 = 1.0_rp + x**2 + y**2
756 oneplusx2 = 1.0_rp + x**2
757 oneplusy2 = 1.0_rp + y**2
758
759 fac = oneplusx2 * oneplusy2 * ( radius / r2 )**2
760 g_ij_(1,1) = fac * oneplusx2
761 g_ij_(1,2) = - fac * (x * y)
762 g_ij_(2,1) = - fac * (x * y)
763 g_ij_(2,2) = fac * oneplusy2
764 g_ij(p,:,:) = g_ij_(:,:)
765
766 gsqrt(p) = radius**2 * oneplusx2 * oneplusy2 / ( r2 * sqrt(r2) )
767
768 fac = 1.0_rp / gsqrt(p)**2
769 gij_(1,1) = fac * g_ij_(2,2)
770 gij_(1,2) = - fac * g_ij_(1,2)
771 gij_(2,1) = - fac * g_ij_(2,1)
772 gij_(2,2) = fac * g_ij_(1,1)
773 gij(p,:,:) = gij_(:,:)
774 end do
775
776 return

Referenced by scale_mesh_cubedspheredom2d::meshcubedspheredom2d_setuplocaldom(), and scale_mesh_cubedspheredom3d::meshcubedspheredom3d_init().

Generated by doxygen 1.10.0