223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

explicit casting and overlong constants regognized by compiler

This commit is contained in:
Martin Diehl 2016-05-25 07:52:56 +02:00
parent 540e1cbec8
commit a58e85e96d
5 changed files with 30 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
code/IO.f90
View File

@ -546,7 +546,7 @@ function IO_hybridIA(Nast,ODFfileName)
!--------------------------------------------------------------------------------------------------
! math module is not available
real(pReal), parameter :: PI = 3.14159265358979323846264338327950288419716939937510_pReal
real(pReal), parameter :: PI = 3.141592653589793_pReal
real(pReal), parameter :: INRAD = PI/180.0_pReal
integer(pInt) :: i,j,bin,NnonZero,Nset,Nreps,reps,phi1,Phi,phi2
@ -666,7 +666,7 @@ function IO_hybridIA(Nast,ODFfileName)
else
prob = 0.0_pReal
endif
dV_V(phi2,Phi,phi1) = prob*dg_0*sin((Phi-1.0_pReal+center)*deltas(2))
dV_V(phi2,Phi,phi1) = prob*dg_0*sin((real(Phi-1_pInt,pReal)+center)*deltas(2))
enddo; enddo; enddo
close(FILEUNIT)
dV_V = dV_V/sum_dV_V ! normalize to 1
@ -713,7 +713,7 @@ function IO_hybridIA(Nast,ODFfileName)
do i=1_pInt,Nast
if (i < Nast) then
call random_number(rnd)
j = nint(rnd*(Nreps-i)+i+0.5_pReal,pInt)
j = nint(rnd*real(Nreps-i,pReal)+real(i,pReal)+0.5_pReal,pInt)
else
j = i
endif

10
code/material.f90
View File

