handling of PGI compiler was to cumbersome

This commit is contained in:
Martin Diehl 2019-04-03 13:04:03 +02:00
parent e33807aab3
commit 3887d5631a
4 changed files with 21 additions and 64 deletions

View File

@ -81,9 +81,6 @@ module math
public :: & public :: &
#if defined(__PGI)
norm2, &
#endif
math_init, & math_init, &
math_qsort, & math_qsort, &
math_expand, & math_expand, &
@ -2647,19 +2644,4 @@ real(pReal) pure elemental function math_clip(a, left, right)
end function math_clip end function math_clip
#if defined(__PGI)
!--------------------------------------------------------------------------------------------------
!> @brief substitute for the norm2 intrinsic which is not available in PGI 18.10
!--------------------------------------------------------------------------------------------------
real(pReal) pure function norm2(v)
implicit none
real(pReal), intent(in), dimension(3) :: v
norm2 = sqrt(sum(v**2))
end function norm2
#endif
end module math end module math

View File

@ -900,9 +900,6 @@ end function mesh_cellCenterCoordinates
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_build_ipAreas subroutine mesh_build_ipAreas
use math, only: & use math, only: &
#ifdef __PGI
norm2, &
#endif
math_crossproduct math_crossproduct
implicit none implicit none

View File

@ -354,10 +354,6 @@ end function pow_quat__
!> ToDo: Lacks any check for invalid operations !> ToDo: Lacks any check for invalid operations
!--------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------
type(quaternion) elemental function exp__(self) type(quaternion) elemental function exp__(self)
#ifdef __PGI
use math, only: &
norm2
#endif
implicit none implicit none
class(quaternion), intent(in) :: self class(quaternion), intent(in) :: self
@ -378,10 +374,6 @@ end function exp__
!> ToDo: Lacks any check for invalid operations !> ToDo: Lacks any check for invalid operations
!--------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------
type(quaternion) elemental function log__(self) type(quaternion) elemental function log__(self)
#ifdef __PGI
use math, only: &
norm2
#endif
implicit none implicit none
class(quaternion), intent(in) :: self class(quaternion), intent(in) :: self
@ -401,10 +393,6 @@ end function log__
!> norm of a quaternion !> norm of a quaternion
!--------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------
real(pReal) elemental function abs__(a) real(pReal) elemental function abs__(a)
#ifdef __PGI
use math, only: &
norm2
#endif
implicit none implicit none
class(quaternion), intent(in) :: a class(quaternion), intent(in) :: a

View File

@ -157,10 +157,6 @@ end subroutine
function rotVector(self,v,active) function rotVector(self,v,active)
use prec, only: & use prec, only: &
dEq dEq
#ifdef __PGI
use math, only: &
norm2
#endif
implicit none implicit none
real(pReal), dimension(3) :: rotVector real(pReal), dimension(3) :: rotVector
@ -169,20 +165,27 @@ function rotVector(self,v,active)
logical, intent(in), optional :: active logical, intent(in), optional :: active
type(quaternion) :: q type(quaternion) :: q
logical :: passive
if (present(active)) then
passive = .not. active
else
passive = .true.
endif
if (dEq(norm2(v),1.0_pReal,tol=1.0e-15_pReal)) then if (dEq(norm2(v),1.0_pReal,tol=1.0e-15_pReal)) then
passive: if (merge(.not. active, .true., present(active))) then ! ToDo: not save (PGI) if (passive) then
q = self%q * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * conjg(self%q) ) q = self%q * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * conjg(self%q) )
else passive else
q = conjg(self%q) * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * self%q ) q = conjg(self%q) * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * self%q )
endif passive endif
rotVector = [q%x,q%y,q%z] rotVector = [q%x,q%y,q%z]
else else
passive2: if (merge(.not. active, .true., present(active))) then ! ToDo: not save (PGI) if (passive) then
rotVector = matmul(self%asRotationMatrix(),v) rotVector = matmul(self%asRotationMatrix(),v)
else passive2 else
rotVector = matmul(transpose(self%asRotationMatrix()),v) rotVector = matmul(transpose(self%asRotationMatrix()),v)
endif passive2 endif
endif endif
end function rotVector end function rotVector
@ -573,9 +576,6 @@ pure function ro2ax(ro) result(ax)
use prec, only: & use prec, only: &
dEq0 dEq0
use math, only: & use math, only: &
#ifdef __PGI
norm2, &
#endif
PI PI
implicit none implicit none
@ -665,9 +665,6 @@ pure function ro2ho(ro) result(ho)
use prec, only: & use prec, only: &
dEq0 dEq0
use math, only: & use math, only: &
#ifdef __PGI
norm2, &
#endif
PI PI
implicit none implicit none
@ -724,10 +721,6 @@ end function qu2om
function om2qu(om) result(qu) function om2qu(om) result(qu)
use prec, only: & use prec, only: &
dEq dEq
#ifdef __PGI
use math, only: &
norm2
#endif
implicit none implicit none
real(pReal), intent(in), dimension(3,3) :: om real(pReal), intent(in), dimension(3,3) :: om
@ -801,9 +794,6 @@ pure function qu2ro(qu) result(ro)
use prec, only: & use prec, only: &
dEq0 dEq0
use math, only: & use math, only: &
#ifdef __PGI
norm2, &
#endif
math_clip math_clip
type(quaternion), intent(in) :: qu type(quaternion), intent(in) :: qu
@ -816,9 +806,12 @@ pure function qu2ro(qu) result(ro)
ro = [qu%x, qu%y, qu%z, IEEE_value(ro(4),IEEE_positive_inf)] ro = [qu%x, qu%y, qu%z, IEEE_value(ro(4),IEEE_positive_inf)]
else else
s = norm2([qu%x,qu%y,qu%z]) s = norm2([qu%x,qu%y,qu%z])
ro = merge ( [ 0.0_pReal, 0.0_pReal, P, 0.0_pReal], & if (s < thr) then
[ qu%x/s, qu%y/s, qu%z/s, tan(acos(math_clip(qu%w,-1.0_pReal,1.0_pReal)))], & ro = [ 0.0_pReal, 0.0_pReal, P, 0.0_pReal]
s < thr) !ToDo: not save (PGI compiler) else
ro = [ qu%x/s, qu%y/s, qu%z/s, tan(acos(math_clip(qu%w,-1.0_pReal,1.0_pReal)))]
endif
end if end if
end function qu2ro end function qu2ro
@ -832,9 +825,6 @@ pure function qu2ho(qu) result(ho)
use prec, only: & use prec, only: &
dEq0 dEq0
use math, only: & use math, only: &
#ifdef __PGI
norm2, &
#endif
math_clip math_clip
implicit none implicit none