more reasonable name
This commit is contained in:
parent
a279785149
commit
ae20ab8d42
|
@ -49,7 +49,7 @@ subroutine IO_init
|
||||||
|
|
||||||
write(6,'(/,a)') ' <<<+- IO init -+>>>'; flush(6)
|
write(6,'(/,a)') ' <<<+- IO init -+>>>'; flush(6)
|
||||||
|
|
||||||
call unitTest
|
call selfTest
|
||||||
|
|
||||||
end subroutine IO_init
|
end subroutine IO_init
|
||||||
|
|
||||||
|
@ -696,7 +696,7 @@ end subroutine IO_warning
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief check correctness of some IO functions
|
!> @brief check correctness of some IO functions
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine unitTest
|
subroutine selfTest
|
||||||
|
|
||||||
integer, dimension(:), allocatable :: chunkPos
|
integer, dimension(:), allocatable :: chunkPos
|
||||||
character(len=:), allocatable :: str
|
character(len=:), allocatable :: str
|
||||||
|
@ -745,6 +745,6 @@ subroutine unitTest
|
||||||
str = IO_rmComment(' ab #')
|
str = IO_rmComment(' ab #')
|
||||||
if (str /= ' ab'.or. len(str) /= 3) call IO_error(0,ext_msg='IO_rmComment/7')
|
if (str /= ' ab'.or. len(str) /= 3) call IO_error(0,ext_msg='IO_rmComment/7')
|
||||||
|
|
||||||
end subroutine unitTest
|
end subroutine selfTest
|
||||||
|
|
||||||
end module IO
|
end module IO
|
||||||
|
|
|
@ -180,7 +180,7 @@ subroutine YAML_types_init
|
||||||
|
|
||||||
write(6,'(/,a)') ' <<<+- YAML_types init -+>>>'
|
write(6,'(/,a)') ' <<<+- YAML_types init -+>>>'
|
||||||
|
|
||||||
call unitTest
|
call selfTest
|
||||||
|
|
||||||
end subroutine YAML_types_init
|
end subroutine YAML_types_init
|
||||||
|
|
||||||
|
@ -188,7 +188,7 @@ end subroutine YAML_types_init
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief check correctness of some type bound procedures
|
!> @brief check correctness of some type bound procedures
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine unitTest
|
subroutine selfTest
|
||||||
|
|
||||||
class(tNode), pointer :: s1,s2
|
class(tNode), pointer :: s1,s2
|
||||||
allocate(tScalar::s1)
|
allocate(tScalar::s1)
|
||||||
|
@ -260,7 +260,7 @@ subroutine unitTest
|
||||||
if(n%get_asString(1) /= 'True') call IO_error(0,ext_msg='byIndex_asString')
|
if(n%get_asString(1) /= 'True') call IO_error(0,ext_msg='byIndex_asString')
|
||||||
end block
|
end block
|
||||||
|
|
||||||
end subroutine unitTest
|
end subroutine selfTest
|
||||||
|
|
||||||
|
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
|
|
|
@ -529,7 +529,7 @@ subroutine lattice_init
|
||||||
lattice_DamageMobility(p) = config_phase(p)%getFloat('damage_mobility',defaultVal=0.0_pReal)
|
lattice_DamageMobility(p) = config_phase(p)%getFloat('damage_mobility',defaultVal=0.0_pReal)
|
||||||
! SHOULD NOT BE PART OF LATTICE END
|
! SHOULD NOT BE PART OF LATTICE END
|
||||||
|
|
||||||
call unitTest
|
call selfTest
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
@ -2295,7 +2295,7 @@ end function equivalent_mu
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief check correctness of some lattice functions
|
!> @brief check correctness of some lattice functions
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine unitTest
|
subroutine selfTest
|
||||||
|
|
||||||
real(pReal), dimension(:,:,:), allocatable :: CoSy
|
real(pReal), dimension(:,:,:), allocatable :: CoSy
|
||||||
real(pReal), dimension(:,:), allocatable :: system
|
real(pReal), dimension(:,:), allocatable :: system
|
||||||
|
@ -2324,6 +2324,6 @@ subroutine unitTest
|
||||||
if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'reuss')),equivalent_nu(C,'reuss'),1.0e-12_pReal)) &
|
if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'reuss')),equivalent_nu(C,'reuss'),1.0e-12_pReal)) &
|
||||||
call IO_error(0,ext_msg='equivalent_nu/reuss')
|
call IO_error(0,ext_msg='equivalent_nu/reuss')
|
||||||
|
|
||||||
end subroutine unitTest
|
end subroutine selfTest
|
||||||
|
|
||||||
end module lattice
|
end module lattice
|
||||||
|
|
|
@ -79,7 +79,7 @@ module math
|
||||||
|
|
||||||
!---------------------------------------------------------------------------------------------------
|
!---------------------------------------------------------------------------------------------------
|
||||||
private :: &
|
private :: &
|
||||||
unitTest
|
selfTest
|
||||||
|
|
||||||
contains
|
contains
|
||||||
|
|
||||||
|
@ -113,7 +113,7 @@ subroutine math_init
|
||||||
|
|
||||||
call random_seed(put = randInit)
|
call random_seed(put = randInit)
|
||||||
|
|
||||||
call unitTest
|
call selfTest
|
||||||
|
|
||||||
end subroutine math_init
|
end subroutine math_init
|
||||||
|
|
||||||
|
@ -1192,7 +1192,7 @@ end function math_clip
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief check correctness of some math functions
|
!> @brief check correctness of some math functions
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine unitTest
|
subroutine selfTest
|
||||||
|
|
||||||
integer, dimension(2,4) :: &
|
integer, dimension(2,4) :: &
|
||||||
sort_in_ = reshape([+1,+5, +5,+6, -1,-1, +3,-2],[2,4])
|
sort_in_ = reshape([+1,+5, +5,+6, -1,-1, +3,-2],[2,4])
|
||||||
|
@ -1330,6 +1330,6 @@ subroutine unitTest
|
||||||
if(dNeq0(math_LeviCivita(ijk(1),ijk(2),ijk(3))))&
|
if(dNeq0(math_LeviCivita(ijk(1),ijk(2),ijk(3))))&
|
||||||
call IO_error(0,ext_msg='math_LeviCivita')
|
call IO_error(0,ext_msg='math_LeviCivita')
|
||||||
|
|
||||||
end subroutine unitTest
|
end subroutine selfTest
|
||||||
|
|
||||||
end module math
|
end module math
|
||||||
|
|
|
@ -75,7 +75,7 @@ module prec
|
||||||
emptyStringArray = [character(len=pStringLen)::]
|
emptyStringArray = [character(len=pStringLen)::]
|
||||||
|
|
||||||
private :: &
|
private :: &
|
||||||
unitTest
|
selfTest
|
||||||
|
|
||||||
contains
|
contains
|
||||||
|
|
||||||
|
@ -94,7 +94,7 @@ subroutine prec_init
|
||||||
write(6,'(a,e10.3)') ' Minimum value: ',tiny(0.0_pReal)
|
write(6,'(a,e10.3)') ' Minimum value: ',tiny(0.0_pReal)
|
||||||
write(6,'(a,i3)') ' Decimal precision: ',precision(0.0_pReal)
|
write(6,'(a,i3)') ' Decimal precision: ',precision(0.0_pReal)
|
||||||
|
|
||||||
call unitTest
|
call selfTest
|
||||||
|
|
||||||
end subroutine prec_init
|
end subroutine prec_init
|
||||||
|
|
||||||
|
@ -233,7 +233,7 @@ end function cNeq
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief check correctness of some prec functions
|
!> @brief check correctness of some prec functions
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine unitTest
|
subroutine selfTest
|
||||||
|
|
||||||
integer, allocatable, dimension(:) :: realloc_lhs_test
|
integer, allocatable, dimension(:) :: realloc_lhs_test
|
||||||
real(pReal), dimension(2) :: r
|
real(pReal), dimension(2) :: r
|
||||||
|
@ -249,6 +249,6 @@ subroutine unitTest
|
||||||
realloc_lhs_test = [1,2]
|
realloc_lhs_test = [1,2]
|
||||||
if (any(realloc_lhs_test/=[1,2])) call quit(9000)
|
if (any(realloc_lhs_test/=[1,2])) call quit(9000)
|
||||||
|
|
||||||
end subroutine unitTest
|
end subroutine selfTest
|
||||||
|
|
||||||
end module prec
|
end module prec
|
||||||
|
|
|
@ -112,7 +112,7 @@ contains
|
||||||
subroutine quaternions_init
|
subroutine quaternions_init
|
||||||
|
|
||||||
write(6,'(/,a)') ' <<<+- quaternions init -+>>>'; flush(6)
|
write(6,'(/,a)') ' <<<+- quaternions init -+>>>'; flush(6)
|
||||||
call unitTest
|
call selfTest
|
||||||
|
|
||||||
end subroutine quaternions_init
|
end subroutine quaternions_init
|
||||||
|
|
||||||
|
@ -457,7 +457,7 @@ end function inverse
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief check correctness of some quaternions functions
|
!> @brief check correctness of some quaternions functions
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine unitTest
|
subroutine selfTest
|
||||||
|
|
||||||
real(pReal), dimension(4) :: qu
|
real(pReal), dimension(4) :: qu
|
||||||
type(quaternion) :: q, q_2
|
type(quaternion) :: q, q_2
|
||||||
|
@ -524,7 +524,7 @@ subroutine unitTest
|
||||||
endif
|
endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
end subroutine unitTest
|
end subroutine selfTest
|
||||||
|
|
||||||
|
|
||||||
end module quaternions
|
end module quaternions
|
||||||
|
|
|
@ -105,7 +105,7 @@ subroutine rotations_init
|
||||||
|
|
||||||
call quaternions_init
|
call quaternions_init
|
||||||
write(6,'(/,a)') ' <<<+- rotations init -+>>>'; flush(6)
|
write(6,'(/,a)') ' <<<+- rotations init -+>>>'; flush(6)
|
||||||
call unitTest
|
call selfTest
|
||||||
|
|
||||||
end subroutine rotations_init
|
end subroutine rotations_init
|
||||||
|
|
||||||
|
@ -1340,7 +1340,7 @@ end function GetPyramidOrder
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief check correctness of some rotations functions
|
!> @brief check correctness of some rotations functions
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
subroutine unitTest
|
subroutine selfTest
|
||||||
|
|
||||||
type(rotation) :: R
|
type(rotation) :: R
|
||||||
real(pReal), dimension(4) :: qu, ax, ro
|
real(pReal), dimension(4) :: qu, ax, ro
|
||||||
|
@ -1443,7 +1443,7 @@ subroutine unitTest
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
end subroutine unitTest
|
end subroutine selfTest
|
||||||
|
|
||||||
|
|
||||||
end module rotations
|
end module rotations
|
||||||
|
|
Loading…
Reference in New Issue