@ -1371,7 +1371,7 @@ subroutine material_populateGrains
else
forall (i = 1_pInt:FE_Nips(t)) & ! loop over IPs
volumeOfGrain(grain+(i-1)*dGrains+1_pInt:grain+i*dGrains) = &
mesh_ipVolume(i,e)/dGrains ! assign IPvolume/Ngrains@IP to all grains of IP
mesh_ipVolume(i,e)/real(dGrains,pReal) ! assign IPvolume/Ngrains@IP to all grains of IP
grain = grain + FE_Nips(t) * dGrains ! wind forward by Nips*Ngrains@IP
endif
enddo
@ -1393,7 +1393,7 @@ subroutine material_populateGrains
NgrainsOfConstituent = 0_pInt ! reset counter of grains per constituent
forall (i = 1_pInt:myNconstituents) &
NgrainsOfConstituent(i) = nint(microstructure_fraction(i,micro) * myNgrains, pInt) ! do rounding integer conversion
NgrainsOfConstituent(i) = nint(microstructure_fraction(i,micro)*real(myNgrains,pReal),pInt)! do rounding integer conversion
do while (sum(NgrainsOfConstituent) /= myNgrains) ! total grain count over constituents wrong?
sgn = sign(1_pInt, myNgrains - sum(NgrainsOfConstituent)) ! direction of required change
extreme = 0.0_pReal
@ -1434,17 +1434,17 @@ subroutine material_populateGrains
! ...has texture components
if (texture_ODFfile(textureID) == '') then
gauss: do t = 1_pInt,texture_Ngauss(textureID) ! loop over Gauss components
do g = 1_pInt,int(myNorientations*texture_Gauss(5,t,textureID),pInt) ! loop over required grain count
do g = 1_pInt,int(real(myNorientations,pReal)*texture_Gauss(5,t,textureID),pInt) ! loop over required grain count
orientationOfGrain(:,grain+constituentGrain+g) = &
math_sampleGaussOri(texture_Gauss(1:3,t,textureID),&
texture_Gauss( 4,t,textureID))
enddo
constituentGrain = &
constituentGrain + int(myNorientations*texture_Gauss(5,t,textureID)) ! advance counter for grains of current constituent
constituentGrain + int(real(myNorientations,pReal)*texture_Gauss(5,t,textureID)) ! advance counter for grains of current constituent
enddo gauss
fiber: do t = 1_pInt,texture_Nfiber(textureID) ! loop over fiber components
do g = 1_pInt,int(myNorientations*texture_Fiber(6,t,textureID),pInt) ! loop over required grain count
do g = 1_pInt,int(real(myNorientations,pReal)*texture_Fiber(6,t,textureID),pInt) ! loop over required grain count
orientationOfGrain(:,grain+constituentGrain+g) = &
math_sampleFiberOri(texture_Fiber(1:2,t,textureID),&
texture_Fiber(3:4,t,textureID),&

4
code/math.f90
View File

@ -13,10 +13,10 @@ module math
implicit none
private
real(pReal), parameter, public :: PI = 3.14159265358979323846264338327950288419716939937510_pReal !< ratio of a circle's circumference to its diameter
real(pReal), parameter, public :: PI = 3.141592653589793_pReal !< ratio of a circle's circumference to its diameter
real(pReal), parameter, public :: INDEG = 180.0_pReal/PI !< conversion from radian into degree
real(pReal), parameter, public :: INRAD = PI/180.0_pReal !< conversion from degree into radian
complex(pReal), parameter, public :: TWOPIIMG = (0.0_pReal,2.0_pReal)* PI !< Re(0.0), Im(2xPi)
complex(pReal), parameter, public :: TWOPIIMG = (0.0_pReal,2.0_pReal)*(PI,0.0_pReal) !< Re(0.0), Im(2xPi)
real(pReal), dimension(3,3), parameter, public :: &
MATH_I3 = reshape([&

12
code/mesh.f90
View File

@ -963,7 +963,7 @@ subroutine mesh_build_ipCoordinates
do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell
myCoords = myCoords + mesh_cellnode(1:3,mesh_cell(n,i,e))
enddo
mesh_ipCoordinates(1:3,i,e) = myCoords / FE_NcellnodesPerCell(c)
mesh_ipCoordinates(1:3,i,e) = myCoords / real(FE_NcellnodesPerCell(c),pReal)
enddo
enddo
!$OMP END PARALLEL DO
@ -990,7 +990,7 @@ pure function mesh_cellCenterCoordinates(ip,el)
do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell
mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el))
enddo
mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / FE_NcellnodesPerCell(c)
mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal)
end function mesh_cellCenterCoordinates
@ -3070,7 +3070,6 @@ use IO, only: &
implicit none
integer(pInt), intent(in) :: fileUnit
#ifndef Spectral
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) chunk, Nchunks
@ -3082,10 +3081,9 @@ use IO, only: &
mesh_periodicSurface = .true.
#else
mesh_periodicSurface = .false.
#ifdef Marc4DAMASK
#if defined(Marc4DAMASK)
keyword = '$damask'
#endif
#ifdef Abaqus
#elif defined(Abaqus)
keyword = '**damask'
#endif
@ -3693,6 +3691,7 @@ integer(pInt) function FE_mapElemtype(what)
'c3d20t')
FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral
case default
FE_mapElemtype = -1_pInt ! error return
call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what))
end select
@ -3701,6 +3700,7 @@ end function FE_mapElemtype
!--------------------------------------------------------------------------------------------------
!> @brief find face-matching element of same type
!> @details currently not used, check if needed for HDF5 output, otherwise delete
!--------------------------------------------------------------------------------------------------
subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace)

22
code/prec.f90
View File

@ -185,10 +185,13 @@ end function prec_isNaN
! http://www.cygnus-software.com/papers/comparingfloats/comparingfloats.htm
!--------------------------------------------------------------------------------------------------
logical elemental pure function dEq(a,b,tol)
real(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal), parameter :: eps = 2.2204460492503131E-16 ! DBL_EPSILON in C
dEq = merge(.True., .False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b])))
implicit none
real(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C
dEq = merge(.True., .False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b])))
end function dEq
@ -198,10 +201,13 @@ end function dEq
! http://www.cygnus-software.com/papers/comparingfloats/comparingfloats.htm
!--------------------------------------------------------------------------------------------------
logical elemental pure function dNeq(a,b,tol)
real(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal), parameter :: eps = 2.2204460492503131E-16 ! DBL_EPSILON in C
dNeq = merge(.False., .True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b])))
implicit none
real(pReal), intent(in) :: a,b
real(pReal), intent(in), optional :: tol
real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C
dNeq = merge(.False., .True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b])))
end function dNeq
end module prec