This repository was archived by the owner on Aug 28, 2024. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Restyled and added quad precision intermediates for improved accuracy
- Loading branch information
Showing
1 changed file
with
24 additions
and
56 deletions.
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,56 +1,24 @@ | ||
| !********************************************************************************************************************************** | ||
| ! | ||
| ! Unit Name : util_crossproduct | ||
| ! Unit Type : subroutine | ||
| ! Project : Swifter | ||
| ! Package : util | ||
| ! Language : Fortran 90/95 | ||
| ! | ||
| ! Description : Calculates cross product of two arrays | ||
| ! | ||
| ! | ||
| ! Invocation : CALL util_crossproduct(symba_plA, npl) | ||
| ! | ||
| !********************************************************************************************************************************** | ||
| pure SUBROUTINE util_crossproduct(ar1, ar2, ans) | ||
|
|
||
| ! Modules | ||
| USE swiftest_globals | ||
| USE module_interfaces, EXCEPT_THIS_ONE => util_crossproduct | ||
| IMPLICIT NONE | ||
|
|
||
| ! Arguments | ||
| real(DP),dimension(:),intent(in) :: ar1,ar2 | ||
| real(DP),dimension(:),intent(out) :: ans | ||
|
|
||
| ! Internals | ||
|
|
||
|
|
||
| ! Executable code | ||
|
|
||
|
|
||
| ans(1) = ar1(2) * ar2(3) - ar1(3) * ar2(2) | ||
| ans(2) = ar1(3) * ar2(1) - ar1(1) * ar2(3) | ||
| ans(3) = ar1(1) * ar2(2) - ar1(2) * ar2(1) | ||
|
|
||
| RETURN | ||
|
|
||
| END SUBROUTINE util_crossproduct | ||
| !********************************************************************************************************************************** | ||
| ! | ||
| ! Author(s) : C.Wishard and J.Pouplin | ||
| ! | ||
| ! Revision Control System (RCS) Information | ||
| ! | ||
| ! Source File : $RCSfile$ | ||
| ! Full Path : $Source$ | ||
| ! Revision : $Revision$ | ||
| ! Date : $Date$ | ||
| ! Programmer : $Author$ | ||
| ! Locked By : $Locker$ | ||
| ! State : $State$ | ||
| ! | ||
| ! Modification History: | ||
| ! | ||
| ! $Log$ | ||
| !********************************************************************************************************************************** | ||
| pure subroutine util_crossproduct(ar1, ar2, ans) | ||
| !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton | ||
| !! | ||
| !! Calculates cross product of two arrays. Stores intermediate values in quad precision to improve accuracy when the two input | ||
| !! arrays are near alignment | ||
| use swiftest_globals | ||
| use module_interfaces, EXCEPT_THIS_ONE => util_crossproduct | ||
| implicit none | ||
| ! Arguments | ||
| real(DP),dimension(:),intent(in) :: ar1,ar2 | ||
| real(DP),dimension(:),intent(out) :: ans | ||
| ! Internals | ||
| real(QP), dimension(3) :: qar1, qar2, qans | ||
|
|
||
| qar1(:) = real(ar1(:), kind=QP) | ||
| qar2(:) = real(ar2(:), kind=QP) | ||
| qans(1) = qar1(2) * qar2(3) - qar1(3) * qar2(2) | ||
| qans(2) = qar1(3) * qar2(1) - qar1(1) * qar2(3) | ||
| qans(3) = qar1(1) * qar2(2) - qar1(2) * qar2(1) | ||
| ans(:) = real(qans(:), kind=DP) | ||
|
|
||
| return | ||
|
|
||
| end subroutine util_crossproduct |