From a58e85e96d7286124652923247713722473d5405 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 25 May 2016 07:52:56 +0200 Subject: [PATCH] explicit casting and overlong constants regognized by compiler --- code/IO.f90 | 6 +++--- code/material.f90 | 10 +++++----- code/math.f90 | 4 ++-- code/mesh.f90 | 12 ++++++------ code/prec.f90 | 22 ++++++++++++++-------- 5 files changed, 30 insertions(+), 24 deletions(-) diff --git a/code/IO.f90 b/code/IO.f90 index ff6b7b091..2a13ce3d8 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -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 diff --git a/code/material.f90 b/code/material.f90 index 372c9dd7e..40c403b8c 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -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),& diff --git a/code/math.f90 b/code/math.f90 index 9ad98df9e..401e46630 100644 --- a/code/math.f90 +++ b/code/math.f90 @@ -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([& diff --git a/code/mesh.f90 b/code/mesh.f90 index 22e103df0..ecf2dd6f3 100644 --- a/code/mesh.f90 +++ b/code/mesh.f90 @@ -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) diff --git a/code/prec.f90 b/code/prec.f90 index e099c8964..f3cba540a 100644 --- a/code/prec.f90 +++ b/code/prec.f90 @@ -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