From 40d38ebf55f38c65f81548645b5b213459e055b1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 8 Dec 2018 08:02:55 +0100 Subject: [PATCH 001/309] added rotation conversions modified versions from 3Drotations code (available on GitHub) by Marc De Graef --- src/CMakeLists.txt | 22 +- src/Lambert.f90 | 213 +++++++ src/commercialFEM_fileList.f90 | 3 + src/prec.f90 | 4 +- src/quaternions.f90 | 433 +++++++++++++ src/rotations.f90 | 1088 ++++++++++++++++++++++++++++++++ 6 files changed, 1757 insertions(+), 6 deletions(-) create mode 100644 src/Lambert.f90 create mode 100644 src/quaternions.f90 create mode 100644 src/rotations.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 2e4462243..4210a79b3 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -49,18 +49,30 @@ add_library(FEsolving OBJECT "FEsolving.f90") add_dependencies(FEsolving DEBUG) list(APPEND OBJECTFILES $) -add_library(DAMASK_MATH OBJECT "math.f90") -add_dependencies(DAMASK_MATH FEsolving) -list(APPEND OBJECTFILES $) +add_library(MATH OBJECT "math.f90") +add_dependencies(MATH DEBUG) +list(APPEND OBJECTFILES $) + +add_library(QUATERNIONS OBJECT "quaternions.f90") +add_dependencies(QUATERNIONS MATH) +list(APPEND OBJECTFILES $) + +add_library(LAMBERT OBJECT "Lambert.f90") +add_dependencies(LAMBERT MATH) +list(APPEND OBJECTFILES $) + +add_library(ROTATIONS OBJECT "rotations.f90") +add_dependencies(ROTATIONS LAMBERT QUATERNIONS) +list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh.f90") - add_dependencies(MESH DAMASK_MATH) + add_dependencies(MESH ROTATIONS FEsolving) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") - add_dependencies(FEZoo DAMASK_MATH) + add_dependencies(FEZoo ROTATIONS FEsolving) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "meshFEM.f90") add_dependencies(MESH FEZoo) diff --git a/src/Lambert.f90 b/src/Lambert.f90 new file mode 100644 index 000000000..ab939bcc6 --- /dev/null +++ b/src/Lambert.f90 @@ -0,0 +1,213 @@ +! ################################################################### +! Copyright (c) 2013-2015, Marc De Graef/Carnegie Mellon University +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! - Redistributions of source code must retain the above copyright notice, this list +! of conditions and the following disclaimer. +! - Redistributions in binary form must reproduce the above copyright notice, this +! list of conditions and the following disclaimer in the documentation and/or +! other materials provided with the distribution. +! - Neither the names of Marc De Graef, Carnegie Mellon University nor the names +! of its contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! ################################################################### + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +! +!> @brief everything that has to do with the modified Lambert projections +! +!> @details This module contains a number of projection functions for the modified +!> Lambert projection between square lattice and 2D hemisphere, hexagonal lattice +!> and 2D hemisphere, as well as the more complex mapping between a 3D cubic grid +!> and the unit quaternion hemisphere with positive scalar component. In addition, there +!> are some other projections, such as the stereographic one. Each function is named +!> by the projection, the dimensionality of the starting grid, and the forward or inverse +!> character. For each function, there is also a single precision and a double precision +!> version, but we use the interface formalism to have only a single call. The Forward +!> mapping is taken to be the one from the simple grid to the curved grid. Since the module +!> deals with various grids, we also add a few functions/subroutines that apply symmetry +!> operations on those grids. +!> References: +!> D. Rosca, A. Morawiec, and M. De Graef. “A new method of constructing a grid +!> in the space of 3D rotations and its applications to texture analysis”. +!> Modeling and Simulations in Materials Science and Engineering 22, 075013 (2014). +!-------------------------------------------------------------------------- +module Lambert + use math + use prec + + implicit none + + real(pReal), private :: & + sPi = sqrt(PI), & + pref = sqrt(6.0_pReal/PI), & + ! the following constants are used for the cube to quaternion hemisphere mapping + ap = PI**(2.0_pReal/3.0_pReal), & + sc = 0.897772786961286_pReal, & ! a/ap + beta = 0.962874509979126_pReal, & ! pi^(5/6)/6^(1/6)/2 + R1 = 1.330670039491469_pReal, & ! (3pi/4)^(1/3) + r2 = sqrt(2.0_pReal), & + pi12 = PI/12.0_pReal, & + prek = 1.643456402972504_pReal, & ! R1 2^(1/4)/beta + r24 = sqrt(24.0_pReal) + + private + public :: & + LambertCubeToBall, & + LambertBallToCube + private :: & + GetPyramidOrder + +contains + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief map from 3D cubic grid to 3D ball +!-------------------------------------------------------------------------- +function LambertCubeToBall(cube) result(ball) + use, intrinsic :: IEEE_ARITHMETIC + + implicit none + real(pReal), intent(in), dimension(3) :: cube + real(pReal), dimension(3) :: ball, LamXYZ, XYZ + real(pReal) :: T(2), c, s, q + real(pReal), parameter :: eps = 1.0e-8_pReal + integer(pInt), dimension(3) :: p + integer(pInt), dimension(2) :: order + + if (maxval(abs(cube)) > ap/2.0+eps) then + ball = IEEE_value(cube,IEEE_positive_inf) + return + end if + + ! transform to the sphere grid via the curved square, and intercept the zero point + center: if (all(dEq0(cube))) then + ball = 0.0_pReal + else center + ! get pyramide and scale by grid parameter ratio + p = GetPyramidOrder(cube) + XYZ = cube(p) * sc + + ! intercept all the points along the z-axis + special: if (all(dEq0(XYZ(1:2)))) then + LamXYZ = [ 0.0_pReal, 0.0_pReal, pref * XYZ(3) ] + else special + order = merge( [2,1], [1,2], abs(XYZ(2)) <= abs(XYZ(1))) ! order of absolute values of XYZ + q = pi12 * XYZ(order(1))/XYZ(order(2)) ! smaller by larger + c = cos(q) + s = sin(q) + q = prek * XYZ(order(2))/ sqrt(r2-c) + T = [ (r2*c - 1.0), r2 * s] * q + + ! transform to sphere grid (inverse Lambert) + ! [note that there is no need to worry about dividing by zero, since XYZ(3) can not become zero] + c = sum(T**2) + s = Pi * c/(24.0*XYZ(3)**2) + c = sPi * c / r24 / XYZ(3) + q = sqrt( 1.0 - s ) + LamXYZ = [ T(order(2)) * q, T(order(1)) * q, pref * XYZ(3) - c ] + endif special + + ! reverse the coordinates back to the regular order according to the original pyramid number + ball = LamXYZ(p) + + endif center + +end function LambertCubeToBall + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief map from 3D ball to 3D cubic grid +!-------------------------------------------------------------------------- +pure function LambertBallToCube(xyz) result(cube) + use, intrinsic :: IEEE_ARITHMETIC + + implicit none + real(pReal), intent(in), dimension(3) :: xyz + real(pReal), dimension(3) :: cube, xyz1, xyz3 + real(pReal), dimension(2) :: Tinv, xyz2 + real(pReal) :: rs, qxy, q2, sq2, q, tt + integer(pInt) , dimension(3) :: p + + rs = norm2(xyz) + if (rs > R1) then + cube = IEEE_value(cube,IEEE_positive_inf) + return + endif + + center: if (all(dEq0(xyz))) then + cube = 0.0_pReal + else center + p = GetPyramidOrder(xyz) + xyz3 = xyz(p) + + ! inverse M_3 + xyz2 = xyz3(1:2) * sqrt( 2.0*rs/(rs+abs(xyz3(3))) ) + + ! inverse M_2 + qxy = sum(xyz2**2) + + special: if (dEq0(qxy)) then + Tinv = 0.0 + else special + q2 = qxy + maxval(abs(xyz2))**2 + sq2 = sqrt(q2) + q = (beta/r2/R1) * sqrt(q2*qxy/(q2-maxval(abs(xyz2))*sq2)) + tt = (minval(abs(xyz2))**2+maxval(abs(xyz2))*sq2)/r2/qxy + Tinv = q * sign(1.0,xyz2) * merge([ 1.0_pReal, acos(math_clip(tt,-1.0_pReal,1.0_pReal))/pi12], & + [ acos(math_clip(tt,-1.0_pReal,1.0_pReal))/pi12, 1.0_pReal], & + abs(xyz2(2)) <= abs(xyz2(1))) + endif special + + ! inverse M_1 + xyz1 = [ Tinv(1), Tinv(2), sign(1.0,xyz3(3)) * rs / pref ] /sc + + ! reverst the coordinates back to the regular order according to the original pyramid number + cube = xyz1(p) + + endif center + +end function LambertBallToCube + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief determine to which pyramid a point in a cubic grid belongs +!-------------------------------------------------------------------------- +pure function GetPyramidOrder(xyz) + + implicit none + real(pReal),intent(in),dimension(3) :: xyz + integer(pInt), dimension(3) :: GetPyramidOrder + + if (((abs(xyz(1)) <= xyz(3)).and.(abs(xyz(2)) <= xyz(3))) .or. & + ((abs(xyz(1)) <= -xyz(3)).and.(abs(xyz(2)) <= -xyz(3)))) then + GetPyramidOrder = [1,2,3] + else if (((abs(xyz(3)) <= xyz(1)).and.(abs(xyz(2)) <= xyz(1))) .or. & + ((abs(xyz(3)) <= -xyz(1)).and.(abs(xyz(2)) <= -xyz(1)))) then + GetPyramidOrder = [2,3,1] + else if (((abs(xyz(1)) <= xyz(2)).and.(abs(xyz(3)) <= xyz(2))) .or. & + ((abs(xyz(1)) <= -xyz(2)).and.(abs(xyz(3)) <= -xyz(2)))) then + GetPyramidOrder = [3,1,2] + else + GetPyramidOrder = -1 ! should be impossible, but might simplify debugging + end if + +end function GetPyramidOrder + +end module Lambert diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 36f0244ef..75f540524 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -11,6 +11,9 @@ #include "debug.f90" #include "config.f90" #include "math.f90" +#include "quaternions.f90" +#include "Lambert.f90" +#include "rotations.f90" #include "FEsolving.f90" #include "mesh.f90" #include "material.f90" diff --git a/src/prec.f90 b/src/prec.f90 index 0f942b3c1..bc7f523d0 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -30,7 +30,9 @@ module prec integer(pInt), allocatable, dimension(:) :: realloc_lhs_test - type, public :: group_float !< variable length datatype used for storage of state + real(pReal), parameter, public :: epsijk = -1.0_pReal !< parameter for orientation conversion. ToDo: Better place? + + type, public :: group_float !< variable length datatype used for storage of state real(pReal), dimension(:), pointer :: p end type group_float diff --git a/src/quaternions.f90 b/src/quaternions.f90 new file mode 100644 index 000000000..60b8d387d --- /dev/null +++ b/src/quaternions.f90 @@ -0,0 +1,433 @@ +! ################################################################### +! Copyright (c) 2013-2015, Marc De Graef/Carnegie Mellon University +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! - Redistributions of source code must retain the above copyright notice, this list +! of conditions and the following disclaimer. +! - Redistributions in binary form must reproduce the above copyright notice, this +! list of conditions and the following disclaimer in the documentation and/or +! other materials provided with the distribution. +! - Neither the names of Marc De Graef, Carnegie Mellon University nor the names +! of its contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! ################################################################### + +module quaternions + + use prec + implicit none + + public + type, public :: quaternion + real(pReal) :: w = 0.0_pReal + real(pReal) :: x = 0.0_pReal + real(pReal) :: y = 0.0_pReal + real(pReal) :: z = 0.0_pReal + + + contains + procedure, private :: add__ + procedure, private :: pos__ + generic, public :: operator(+) => add__,pos__ + + procedure, private :: sub__ + procedure, private :: neg__ + generic, public :: operator(-) => sub__,neg__ + + procedure, private :: mul_quat__ + procedure, private :: mul_scal__ + generic, public :: operator(*) => mul_quat__, mul_scal__ + + procedure, private :: div_quat__ + procedure, private :: div_scal__ + generic, public :: operator(/) => div_quat__, div_scal__ + + procedure, private :: eq__ + generic, public :: operator(==) => eq__ + + procedure, private :: neq__ + generic, public :: operator(/=) => neq__ + + procedure, private :: pow_quat__ + procedure, private :: pow_scal__ + generic, public :: operator(**) => pow_quat__, pow_scal__ + + procedure, private :: abs__ + procedure, private :: dot_product__ + procedure, private :: conjg__ + procedure, private :: exp__ + procedure, private :: log__ + + procedure, public :: homomorphed => quat_homomorphed + + !procedure,private :: quat_write + !generic :: write(formatted) => quat_write + + end type + +interface assignment (=) + module procedure assign_quat__ + module procedure assign_vec__ +end interface assignment (=) + +interface quaternion + module procedure init__ +end interface quaternion + +interface abs + procedure abs__ +end interface abs + +interface dot_product + procedure dot_product__ +end interface dot_product + +interface conjg + module procedure conjg__ +end interface conjg + +interface exp + module procedure exp__ +end interface exp + +interface log + module procedure log__ +end interface log + +contains + + +!-------------------------------------------------------------------------- +!> constructor for a quaternion from a 4-vector +!-------------------------------------------------------------------------- +type(quaternion) pure function init__(array) + + implicit none + real(pReal), intent(in), dimension(4) :: array + + init__%w=array(1) + init__%x=array(2) + init__%y=array(3) + init__%z=array(4) + +end function init__ + + +!-------------------------------------------------------------------------- +!> assing a quaternion +!-------------------------------------------------------------------------- +elemental subroutine assign_quat__(self,other) + + implicit none + type(quaternion), intent(out) :: self + type(quaternion), intent(in) :: other + + self%w = other%w + self%x = other%x + self%y = other%y + self%z = other%z + +end subroutine assign_quat__ + + +!-------------------------------------------------------------------------- +!> assing a 4-vector +!-------------------------------------------------------------------------- +pure subroutine assign_vec__(self,other) + + implicit none + type(quaternion), intent(out) :: self + real(pReal), intent(in), dimension(4) :: other + + self%w = other(1) + self%x = other(2) + self%y = other(3) + self%z = other(4) + +end subroutine assign_vec__ + + +!-------------------------------------------------------------------------- +!> addition of two quaternions +!-------------------------------------------------------------------------- +type(quaternion) elemental function add__(self,other) + + implicit none + class(quaternion), intent(in) :: self,other + + add__%w = self%w + other%w + add__%x = self%x + other%x + add__%y = self%y + other%y + add__%z = self%z + other%z + +end function add__ + + +!-------------------------------------------------------------------------- +!> unary positive operator +!-------------------------------------------------------------------------- +type(quaternion) elemental function pos__(self) + + implicit none + class(quaternion), intent(in) :: self + + pos__%w = self%w + pos__%x = self%x + pos__%y = self%y + pos__%z = self%z + +end function pos__ + + +!-------------------------------------------------------------------------- +!> subtraction of two quaternions +!-------------------------------------------------------------------------- +type(quaternion) elemental function sub__(self,other) + + implicit none + class(quaternion), intent(in) :: self,other + + sub__%w = self%w - other%w + sub__%x = self%x - other%x + sub__%y = self%y - other%y + sub__%z = self%z - other%z + +end function sub__ + + +!-------------------------------------------------------------------------- +!> unary positive operator +!-------------------------------------------------------------------------- +type(quaternion) elemental function neg__(self) + + implicit none + class(quaternion), intent(in) :: self + + neg__%w = -self%w + neg__%x = -self%x + neg__%y = -self%y + neg__%z = -self%z + +end function neg__ + + +!-------------------------------------------------------------------------- +!> multiplication of two quaternions +!-------------------------------------------------------------------------- +type(quaternion) elemental function mul_quat__(self,other) + + implicit none + class(quaternion), intent(in) :: self, other + + mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z + mul_quat__%x = self%w*other%x + self%x*other%w + epsijk * (self%y*other%z - self%z*other%y) + mul_quat__%y = self%w*other%y + self%y*other%w + epsijk * (self%z*other%x - self%x*other%z) + mul_quat__%z = self%w*other%z + self%z*other%w + epsijk * (self%x*other%y - self%y*other%x) + +end function mul_quat__ + + +!-------------------------------------------------------------------------- +!> multiplication of quaternions with scalar +!-------------------------------------------------------------------------- +type(quaternion) elemental function mul_scal__(self,scal) + + implicit none + class(quaternion), intent(in) :: self + real(pReal), intent(in) :: scal + + mul_scal__%w = self%w*scal + mul_scal__%x = self%x*scal + mul_scal__%y = self%y*scal + mul_scal__%z = self%z*scal + +end function mul_scal__ + + +!-------------------------------------------------------------------------- +!> division of two quaternions +!-------------------------------------------------------------------------- +type(quaternion) elemental function div_quat__(self,other) + + implicit none + class(quaternion), intent(in) :: self, other + + div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal)) + +end function div_quat__ + + +!-------------------------------------------------------------------------- +!> divisiont of quaternions by scalar +!-------------------------------------------------------------------------- +type(quaternion) elemental function div_scal__(self,scal) + + implicit none + class(quaternion), intent(in) :: self + real(pReal), intent(in) :: scal + + div_scal__ = [self%w,self%x,self%y,self%z]/scal + +end function div_scal__ + + +!-------------------------------------------------------------------------- +!> equality of two quaternions +!-------------------------------------------------------------------------- +logical elemental function eq__(self,other) + implicit none + class(quaternion), intent(in) :: self,other + + eq__ = all(dEq([ self%w, self%x, self%y, self%z], & + [other%w,other%x,other%y,other%z])) + +end function eq__ + + +!-------------------------------------------------------------------------- +!> inequality of two quaternions +!-------------------------------------------------------------------------- +logical elemental function neq__(self,other) + + implicit none + class(quaternion), intent(in) :: self,other + + neq__ = .not. self%eq__(other) + +end function neq__ + + +!-------------------------------------------------------------------------- +!> quaternion to the power of a scalar +!-------------------------------------------------------------------------- +type(quaternion) elemental function pow_scal__(self,expon) + + implicit none + class(quaternion), intent(in) :: self + real(pReal), intent(in) :: expon + + pow_scal__ = exp(log(self)*expon) + +end function pow_scal__ + + +!-------------------------------------------------------------------------- +!> quaternion to the power of a quaternion +!-------------------------------------------------------------------------- +type(quaternion) elemental function pow_quat__(self,expon) + + implicit none + class(quaternion), intent(in) :: self + type(quaternion), intent(in) :: expon + + pow_quat__ = exp(log(self)*expon) + +end function pow_quat__ + + +!-------------------------------------------------------------------------- +!> exponential of a quaternion +!> ToDo: Lacks any check for invalid operations +!-------------------------------------------------------------------------- +type(quaternion) elemental function exp__(self) + + implicit none + class(quaternion), intent(in) :: self + real(pReal) :: absImag + + absImag = norm2([self%x, self%y, self%z]) + + exp__ = exp(self%w) * [ cos(absImag), & + self%x/absImag * sin(absImag), & + self%y/absImag * sin(absImag), & + self%z/absImag * sin(absImag)] + +end function exp__ + + +!-------------------------------------------------------------------------- +!> logarithm of a quaternion +!> ToDo: Lacks any check for invalid operations +!-------------------------------------------------------------------------- +type(quaternion) elemental function log__(self) + + implicit none + class(quaternion), intent(in) :: self + real(pReal) :: absImag + + absImag = norm2([self%x, self%y, self%z]) + + log__ = [log(abs(self)), & + self%x/absImag * acos(self%w/abs(self)), & + self%y/absImag * acos(self%w/abs(self)), & + self%z/absImag * acos(self%w/abs(self))] + +end function log__ + + +!-------------------------------------------------------------------------- +!> norm of a quaternion +!-------------------------------------------------------------------------- +real(pReal) elemental function abs__(a) + + implicit none + class(quaternion), intent(in) :: a + + abs__ = norm2([a%w,a%x,a%y,a%z]) + +end function abs__ + + +!-------------------------------------------------------------------------- +!> dot product of two quaternions +!-------------------------------------------------------------------------- +real(pReal) elemental function dot_product__(a,b) + + implicit none + class(quaternion), intent(in) :: a,b + + dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z + +end function dot_product__ + + +!-------------------------------------------------------------------------- +!> conjugate complex of a quaternion +!-------------------------------------------------------------------------- +type(quaternion) elemental function conjg__(a) + + implicit none + class(quaternion), intent(in) :: a + + conjg__ = quaternion([a%w, -a%x, -a%y, -a%z]) + +end function conjg__ + + +!-------------------------------------------------------------------------- +!> homomorphed quaternion of a quaternion +!-------------------------------------------------------------------------- +type(quaternion) elemental function quat_homomorphed(a) + + implicit none + class(quaternion), intent(in) :: a + + quat_homomorphed = quaternion(-[a%w,a%x,a%y,a%z]) + +end function quat_homomorphed + +end module quaternions diff --git a/src/rotations.f90 b/src/rotations.f90 new file mode 100644 index 000000000..830f49553 --- /dev/null +++ b/src/rotations.f90 @@ -0,0 +1,1088 @@ +! ################################################################### +! Copyright (c) 2013-2014, Marc De Graef/Carnegie Mellon University +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without modification, are +! permitted provided that the following conditions are met: +! +! - Redistributions of source code must retain the above copyright notice, this list +! of conditions and the following disclaimer. +! - Redistributions in binary form must reproduce the above copyright notice, this +! list of conditions and the following disclaimer in the documentation and/or +! other materials provided with the distribution. +! - Neither the names of Marc De Graef, Carnegie Mellon University nor the names +! of its contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! ################################################################### + +module rotations + use prec + use quaternions + + implicit none + type, public :: rotation + type(quaternion), private :: q + contains + procedure, public :: asEulerAngles => asEulerAngles + procedure, public :: asAxisAnglePair => asAxisAnglePair + procedure, public :: asRodriguesFrankVector => asRodriguesFrankVector + procedure, public :: asRotationMatrix => asRotationMatrix + procedure, public :: rotVector + procedure, public :: rotTensor + end type + + interface rotation + module procedure init + end interface + +contains + +type(rotation) function init(eu,ax,om,qu,cu,ho,ro) + real(pReal), intent(in), optional, dimension(3) :: eu, cu, ho + real(pReal), intent(in), optional, dimension(4) :: qu, ax, ro + real(pReal), intent(in), optional, dimension(3,3) :: om + + if (count([present(eu),present(ax),present(om),present(qu),& + present(cu),present(ho),present(ro)]) > 1_pInt) write(6,*) 'invalid' + + if (present(eu)) then + init%q = eu2qu(eu) + elseif (present(ax)) then + init%q = ax2qu(ax) + elseif (present(om)) then + init%q = om2qu(om) + elseif (present(qu)) then + init%q = quaternion(qu) + elseif (present(cu)) then + init%q = cu2qu(cu) + elseif (present(ho)) then + init%q = ho2qu(ho) + elseif (present(ro)) then + init%q = ro2qu(ro) + else + init%q = quaternion([1.0_pReal,0.0_pReal,0.0_pReal,0.0_pReal]) + endif + +end function + +function asEulerAngles(this) + class(rotation), intent(in) :: this + real(pReal), dimension(3) :: asEulerAngles + + asEulerAngles = qu2eu(this%q) + +end function asEulerAngles + + +function asAxisAnglePair(this) + class(rotation), intent(in) :: this + real(pReal), dimension(4) :: asAxisAnglePair + + asAxisAnglePair = qu2ax(this%q) + +end function asAxisAnglePair + + +function asRotationMatrix(this) + class(rotation), intent(in) :: this + real(pReal), dimension(3,3) :: asRotationMatrix + + asRotationMatrix = qu2om(this%q) + +end function asRotationMatrix + + +function asRodriguesFrankVector(this) + class(rotation), intent(in) :: this + real(pReal), dimension(4) :: asRodriguesFrankVector + + asRodriguesFrankVector = qu2ro(this%q) +end function asRodriguesFrankVector + + +function asHomochoric(this) + class(rotation), intent(in) :: this + real(pReal), dimension(3) :: asHomochoric + + asHomochoric = qu2ho(this%q) + +end function asHomochoric + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief rotates a vector passively (default) or actively +!-------------------------------------------------------------------------- +function rotVector(this,v,active) + class(rotation), intent(in) :: this + logical, intent(in), optional :: active + real(pReal),intent(in),dimension(3) :: v + real(pReal),dimension(3) :: rotVector + type(quaternion) :: q + + if (dEq(norm2(v),1.0_pReal,tol=1.0e-15_pReal)) then + passive: if (merge(.not. active, .true., present(active))) then + q = this%q * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * conjg(this%q) ) + else passive + q = conjg(this%q) * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * this%q ) + endif passive + rotVector = [q%x,q%y,q%z] + else + passive2: if (merge(.not. active, .true., present(active))) then + rotVector = matmul(this%asRotationMatrix(),v) + else passive2 + rotVector = matmul(transpose(this%asRotationMatrix()),v) + endif passive2 + endif + +end function rotVector + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief rotate a second rank tensor using a rotation matrix, active or passive (single precision) +!-------------------------------------------------------------------------- +function rotTensor(this,m,active) + class(rotation), intent(in) :: this + real(pReal),intent(in),dimension(3,3) :: m + logical, intent(in), optional :: active + real(pReal),dimension(3,3) :: rotTensor + + passive: if (merge(.not. active, .true., present(active))) then + rotTensor = matmul(matmul(this%asRotationMatrix(),m),transpose(this%asRotationMatrix())) + else passive + rotTensor = matmul(matmul(transpose(this%asRotationMatrix()),m),this%asRotationMatrix()) + endif passive + +end function rotTensor + + +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- +! here we start with a series of conversion routines between representations +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief Euler angles to orientation matrix [Morawiec, page 28] +!-------------------------------------------------------------------------- +pure function eu2om(eu) result(om) + + implicit none + real(pReal), intent(in), dimension(3) :: eu !< Euler angles in radians + real(pReal), dimension(3,3) :: om !< output orientation matrix + real(pReal), dimension(3) :: c, s + + c = cos(eu) + s = sin(eu) + + om(1,1) = c(1)*c(3)-s(1)*s(3)*c(2) + om(1,2) = s(1)*c(3)+c(1)*s(3)*c(2) + om(1,3) = s(3)*s(2) + om(2,1) = -c(1)*s(3)-s(1)*c(3)*c(2) + om(2,2) = -s(1)*s(3)+c(1)*c(3)*c(2) + om(2,3) = c(3)*s(2) + om(3,1) = s(1)*s(2) + om(3,2) = -c(1)*s(2) + om(3,3) = c(2) + + where(dEq0(om)) om = 0.0_pReal + +end function eu2om + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert euler to axis angle +!-------------------------------------------------------------------------- +pure function eu2ax(eu) result(ax) + use math, only: & + PI + + implicit none + real(pReal), intent(in), dimension(3) :: eu !< Euler angles in radians + real(pReal), dimension(4) :: ax + real(pReal) :: t, delta, tau, alpha, sigma + + t = tan(eu(2)*0.5) + sigma = 0.5*(eu(1)+eu(3)) + delta = 0.5*(eu(1)-eu(3)) + tau = sqrt(t**2+sin(sigma)**2) + + alpha = merge(PI, 2.0*atan(tau/cos(sigma)), dEq(sigma,PI*0.5_pReal,tol=1.0e-15_pReal)) + + if (dEq0(alpha)) then ! return a default identity axis-angle pair + ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ] + else + ax(1:3) = -epsijk/tau * [ t*cos(delta), t*sin(delta), sin(sigma) ] ! passive axis-angle pair so a minus sign in front + ax(4) = alpha + if (alpha < 0.0) ax = -ax ! ensure alpha is positive + end if + +end function eu2ax + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief Euler angles to Rodrigues vector +!-------------------------------------------------------------------------- +pure function eu2ro(eu) result(ro) + use, intrinsic :: IEEE_ARITHMETIC + use math, only: & + PI + + implicit none + real(pReal), intent(in), dimension(3) :: eu !< Euler angles in radians + real(pReal), dimension(4) :: ro + + ro = eu2ax(eu) ! convert to axis angle representation + if (ro(4) >= PI) then + ro(4) = IEEE_value(ro(4),IEEE_positive_inf) + elseif(dEq0(ro(4))) then + ro = [ 0.0_pReal, 0.0_pReal, epsijk, 0.0_pReal ] + else + ro(4) = tan(ro(4)*0.5) + end if + +end function eu2ro + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief Euler angles to quaternion +!-------------------------------------------------------------------------- +pure function eu2qu(eu) result(qu) + + implicit none + real(pReal), intent(in), dimension(3) :: eu + type(quaternion) :: qu + real(pReal), dimension(3) :: ee + real(pReal) :: cPhi, sPhi + + ee = 0.5_pReal*eu + + cPhi = cos(ee(2)) + sPhi = sin(ee(2)) + + ! passive quaternion + qu = quaternion([ cPhi*cos(ee(1)+ee(3)), & + -epsijk*sPhi*cos(ee(1)-ee(3)), & + -epsijk*sPhi*sin(ee(1)-ee(3)), & + -epsijk*cPhi*sin(ee(1)+ee(3))]) + if(qu%w < 0.0_pReal) qu = qu%homomorphed() + +end function eu2qu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief orientation matrix to euler angles +!-------------------------------------------------------------------------- +pure function om2eu(om) result(eu) + use math, only: & + PI + + implicit none + real(pReal), intent(in), dimension(3,3) :: om !< orientation matrix + real(pReal), dimension(3) :: eu + real(pReal) :: zeta + + if (dEq(abs(om(3,3)),1.0_pReal,1.0e-15_pReal)) then + eu = [ atan2( om(1,2),om(1,1)), 0.5*PI*(1-om(3,3)),0.0_pReal ] + else + zeta = 1.0_pReal/sqrt(1.0_pReal-om(3,3)**2.0_pReal) + eu = [atan2(om(3,1)*zeta,-om(3,2)*zeta), & + acos(om(3,3)), & + atan2(om(1,3)*zeta, om(2,3)*zeta)] + end if + where(eu<0.0_pReal) eu = mod(eu+2.0_pReal*PI,[2.0_pReal*PI,PI,2.0_pReal*PI]) + +end function om2eu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief Axis angle pair to orientation matrix +!-------------------------------------------------------------------------- +pure function ax2om(ax) result(om) + + implicit none + real(pReal), intent(in), dimension(4) :: ax + real(pReal), dimension(3,3) :: om !< orientation matrix + real(pReal) :: q, c, s, omc + integer(pInt) :: i + + c = cos(ax(4)) + s = sin(ax(4)) + omc = 1.0-c + + forall(i=1:3) om(i,i) = ax(i)**2*omc + c + + q = omc*ax(1)*ax(2) + om(1,2) = q + s*ax(3) + om(2,1) = q - s*ax(3) + + q = omc*ax(2)*ax(3) + om(2,3) = q + s*ax(1) + om(3,2) = q - s*ax(1) + + q = omc*ax(3)*ax(1) + om(3,1) = q + s*ax(2) + om(1,3) = q - s*ax(2) + + if (epsijk > 0.0) om = transpose(om) + +end function ax2om + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief Quaternion to Euler angles [Morawiec page 40, with errata !!!! ] +!-------------------------------------------------------------------------- +pure function qu2eu(qu) result(eu) + use math, only: & + PI + + implicit none + type(quaternion), intent(in) :: qu !< quaternion + real(pReal), dimension(3) :: eu + real(pReal) :: q12, q03, chi, chiInv + + q03 = qu%w**2+qu%z**2 + q12 = qu%x**2+qu%y**2 + chi = sqrt(q03*q12) + + degenerated: if (dEq0(chi)) then + eu = merge([atan2(-epsijk*2.0*qu%w*qu%z,qu%w**2-qu%z**2), 0.0_pReal, 0.0_pReal], & + [atan2(2.0*qu%x*qu%y,qu%x**2-qu%y**2), PI, 0.0_pReal], & + dEq0(q12)) + else degenerated + chiInv = 1.0/chi + eu = [atan2((-epsijk*qu%w*qu%y+qu%x*qu%z)*chi, (-epsijk*qu%w*qu%x-qu%y*qu%z)*chi ), & + atan2( 2.0*chi, q03-q12 ), & + atan2(( epsijk*qu%w*qu%y+qu%x*qu%z)*chi, (-epsijk*qu%w*qu%x+qu%y*qu%z)*chi )] + endif degenerated + where(eu<0.0_pReal) eu = mod(eu+2.0_pReal*PI,[2.0_pReal*PI,PI,2.0_pReal*PI]) + +end function qu2eu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief Axis angle pair to homochoric +!-------------------------------------------------------------------------- +pure function ax2ho(ax) result(ho) + + + real(pReal), intent(in), dimension(4) :: ax !< axis angle in degree/radians? + real(pReal), dimension(3) :: ho + real(pReal) :: f + + f = 0.75 * ( ax(4) - sin(ax(4)) ) + f = f**(1.0/3.0) + ho = ax(1:3) * f + +end function ax2ho + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief Homochoric to axis angle pair +!-------------------------------------------------------------------------- +pure function ho2ax(ho) result(ax) + + implicit none + real(pReal), intent(in), dimension(3) :: ho !< homochoric coordinates + real(pReal), dimension(4) :: ax + integer(pInt) :: i + real(pReal) :: hmag_squared, s, hm + real(pReal), parameter, dimension(16) :: & + tfit = [ 1.0000000000018852_pReal, -0.5000000002194847_pReal, & + -0.024999992127593126_pReal, -0.003928701544781374_pReal, & + -0.0008152701535450438_pReal, -0.0002009500426119712_pReal, & + -0.00002397986776071756_pReal, -0.00008202868926605841_pReal, & + +0.00012448715042090092_pReal, -0.0001749114214822577_pReal, & + +0.0001703481934140054_pReal, -0.00012062065004116828_pReal, & + +0.000059719705868660826_pReal, -0.00001980756723965647_pReal, & + +0.000003953714684212874_pReal, -0.00000036555001439719544_pReal ] + + ! normalize h and store the magnitude + hmag_squared = sum(ho**2.0_pReal) + if (dEq0(hmag_squared)) then + ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ] + else + hm = hmag_squared + + ! convert the magnitude to the rotation angle + s = tfit(1) + tfit(2) * hmag_squared + do i=3,16 + hm = hm*hmag_squared + s = s + tfit(i) * hm + end do + ax = [ho/sqrt(hmag_squared), 2.0_pReal*acos(s)] + end if + +end function ho2ax + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert orientation matrix to axis angle +!-------------------------------------------------------------------------- +function om2ax(om) result(ax) + use IO, only: & + IO_error + use math, only: & + math_clip, & + math_trace33 + + implicit none + real(pReal), intent(in) :: om(3,3) + real(pReal) :: ax(4) + + real(pReal) :: t + real(pReal), dimension(3) :: Wr, Wi + real(pReal), dimension(10) :: WORK + real(pReal), dimension(3,3) :: VR, devNull, o + integer(pInt) :: INFO, LWORK, i + + external :: dgeev,sgeev + + o = om + + ! first get the rotation angle + t = 0.5_pReal * (math_trace33(om) - 1.0) + ax(4) = acos(math_clip(t,-1.0_pReal,1.0_pReal)) + + if (dEq0(ax(4))) then + ax(1:3) = [ 0.0, 0.0, 1.0 ] + else + ! set some initial LAPACK variables + INFO = 0 + ! first initialize the parameters for the LAPACK DGEEV routines + LWORK = 20 + + ! call the eigenvalue solver +#if (FLOAT==8) + call dgeev('N','V',3,o,3,Wr,Wi,devNull,3,VR,3,WORK,LWORK,INFO) +#elif (FLOAT==4) + call sgeev('N','V',3,o,3,Wr,Wi,devNull,3,VR,3,WORK,LWORK,INFO) +#else + NO SUITABLE PRECISION FOR REAL SELECTED, STOPPING COMPILATION +#endif + if (INFO /= 0) call IO_error(0_pInt,ext_msg='Error in om2ax/(s/d)geev: (S/D)GEEV return not zero') + i = maxloc(merge(1.0_pReal,0.0_pReal,cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal)),dim=1) ! poor substitute for findloc + ax(1:3) = VR(1:3,i) + where ( dNeq0([om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])) & + ax(1:3) = sign(ax(1:3),-epsijk *[om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)]) + endif + +end function om2ax + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief Rodrigues vector to axis angle pair +!-------------------------------------------------------------------------- +pure function ro2ax(ro) result(ax) + use, intrinsic :: IEEE_ARITHMETIC + use math, only: & + PI + + implicit none + real(pReal), intent(in), dimension(4) :: ro !< homochoric coordinates + real(pReal), dimension(4) :: ax + real(pReal) :: ta, angle + + ta = ro(4) + + if (dEq0(ta)) then + ax = [ 0.0, 0.0, 1.0, 0.0 ] + elseif (.not. IEEE_is_finite(ta)) then + ax = [ ro(1), ro(2), ro(3), PI ] + else + angle = 2.0*atan(ta) + ta = 1.0/norm2(ro(1:3)) + ax = [ ro(1)/ta, ro(2)/ta, ro(3)/ta, angle ] + end if + +end function ro2ax + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert axis angle to Rodrigues +!-------------------------------------------------------------------------- +pure function ax2ro(ax) result(ro) + use, intrinsic :: IEEE_ARITHMETIC + use math, only: & + PI + + implicit none + real(pReal), intent(in), dimension(4) :: ax !< axis angle in degree/radians? + real(pReal), dimension(4) :: ro + real(pReal), parameter :: thr = 1.0E-7 + + if (dEq0(ax(4))) then + ro = [ 0.0_pReal, 0.0_pReal, epsijk, 0.0_pReal ] + else + ro(1:3) = ax(1:3) + ! we need to deal with the 180 degree case + ro(4) = merge(IEEE_value(ro(4),IEEE_positive_inf),tan(ax(4)*0.5 ),abs(ax(4)-PI) < thr) + end if + +end function ax2ro + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert axis angle to quaternion +!-------------------------------------------------------------------------- +pure function ax2qu(ax) result(qu) + + implicit none + real(pReal), intent(in), dimension(4) :: ax + type(quaternion) :: qu + real(pReal) :: c, s + + + if (dEq0(ax(4))) then + qu = quaternion([ 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal ]) + else + c = cos(ax(4)*0.5) + s = sin(ax(4)*0.5) + qu = quaternion([ c, ax(1)*s, ax(2)*s, ax(3)*s ]) + end if + +end function ax2qu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert rodrigues to homochoric +!-------------------------------------------------------------------------- +pure function ro2ho(ro) result(ho) + use, intrinsic :: IEEE_ARITHMETIC + use math, only: & + PI + + implicit none + real(pReal), intent(in), dimension(4) :: ro + real(pReal), dimension(3) :: ho + real(pReal) :: f + + if (dEq0(norm2(ro(1:3)))) then + ho = [ 0.0, 0.0, 0.0 ] + else + f = merge(2.0*atan(ro(4)) - sin(2.0*atan(ro(4))),PI, IEEE_is_finite(ro(4))) + ho = ro(1:3) * (0.75_pReal*f)**(1.0/3.0) + end if + +end function ro2ho + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert a quaternion to a 3x3 matrix +!-------------------------------------------------------------------------- +pure function qu2om(qu) result(om) + + implicit none + type(quaternion), intent(in) :: qu + real(pReal), dimension(3,3) :: om + real(pReal) :: qq + + qq = qu%w**2-(qu%x**2 + qu%y**2 + qu%z**2) + + + om(1,1) = qq+2.0*qu%x*qu%x + om(2,2) = qq+2.0*qu%y*qu%y + om(3,3) = qq+2.0*qu%z*qu%z + + om(1,2) = 2.0*(qu%x*qu%y-qu%w*qu%z) + om(2,3) = 2.0*(qu%y*qu%z-qu%w*qu%x) + om(3,1) = 2.0*(qu%z*qu%x-qu%w*qu%y) + om(2,1) = 2.0*(qu%y*qu%x+qu%w*qu%z) + om(3,2) = 2.0*(qu%z*qu%y+qu%w*qu%x) + om(1,3) = 2.0*(qu%x*qu%z+qu%w*qu%y) + + if (epsijk < 0.0) om = transpose(om) + +end function qu2om + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert a 3x3 rotation matrix to a unit quaternion (see Morawiec, page 37) +!-------------------------------------------------------------------------- +function om2qu(om) result(qu) + + implicit none + real(pReal), intent(in), dimension(3,3) :: om + type(quaternion) :: qu + real(pReal), dimension(4) :: qu_A + real(pReal), dimension(4) :: s + + s = [+om(1,1) +om(2,2) +om(3,3) +1.0_pReal, & + +om(1,1) -om(2,2) -om(3,3) +1.0_pReal, & + -om(1,1) +om(2,2) -om(3,3) +1.0_pReal, & + -om(1,1) -om(2,2) +om(3,3) +1.0_pReal] + + qu_A = sqrt(max(s,0.0_pReal))*0.5_pReal*[1.0_pReal,epsijk,epsijk,epsijk] + qu_A = qu_A/norm2(qu_A) + + if(any(dEq(abs(qu_A),1.0_pReal,1.0e-15_pReal))) & + where (.not.(dEq(abs(qu_A),1.0_pReal,1.0e-15_pReal))) qu_A = 0.0_pReal + + if (om(3,2) < om(2,3)) qu_A(2) = -qu_A(2) + if (om(1,3) < om(3,1)) qu_A(3) = -qu_A(3) + if (om(2,1) < om(1,2)) qu_A(4) = -qu_A(4) + + qu = quaternion(qu_A) + !qu_A = om2ax(om) + !if(any(qu_A(1:3) * [qu%x,qu%y,qu%z] < 0.0)) print*, 'sign error' + +end function om2qu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert quaternion to axis angle +!-------------------------------------------------------------------------- +pure function qu2ax(qu) result(ax) + use math, only: & + PI + + implicit none + type(quaternion), intent(in) :: qu + real(pReal), dimension(4) :: ax + real(pReal) :: omega, s + + omega = 2.0 * acos(qu%w) + ! if the angle equals zero, then we return the rotation axis as [001] + if (dEq0(omega)) then + ax = [ 0.0, 0.0, 1.0, 0.0 ] + elseif (dNeq0(qu%w)) then + s = sign(1.0_pReal,qu%w)/sqrt(qu%x**2+qu%y**2+qu%z**2) + ax = [ qu%x*s, qu%y*s, qu%z*s, omega ] + else + ax = [ qu%x, qu%y, qu%z, PI ] + end if + +end function qu2ax + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert quaternion to Rodrigues +!-------------------------------------------------------------------------- +pure function qu2ro(qu) result(ro) + use, intrinsic :: IEEE_ARITHMETIC + + type(quaternion), intent(in) :: qu + real(pReal), dimension(4) :: ro + real(pReal) :: s + real(pReal), parameter :: thr = 1.0e-8_pReal + + if (qu%w < thr) then + ro = [qu%x, qu%y, qu%z, IEEE_value(ro(4),IEEE_positive_inf)] + else + s = norm2([qu%x,qu%y,qu%z]) + ro = merge ( [ 0.0_pReal, 0.0_pReal, epsijk, 0.0_pReal] , & + [ qu%x/s, qu%y/s, qu%z/s, tan(acos(qu%w))], & + s < thr) + end if + +end function qu2ro + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert quaternion to homochoric +!-------------------------------------------------------------------------- +pure function qu2ho(qu) result(ho) + + implicit none + type(quaternion), intent(in) :: qu + real(pReal), dimension(3) :: ho + real(pReal) :: omega, f + + omega = 2.0 * acos(qu%w) + + if (dEq0(omega)) then + ho = [ 0.0, 0.0, 0.0 ] + else + ho = [qu%x, qu%y, qu%z] + f = 0.75 * ( omega - sin(omega) ) + ho = ho/norm2(ho)* f**(1.0/3.0) + end if + +end function qu2ho + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert homochoric to cubochoric +!-------------------------------------------------------------------------- +function ho2cu(ho) result(cu) + use Lambert, only: LambertBallToCube + + implicit none + real(pReal), intent(in), dimension(3) :: ho + real(pReal), dimension(3) :: cu + + cu = LambertBallToCube(ho) + +end function ho2cu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert cubochoric to homochoric +!-------------------------------------------------------------------------- +function cu2ho(cu) result(ho) + use Lambert, only: LambertCubeToBall + + implicit none + real(pReal), intent(in), dimension(3) :: cu + real(pReal), dimension(3) :: ho + + ho = LambertCubeToBall(cu) + +end function cu2ho + +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- +! and here are a bunch of transformation routines that are derived from the others +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief Rodrigues vector to Euler angles +!-------------------------------------------------------------------------- +pure function ro2eu(ro) result(eu) + + implicit none + real(pReal), intent(in), dimension(4) :: ro !< Rodrigues vector + real(pReal), dimension(3) :: eu + + eu = om2eu(ro2om(ro)) + +end function ro2eu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert euler to homochoric +!-------------------------------------------------------------------------- +pure function eu2ho(eu) result(ho) + + implicit none + real(pReal), intent(in), dimension(3) :: eu + real(pReal), dimension(3) :: ho + + ho = ax2ho(eu2ax(eu)) + +end function eu2ho + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert orientation matrix to Rodrigues +!-------------------------------------------------------------------------- +pure function om2ro(om) result(ro) + + implicit none + real(pReal), intent(in), dimension(3,3) :: om + real(pReal), dimension(4) :: ro + + ro = eu2ro(om2eu(om)) + +end function om2ro + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert orientation matrix to homochoric +!-------------------------------------------------------------------------- +function om2ho(om) result(ho) + + implicit none + real(pReal), intent(in), dimension(3,3) :: om + real(pReal), dimension(3) :: ho + + ho = ax2ho(om2ax(om)) + +end function om2ho + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert axis angle to euler +!-------------------------------------------------------------------------- +pure function ax2eu(ax) result(eu) + + implicit none + real(pReal), intent(in), dimension(4) :: ax + real(pReal), dimension(3) :: eu + + eu = om2eu(ax2om(ax)) + +end function ax2eu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert rodrigues to orientation matrix +!-------------------------------------------------------------------------- +pure function ro2om(ro) result(om) + + implicit none + real(pReal), intent(in), dimension(4) :: ro + real(pReal), dimension(3,3) :: om + + om = ax2om(ro2ax(ro)) + +end function ro2om + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert rodrigues to quaternion +!-------------------------------------------------------------------------- +pure function ro2qu(ro) result(qu) + + implicit none + real(pReal), intent(in), dimension(4) :: ro + type(quaternion) :: qu + + qu = ax2qu(ro2ax(ro)) + +end function ro2qu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert homochoric to euler +!-------------------------------------------------------------------------- +pure function ho2eu(ho) result(eu) + + implicit none + real(pReal), intent(in), dimension(3) :: ho + real(pReal), dimension(3) :: eu + + eu = ax2eu(ho2ax(ho)) + +end function ho2eu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert homochoric to orientation matrix +!-------------------------------------------------------------------------- +pure function ho2om(ho) result(om) + + implicit none + real(pReal), intent(in), dimension(3) :: ho + real(pReal), dimension(3,3) :: om + + om = ax2om(ho2ax(ho)) + +end function ho2om + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert homochoric to Rodrigues +!-------------------------------------------------------------------------- +pure function ho2ro(ho) result(ro) + + implicit none + real(pReal), intent(in), dimension(3) :: ho + real(pReal), dimension(4) :: ro + + + ro = ax2ro(ho2ax(ho)) + +end function ho2ro + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert homochoric to quaternion +!-------------------------------------------------------------------------- +pure function ho2qu(ho) result(qu) + + implicit none + real(pReal), intent(in), dimension(3) :: ho + type(quaternion) :: qu + + qu = ax2qu(ho2ax(ho)) + +end function ho2qu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert euler angles to cubochoric +!-------------------------------------------------------------------------- +function eu2cu(eu) result(cu) + + implicit none + real(pReal), intent(in), dimension(3) :: eu !< Bunge-Euler angles in radians + real(pReal), dimension(3) :: cu + + cu = ho2cu(eu2ho(eu)) + +end function eu2cu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert orientation matrix to cubochoric +!-------------------------------------------------------------------------- +function om2cu(om) result(cu) + + implicit none + real(pReal), intent(in), dimension(3,3) :: om !< rotation matrix + real(pReal), dimension(3) :: cu + + cu = ho2cu(om2ho(om)) + +end function om2cu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert axis angle to cubochoric +!-------------------------------------------------------------------------- +function ax2cu(ax) result(cu) + + implicit none + real(pReal), intent(in), dimension(4) :: ax !< axis angle in degree/radians? + real(pReal), dimension(3) :: cu + + cu = ho2cu(ax2ho(ax)) + +end function ax2cu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert Rodrigues to cubochoric +!-------------------------------------------------------------------------- +function ro2cu(ro) result(cu) + + implicit none + real(pReal), intent(in), dimension(4) :: ro !< Rodrigues vector + real(pReal), dimension(3) :: cu + + cu = ho2cu(ro2ho(ro)) + +end function ro2cu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert quaternion to cubochoric +!-------------------------------------------------------------------------- +function qu2cu(qu) result(cu) + + implicit none + type(quaternion), intent(in) :: qu ! unit quaternion + real(pReal), dimension(3) :: cu + + cu = ho2cu(qu2ho(qu)) + +end function qu2cu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert cubochoric to euler angles +!-------------------------------------------------------------------------- +function cu2eu(cu) result(eu) + + implicit none + real(pReal), intent(in), dimension(3) :: cu ! cubochoric? + real(pReal), dimension(3) :: eu + + eu = ho2eu(cu2ho(cu)) + +end function cu2eu + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert cubochoric to orientation matrix +!-------------------------------------------------------------------------- +function cu2om(cu) result(om) + + implicit none + real(pReal), intent(in), dimension(3) :: cu ! cubochoric? + real(pReal), dimension(3,3) :: om + + om = ho2om(cu2ho(cu)) + +end function cu2om + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert cubochoric to axis angle +!-------------------------------------------------------------------------- +function cu2ax(cu) result(ax) + + implicit none + real(pReal), intent(in), dimension(3) :: cu ! cubochoric? + real(pReal), dimension(4) :: ax + + ax = ho2ax(cu2ho(cu)) + +end function cu2ax + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert cubochoric to Rodrigues +!-------------------------------------------------------------------------- +function cu2ro(cu) result(ro) + + implicit none + real(pReal), intent(in), dimension(3) :: cu ! cubochoric? + real(pReal), dimension(4) :: ro + + ro = ho2ro(cu2ho(cu)) + +end function cu2ro + + +!-------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @brief convert cubochoric to quaternion +!-------------------------------------------------------------------------- +function cu2qu(cu) result(qu) + + implicit none + real(pReal), intent(in), dimension(3) :: cu ! cubochoric? + type(quaternion) :: qu ! cubochoric? + + qu = ho2qu(cu2ho(cu)) + +end function cu2qu + +end module rotations From 5cdd603671696424bcdf36356e42edd8fe3a33cb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 8 Dec 2018 11:40:27 +0100 Subject: [PATCH 002/309] dummy orientations module needs to be extendend to include symmetry --- src/CMakeLists.txt | 8 ++++++-- src/orientations.f90 | 8 ++++++++ src/quaternions.f90 | 3 +-- 3 files changed, 15 insertions(+), 4 deletions(-) create mode 100644 src/orientations.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 4210a79b3..e86fbe422 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -65,14 +65,18 @@ add_library(ROTATIONS OBJECT "rotations.f90") add_dependencies(ROTATIONS LAMBERT QUATERNIONS) list(APPEND OBJECTFILES $) +add_library(ORIENTATIONS OBJECT "orientations.f90") +add_dependencies(ORIENTATIONS ROTATIONS) +list(APPEND OBJECTFILES $) + # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh.f90") - add_dependencies(MESH ROTATIONS FEsolving) + add_dependencies(MESH ORIENTATIONS FEsolving) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") - add_dependencies(FEZoo ROTATIONS FEsolving) + add_dependencies(FEZoo ORIENTATIONS FEsolving) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "meshFEM.f90") add_dependencies(MESH FEZoo) diff --git a/src/orientations.f90 b/src/orientations.f90 new file mode 100644 index 000000000..1a5363ee6 --- /dev/null +++ b/src/orientations.f90 @@ -0,0 +1,8 @@ +module orientations + use rotations + + implicit none + type, extends(rotation), public :: orientation + end type + +end module orientations diff --git a/src/quaternions.f90 b/src/quaternions.f90 index 60b8d387d..78379c49b 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -27,10 +27,9 @@ ! ################################################################### module quaternions - use prec - implicit none + implicit none public type, public :: quaternion real(pReal) :: w = 0.0_pReal From 9686014ce0b17feb0ed74c79ece29038cd9a03bb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 8 Dec 2018 12:52:52 +0100 Subject: [PATCH 003/309] polishing --- src/rotations.f90 | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/rotations.f90 b/src/rotations.f90 index 830f49553..f9ec9cf74 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -33,24 +33,24 @@ module rotations implicit none type, public :: rotation type(quaternion), private :: q - contains - procedure, public :: asEulerAngles => asEulerAngles - procedure, public :: asAxisAnglePair => asAxisAnglePair - procedure, public :: asRodriguesFrankVector => asRodriguesFrankVector - procedure, public :: asRotationMatrix => asRotationMatrix - procedure, public :: rotVector - procedure, public :: rotTensor - end type + contains + procedure, public :: asEulerAngles + procedure, public :: asAxisAnglePair + procedure, public :: asRodriguesFrankVector + procedure, public :: asRotationMatrix + procedure, public :: rotVector + procedure, public :: rotTensor + end type interface rotation - module procedure init + module procedure :: init end interface contains type(rotation) function init(eu,ax,om,qu,cu,ho,ro) real(pReal), intent(in), optional, dimension(3) :: eu, cu, ho - real(pReal), intent(in), optional, dimension(4) :: qu, ax, ro + real(pReal), intent(in), optional, dimension(4) :: ax, qu, ro real(pReal), intent(in), optional, dimension(3,3) :: om if (count([present(eu),present(ax),present(om),present(qu),& @@ -119,7 +119,6 @@ function asHomochoric(this) end function asHomochoric - !-------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief rotates a vector passively (default) or actively @@ -239,7 +238,9 @@ end function eu2ax !> @brief Euler angles to Rodrigues vector !-------------------------------------------------------------------------- pure function eu2ro(eu) result(ro) - use, intrinsic :: IEEE_ARITHMETIC + use, intrinsic :: IEEE_ARITHMETIC, only: & + IEEE_value, & + IEEE_positive_inf use math, only: & PI From c1e5f66d777ac5dadb8bdf2025c92177d0812147 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 8 Dec 2018 13:03:27 +0100 Subject: [PATCH 004/309] make quaternion accesible output as usual array to completly hide the internal representation --- src/rotations.f90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/rotations.f90 b/src/rotations.f90 index f9ec9cf74..539cc23c2 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -34,6 +34,7 @@ module rotations type, public :: rotation type(quaternion), private :: q contains + procedure, public :: asQuaternion procedure, public :: asEulerAngles procedure, public :: asAxisAnglePair procedure, public :: asRodriguesFrankVector @@ -76,6 +77,15 @@ type(rotation) function init(eu,ax,om,qu,cu,ho,ro) end function +function asQuaternion(this) + class(rotation), intent(in) :: this + real(pReal), dimension(4) :: asQuaternion + + asQuaternion = [this%q%w, this%q%x, this%q%y, this%q%z] + +end function asQuaternion + + function asEulerAngles(this) class(rotation), intent(in) :: this real(pReal), dimension(3) :: asEulerAngles From ccdf1e5e8e1e35a03ccb412e80266c1ec461a94c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 8 Dec 2018 13:49:42 +0100 Subject: [PATCH 005/309] polishing --- src/math.f90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 725c0446e..55c082e3a 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -1797,7 +1797,6 @@ function math_sampleGaussOri(center,FWHM) math_sampleGaussOri = math_RtoEuler(math_mul33x33(R,math_EulerToR(center))) endif - end function math_sampleGaussOri @@ -1870,11 +1869,11 @@ real(pReal) function math_sampleGaussVar(meanvalue, stddev, width) tol_math_check implicit none - real(pReal), intent(in) :: meanvalue, & ! meanvalue of gauss distribution - stddev ! standard deviation of gauss distribution - real(pReal), intent(in), optional :: width ! width of considered values as multiples of standard deviation - real(pReal), dimension(2) :: rnd ! random numbers - real(pReal) :: scatter, & ! normalized scatter around meanvalue + real(pReal), intent(in) :: meanvalue, & ! meanvalue of gauss distribution + stddev ! standard deviation of gauss distribution + real(pReal), intent(in), optional :: width ! width of considered values as multiples of standard deviation + real(pReal), dimension(2) :: rnd ! random numbers + real(pReal) :: scatter, & ! normalized scatter around meanvalue myWidth if (abs(stddev) < tol_math_check) then From 5d6faff4d6c7c57fd719ec7b316cf56ed395ad23 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 8 Dec 2018 15:44:00 +0100 Subject: [PATCH 006/309] moving nice initializers to orientation --- src/orientations.f90 | 23 ++++++++++++++++++++-- src/rotations.f90 | 45 ++++++++++++-------------------------------- 2 files changed, 33 insertions(+), 35 deletions(-) diff --git a/src/orientations.f90 b/src/orientations.f90 index 1a5363ee6..29760e05c 100644 --- a/src/orientations.f90 +++ b/src/orientations.f90 @@ -3,6 +3,25 @@ module orientations implicit none type, extends(rotation), public :: orientation - end type + end type orientation -end module orientations + interface orientation + module procedure :: orientation_init + end interface orientation + +contains + +type(orientation) function orientation_init(eu,ax,om,qu,cu,ho,ro) + use prec + implicit none + real(pReal), intent(in), optional, dimension(3) :: eu, cu, ho + real(pReal), intent(in), optional, dimension(4) :: ax, qu, ro + real(pReal), intent(in), optional, dimension(3,3) :: om + + if (present(om)) then + call orientation_init%fromRotationMatrix(om) + endif + +end function orientation_init + +end module diff --git a/src/rotations.f90 b/src/rotations.f90 index 539cc23c2..28c9b208f 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -39,44 +39,13 @@ module rotations procedure, public :: asAxisAnglePair procedure, public :: asRodriguesFrankVector procedure, public :: asRotationMatrix + procedure, public :: fromRotationMatrix procedure, public :: rotVector procedure, public :: rotTensor - end type - - interface rotation - module procedure :: init - end interface + end type rotation contains -type(rotation) function init(eu,ax,om,qu,cu,ho,ro) - real(pReal), intent(in), optional, dimension(3) :: eu, cu, ho - real(pReal), intent(in), optional, dimension(4) :: ax, qu, ro - real(pReal), intent(in), optional, dimension(3,3) :: om - - if (count([present(eu),present(ax),present(om),present(qu),& - present(cu),present(ho),present(ro)]) > 1_pInt) write(6,*) 'invalid' - - if (present(eu)) then - init%q = eu2qu(eu) - elseif (present(ax)) then - init%q = ax2qu(ax) - elseif (present(om)) then - init%q = om2qu(om) - elseif (present(qu)) then - init%q = quaternion(qu) - elseif (present(cu)) then - init%q = cu2qu(cu) - elseif (present(ho)) then - init%q = ho2qu(ho) - elseif (present(ro)) then - init%q = ro2qu(ro) - else - init%q = quaternion([1.0_pReal,0.0_pReal,0.0_pReal,0.0_pReal]) - endif - -end function - function asQuaternion(this) class(rotation), intent(in) :: this real(pReal), dimension(4) :: asQuaternion @@ -129,6 +98,16 @@ function asHomochoric(this) end function asHomochoric + +subroutine fromRotationMatrix(this,om) + class(rotation), intent(out) :: this + real(pReal), dimension(3,3), intent(in) :: om + + this%q = om2qu(om) + +end subroutine + + !-------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief rotates a vector passively (default) or actively From 58862a939dfbbeaf4cdd4a72a8670732c8d4c722 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 8 Dec 2018 15:54:59 +0100 Subject: [PATCH 007/309] initial handling of symmetry introduced --- src/orientations.f90 | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/orientations.f90 b/src/orientations.f90 index 29760e05c..67c46c2bb 100644 --- a/src/orientations.f90 +++ b/src/orientations.f90 @@ -1,8 +1,11 @@ module orientations use rotations + use prec, only: & + pStringLen implicit none type, extends(rotation), public :: orientation + character(len=pStringLen) :: sym = 'none' end type orientation interface orientation @@ -11,13 +14,16 @@ module orientations contains -type(orientation) function orientation_init(eu,ax,om,qu,cu,ho,ro) +type(orientation) function orientation_init(sym,eu,ax,om,qu,cu,ho,ro) use prec implicit none - real(pReal), intent(in), optional, dimension(3) :: eu, cu, ho - real(pReal), intent(in), optional, dimension(4) :: ax, qu, ro - real(pReal), intent(in), optional, dimension(3,3) :: om - + character(len=pStringLen), intent(in), optional :: sym + real(pReal), intent(in), optional, dimension(3) :: eu, cu, ho + real(pReal), intent(in), optional, dimension(4) :: ax, qu, ro + real(pReal), intent(in), optional, dimension(3,3) :: om + + if (present(sym)) orientation_init%sym = sym + if (present(om)) then call orientation_init%fromRotationMatrix(om) endif From e0fa3e0b2609c2429d5656306683b7caba1eabdf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 30 Dec 2018 20:58:38 +0100 Subject: [PATCH 008/309] takeover from 40_XX and 41_XX branch easier to focus on thermal instead of doing all kinematics and sources together --- src/constitutive.f90 | 2 +- src/kinematics_thermal_expansion.f90 | 105 +++------------------------ src/source_thermal_dissipation.f90 | 48 +++++++----- src/source_thermal_externalheat.f90 | 33 ++++++--- src/thermal_adiabatic.f90 | 9 ++- src/thermal_conduction.f90 | 13 ++-- 6 files changed, 76 insertions(+), 134 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 8294047e7..1c32f73d9 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -188,7 +188,7 @@ subroutine constitutive_init() call IO_checkAndRewind(FILEUNIT) if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init(FILEUNIT) if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init(FILEUNIT) - if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init(FILEUNIT) + if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init if (any(phase_kinematics == KINEMATICS_vacancy_strain_ID)) call kinematics_vacancy_strain_init(FILEUNIT) if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) close(FILEUNIT) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 3d1de3d0a..e8f0d71c7 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -10,24 +10,7 @@ module kinematics_thermal_expansion implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - kinematics_thermal_expansion_sizePostResults, & !< cumulative size of post results - kinematics_thermal_expansion_offset, & !< which kinematics is my current damage mechanism? - kinematics_thermal_expansion_instance !< instance of damage kinematics mechanism - integer(pInt), dimension(:,:), allocatable, target, public :: & - kinematics_thermal_expansion_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - kinematics_thermal_expansion_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage - -! enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult -! enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output -! thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... -! end enum public :: & kinematics_thermal_expansion_init, & kinematics_thermal_expansion_initialStrain, & @@ -40,7 +23,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_thermal_expansion_init(fileUnit) +subroutine kinematics_thermal_expansion_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -51,37 +34,17 @@ subroutine kinematics_thermal_expansion_init(fileUnit) debug_constitutive,& debug_levelBasic use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & phase_kinematics, & - phase_Nkinematics, & - phase_Noutput, & KINEMATICS_thermal_expansion_label, & KINEMATICS_thermal_expansion_ID use config, only: & - material_Nphase, & - MATERIAL_partPhase + config_phase implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,kinematics - character(len=65536) :: & - tag = '', & - line = '' - + integer(pInt) maxNinstance + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -91,58 +54,8 @@ subroutine kinematics_thermal_expansion_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(kinematics_thermal_expansion_offset(material_Nphase), source=0_pInt) - allocate(kinematics_thermal_expansion_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - kinematics_thermal_expansion_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_thermal_expansion_ID) - do kinematics = 1, phase_Nkinematics(phase) - if (phase_kinematics(kinematics,phase) == kinematics_thermal_expansion_ID) & - kinematics_thermal_expansion_offset(phase) = kinematics - enddo - enddo - - allocate(kinematics_thermal_expansion_sizePostResults(maxNinstance), source=0_pInt) - allocate(kinematics_thermal_expansion_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(kinematics_thermal_expansion_output(maxval(phase_Noutput),maxNinstance)) - kinematics_thermal_expansion_output = '' - allocate(kinematics_thermal_expansion_Noutput(maxNinstance), source=0_pInt) - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_thermal_expansion_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = kinematics_thermal_expansion_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key... - select case(tag) -! case ('(output)') -! output = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) ! ...and corresponding output -! select case(output) -! case ('thermalexpansionrate') -! kinematics_thermal_expansion_Noutput(instance) = kinematics_thermal_expansion_Noutput(instance) + 1_pInt -! kinematics_thermal_expansion_outputID(kinematics_thermal_expansion_Noutput(instance),instance) = & -! thermalexpansionrate_ID -! kinematics_thermal_expansion_output(kinematics_thermal_expansion_Noutput(instance),instance) = output -! ToDo add sizePostResult loop afterwards... - - end select - endif; endif - enddo parsingFile +! ToDo: this subroutine should read in lattice_thermal_expansion. No need to make it a global array end subroutine kinematics_thermal_expansion_init @@ -187,7 +100,7 @@ end function kinematics_thermal_expansion_initialStrain !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar3333, ipc, ip, el) +subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el) use material, only: & material_phase, & material_homog, & @@ -206,7 +119,7 @@ subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar3333, ipc, real(pReal), intent(out), dimension(3,3) :: & Li !< thermal velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & - dLi_dTstar3333 !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) + dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) integer(pInt) :: & phase, & homog, offset @@ -230,7 +143,7 @@ subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar3333, ipc, + lattice_thermalExpansion33(1:3,1:3,2,phase)*(T - TRef)**2 / 2. & + lattice_thermalExpansion33(1:3,1:3,3,phase)*(T - TRef)**3 / 3. & ) - dLi_dTstar3333 = 0.0_pReal + dLi_dTstar = 0.0_pReal end subroutine kinematics_thermal_expansion_LiAndItsTangent diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 994d26b41..290ad7efe 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -27,6 +27,15 @@ module source_thermal_dissipation real(pReal), dimension(:), allocatable, private :: & source_thermal_dissipation_coldworkCoeff + + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + coldworkCoeff + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + public :: & source_thermal_dissipation_init, & source_thermal_dissipation_getRateAndItsTangent @@ -70,6 +79,7 @@ subroutine source_thermal_dissipation_init(fileUnit) material_phase, & sourceState use config, only: & + config_phase, & material_Nphase, & MATERIAL_partPhase use numerics,only: & @@ -79,9 +89,9 @@ subroutine source_thermal_dissipation_init(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase + integer(pInt) :: NofMyPhase,p character(len=65536) :: & tag = '', & line = '' @@ -90,10 +100,10 @@ subroutine source_thermal_dissipation_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_source == SOURCE_thermal_dissipation_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_thermal_dissipation_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_thermal_dissipation_offset(material_Nphase), source=0_pInt) allocate(source_thermal_dissipation_instance(material_Nphase), source=0_pInt) @@ -105,12 +115,17 @@ subroutine source_thermal_dissipation_init(fileUnit) enddo enddo - allocate(source_thermal_dissipation_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_thermal_dissipation_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_thermal_dissipation_output (maxval(phase_Noutput),maxNinstance)) + allocate(source_thermal_dissipation_sizePostResults(Ninstance), source=0_pInt) + allocate(source_thermal_dissipation_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_thermal_dissipation_output (maxval(phase_Noutput),Ninstance)) source_thermal_dissipation_output = '' - allocate(source_thermal_dissipation_Noutput(maxNinstance), source=0_pInt) - allocate(source_thermal_dissipation_coldworkCoeff(maxNinstance), source=0.0_pReal) + allocate(source_thermal_dissipation_Noutput(Ninstance), source=0_pInt) + + allocate(source_thermal_dissipation_coldworkCoeff(Ninstance), source=0.0_pReal) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_thermal_dissipation_ID)) cycle + enddo rewind(fileUnit) phase = 0_pInt @@ -181,17 +196,14 @@ end subroutine source_thermal_dissipation_init !-------------------------------------------------------------------------------------------------- !> @brief returns local vacancy generation rate !-------------------------------------------------------------------------------------------------- -subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDOT_dT, Tstar_v, Lp, ipc, ip, el) +subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDOT_dT, Tstar_v, Lp, phase, constituent) use math, only: & math_Mandel6to33 - use material, only: & - phaseAt, phasememberAt implicit none integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number + phase, & + constituent real(pReal), intent(in), dimension(6) :: & Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel) real(pReal), intent(in), dimension(3,3) :: & @@ -200,10 +212,8 @@ subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDOT_dT, Tstar TDot, & dTDOT_dT integer(pInt) :: & - instance, phase, constituent + instance - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_thermal_dissipation_instance(phase) TDot = source_thermal_dissipation_coldworkCoeff(instance)* & diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index b7151aece..eac1232f3 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -32,6 +32,18 @@ module source_thermal_externalheat source_thermal_externalheat_time, & source_thermal_externalheat_rate + + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal), dimension(:), allocatable :: & + time, & + rate + integer(pInt) :: & + nInterval + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + public :: & source_thermal_externalheat_init, & source_thermal_externalheat_dotState, & @@ -76,6 +88,7 @@ subroutine source_thermal_externalheat_init(fileUnit) material_phase, & sourceState use config, only: & + config_phase, & material_Nphase, & MATERIAL_partPhase use numerics,only: & @@ -87,7 +100,7 @@ subroutine source_thermal_externalheat_init(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase,interval + integer(pInt) :: NofMyPhase,interval,p character(len=65536) :: & tag = '', & line = '' @@ -117,11 +130,15 @@ subroutine source_thermal_externalheat_init(fileUnit) allocate(source_thermal_externalheat_output (maxval(phase_Noutput),maxNinstance)) source_thermal_externalheat_output = '' allocate(source_thermal_externalheat_Noutput(maxNinstance), source=0_pInt) - allocate(source_thermal_externalheat_nIntervals(maxNinstance), source=0_pInt) + allocate(source_thermal_externalheat_nIntervals(maxNinstance), source=0_pInt) allocate(temp_time(maxNinstance,1000), source=0.0_pReal) allocate(temp_rate(maxNinstance,1000), source=0.0_pReal) + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_thermal_externalheat_ID)) cycle + enddo + rewind(fileUnit) phase = 0_pInt do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to @@ -238,26 +255,22 @@ end subroutine source_thermal_externalheat_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local heat generation rate !-------------------------------------------------------------------------------------------------- -subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, ipc, ip, el) +subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number + phase, & + constituent real(pReal), intent(out) :: & TDot, & dTDot_dT integer(pInt) :: & - instance, phase, constituent, sourceOffset, interval + instance, sourceOffset, interval real(pReal) :: & frac_time - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_thermal_externalheat_instance(phase) sourceOffset = source_thermal_externalheat_offset(phase) diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 6a70ca7ee..dd52293eb 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -238,6 +238,7 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) homogenization_Ngrains, & mappingHomogenization, & phaseAt, & + phasememberAt, & thermal_typeInstance, & phase_Nsources, & phase_source, & @@ -267,7 +268,8 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) offset, & instance, & grain, & - source + source, & + constituent homog = mappingHomogenization(2,ip,el) offset = mappingHomogenization(1,ip,el) @@ -277,17 +279,18 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) dTdot_dT = 0.0_pReal do grain = 1, homogenization_Ngrains(homog) phase = phaseAt(grain,ip,el) + constituent = phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_thermal_dissipation_ID) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & crystallite_Tstar_v(1:6,grain,ip,el), & crystallite_Lp(1:3,1:3,grain,ip,el), & - grain, ip, el) + phase, constituent) case (SOURCE_thermal_externalheat_ID) call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - grain, ip, el) + phase, constituent) case default my_Tdot = 0.0_pReal diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 16497040b..1a9014e89 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -192,6 +192,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) homogenization_Ngrains, & mappingHomogenization, & phaseAt, & + phasememberAt, & thermal_typeInstance, & phase_Nsources, & phase_source, & @@ -221,7 +222,8 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) offset, & instance, & grain, & - source + source, & + constituent homog = mappingHomogenization(2,ip,el) offset = mappingHomogenization(1,ip,el) @@ -231,17 +233,18 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) dTdot_dT = 0.0_pReal do grain = 1, homogenization_Ngrains(homog) phase = phaseAt(grain,ip,el) + constituent = phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_thermal_dissipation_ID) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & crystallite_Tstar_v(1:6,grain,ip,el), & crystallite_Lp(1:3,1:3,grain,ip,el), & - grain, ip, el) + phase, constituent) case (SOURCE_thermal_externalheat_ID) call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - grain, ip, el) + phase, constituent) case default my_Tdot = 0.0_pReal @@ -363,8 +366,8 @@ function thermal_conduction_getMassDensity(ip,el) homog = mappingHomogenization(2,ip,el) do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - thermal_conduction_getMassDensity = thermal_conduction_getMassDensity + & - lattice_massDensity(material_phase(grain,ip,el)) + thermal_conduction_getMassDensity = thermal_conduction_getMassDensity & + + lattice_massDensity(material_phase(grain,ip,el)) enddo thermal_conduction_getMassDensity = & From fd4ae7127952d2c798df249f20c89874309b9ef7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 30 Dec 2018 21:08:48 +0100 Subject: [PATCH 009/309] takeover from 40_XX and 41_XX branch easier to focus on damage instead of doing all kinematics and sources together --- src/constitutive.f90 | 14 ++- src/damage_local.f90 | 13 +- src/damage_nonlocal.f90 | 13 +- src/kinematics_cleavage_opening.f90 | 167 ++++++++------------------ src/kinematics_slipplane_opening.f90 | 170 ++++++++------------------- src/source_damage_anisoBrittle.f90 | 85 ++++++++------ src/source_damage_anisoDuctile.f90 | 85 ++++++++------ src/source_damage_isoBrittle.f90 | 70 ++++++----- src/source_damage_isoDuctile.f90 | 70 ++++++----- 9 files changed, 302 insertions(+), 385 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 8294047e7..ceb396823 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -186,8 +186,8 @@ subroutine constitutive_init() !-------------------------------------------------------------------------------------------------- ! parse kinematic mechanisms from config file call IO_checkAndRewind(FILEUNIT) - if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init(FILEUNIT) - if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init(FILEUNIT) + if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init + if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init(FILEUNIT) if (any(phase_kinematics == KINEMATICS_vacancy_strain_ID)) call kinematics_vacancy_strain_init(FILEUNIT) if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) @@ -1173,16 +1173,18 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) SourceLoop: do s = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) startPos = endPos + 1_pInt endPos = endPos + sourceState(material_phase(ipc,ip,el))%p(s)%sizePostResults + of = phasememberAt(ipc,ip,el) sourceType: select case (phase_source(s,material_phase(ipc,ip,el))) case (SOURCE_damage_isoBrittle_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(ipc, ip, el) + constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(material_phase(ipc,ip,el),of) case (SOURCE_damage_isoDuctile_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_isoDuctile_postResults(ipc, ip, el) + constitutive_postResults(startPos:endPos) = source_damage_isoDuctile_postResults(material_phase(ipc,ip,el),of) case (SOURCE_damage_anisoBrittle_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_anisoBrittle_postResults(ipc, ip, el) + constitutive_postResults(startPos:endPos) = source_damage_anisoBrittle_postResults(material_phase(ipc,ip,el),of) case (SOURCE_damage_anisoDuctile_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_anisoDuctile_postResults(ipc, ip, el) + constitutive_postResults(startPos:endPos) = source_damage_anisoDuctile_postResults(material_phase(ipc,ip,el),of) end select sourceType + enddo SourceLoop end function constitutive_postResults diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 74bcb00db..6569347c2 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -225,6 +225,7 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el homogenization_Ngrains, & mappingHomogenization, & phaseAt, & + phasememberAt, & phase_source, & phase_Nsources, & SOURCE_damage_isoBrittle_ID, & @@ -249,7 +250,8 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el integer(pInt) :: & phase, & grain, & - source + source, & + constituent real(pReal) :: & phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi @@ -257,19 +259,20 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el dPhiDot_dPhi = 0.0_pReal do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el)) phase = phaseAt(grain,ip,el) + constituent = phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_damage_isoBrittle_ID) - call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case (SOURCE_damage_isoDuctile_ID) - call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case (SOURCE_damage_anisoBrittle_ID) - call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case (SOURCE_damage_anisoDuctile_ID) - call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case default localphiDot = 0.0_pReal diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 6b9093ef1..eab808266 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -186,6 +186,7 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, homogenization_Ngrains, & mappingHomogenization, & phaseAt, & + phasememberAt, & phase_source, & phase_Nsources, & SOURCE_damage_isoBrittle_ID, & @@ -210,7 +211,8 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, integer(pInt) :: & phase, & grain, & - source + source, & + constituent real(pReal) :: & phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi @@ -218,19 +220,20 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, dPhiDot_dPhi = 0.0_pReal do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el)) phase = phaseAt(grain,ip,el) + constituent = phasememberAt(grain,ip,el) do source = 1_pInt, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_damage_isoBrittle_ID) - call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case (SOURCE_damage_isoDuctile_ID) - call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case (SOURCE_damage_anisoBrittle_ID) - call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case (SOURCE_damage_anisoDuctile_ID) - call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, grain, ip, el) + call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case default localphiDot = 0.0_pReal diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 998b19562..89d9dcd68 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -11,20 +11,22 @@ module kinematics_cleavage_opening implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - kinematics_cleavage_opening_sizePostResults, & !< cumulative size of post results - kinematics_cleavage_opening_offset, & !< which kinematics is my current damage mechanism? - kinematics_cleavage_opening_instance !< instance of damage kinematics mechanism + integer(pInt), dimension(:), allocatable, private :: kinematics_cleavage_opening_instance - integer(pInt), dimension(:,:), allocatable, target, public :: & - kinematics_cleavage_opening_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - kinematics_cleavage_opening_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - kinematics_cleavage_opening_Noutput !< number of outputs per instance of this damage + type, private :: tParameters !< container type for internal constitutive parameters + integer(pInt) :: & + totalNcleavage + integer(pInt), dimension(:), allocatable :: & + Ncleavage !< active number of cleavage systems per family + real(pReal) :: & + sdot0, & + n + real(pReal), dimension(:), allocatable :: & + critDip, & + critLoad + end type +! Begin Deprecated integer(pInt), dimension(:), allocatable, private :: & kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems @@ -38,6 +40,7 @@ module kinematics_cleavage_opening real(pReal), dimension(:,:), allocatable, private :: & kinematics_cleavage_opening_critDisp, & kinematics_cleavage_opening_critLoad +! End Deprecated public :: & kinematics_cleavage_opening_init, & @@ -50,7 +53,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_cleavage_opening_init(fileUnit) +subroutine kinematics_cleavage_opening_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -60,41 +63,25 @@ subroutine kinematics_cleavage_opening_init(fileUnit) debug_level,& debug_constitutive,& debug_levelBasic + use config, only: & + config_phase use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & phase_kinematics, & - phase_Nkinematics, & - phase_Noutput, & KINEMATICS_cleavage_opening_label, & KINEMATICS_cleavage_opening_ID - use config, only: & - material_Nphase, & - MATERIAL_partPhase use lattice, only: & lattice_maxNcleavageFamily, & lattice_NcleavageSystem implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), allocatable, dimension(:) :: tempInt + real(pReal), allocatable, dimension(:) :: tempFloat - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,kinematics - integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j - character(len=65536) :: & - tag = '', & - line = '' + integer(pInt) :: maxNinstance,p,instance,kinematics write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -106,21 +93,11 @@ subroutine kinematics_cleavage_opening_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(kinematics_cleavage_opening_offset(material_Nphase), source=0_pInt) - allocate(kinematics_cleavage_opening_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - kinematics_cleavage_opening_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_cleavage_opening_ID) - do kinematics = 1, phase_Nkinematics(phase) - if (phase_kinematics(kinematics,phase) == kinematics_cleavage_opening_ID) & - kinematics_cleavage_opening_offset(phase) = kinematics - enddo + allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0_pInt) + do p = 1_pInt, size(config_phase) + kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct? enddo - allocate(kinematics_cleavage_opening_sizePostResults(maxNinstance), source=0_pInt) - allocate(kinematics_cleavage_opening_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt) - allocate(kinematics_cleavage_opening_output(maxval(phase_Noutput),maxNinstance)) - kinematics_cleavage_opening_output = '' - allocate(kinematics_cleavage_opening_Noutput(maxNinstance), source=0_pInt) allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt) @@ -128,84 +105,44 @@ subroutine kinematics_cleavage_opening_init(fileUnit) allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal) allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal) - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_cleavage_opening_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = kinematics_cleavage_opening_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('anisobrittle_sdot0') - kinematics_cleavage_opening_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('anisobrittle_ratesensitivity') - kinematics_cleavage_opening_N(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('ncleavage') ! - Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_CleavageFamilies - kinematics_cleavage_opening_Ncleavage(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo + do p = 1_pInt, size(config_phase) + if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle + instance = kinematics_cleavage_opening_instance(p) + kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0') + kinematics_cleavage_opening_N(instance) = config_phase(p)%getFloat('anisobrittle_ratesensitivity') + tempInt = config_phase(p)%getInts('ncleavage') + kinematics_cleavage_opening_Ncleavage(1:size(tempInt),instance) = tempInt - case ('anisobrittle_criticaldisplacement') - do j = 1_pInt, Nchunks_CleavageFamilies - kinematics_cleavage_opening_critDisp(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo + tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredShape=shape(tempInt)) + kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) = tempFloat - case ('anisobrittle_criticalload') - do j = 1_pInt, Nchunks_CleavageFamilies - kinematics_cleavage_opening_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo + tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredShape=shape(tempInt)) + kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) = tempFloat - end select - endif; endif - enddo parsingFile - -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, material_Nphase - myPhase: if (any(phase_kinematics(:,phase) == KINEMATICS_cleavage_opening_ID)) then - instance = kinematics_cleavage_opening_instance(phase) - kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & - min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,phase),& ! limit active cleavage systems per family to min of available and requested + kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & + min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,p),& ! limit active cleavage systems per family to min of available and requested kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance)) kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') - if (any(kinematics_cleavage_opening_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & + if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') - if (any(kinematics_cleavage_opening_critLoad(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & + if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') - endif myPhase - enddo sanityChecks + enddo end subroutine kinematics_cleavage_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar_v, ipc, ip, el) +subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, ip, el) use prec, only: & tol_math_check use material, only: & - phaseAt, phasememberAt, & + material_phase, & material_homog, & damage, & damageMapping @@ -225,25 +162,22 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar real(pReal), intent(out), dimension(3,3) :: & Ld !< damage velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & - dLd_dTstar3333 !< derivative of Ld with respect to Tstar (4th-order tensor) + dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) integer(pInt) :: & - phase, & - constituent, & - instance, & + instance, phase, & homog, damageOffset, & f, i, index_myFamily, k, l, m, n real(pReal) :: & traction_d, traction_t, traction_n, traction_crit, & udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) + phase = material_phase(ipc,ip,el) instance = kinematics_cleavage_opening_instance(phase) homog = material_homog(ip,el) damageOffset = damageMapping(homog)%p(ip,el) Ld = 0.0_pReal - dLd_dTstar3333 = 0.0_pReal + dLd_dTstar = 0.0_pReal do f = 1_pInt,lattice_maxNcleavageFamily index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family @@ -261,7 +195,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ & max(0.0_pReal, abs(traction_d) - traction_crit) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* & lattice_Scleavage(m,n,1,index_myFamily+i,phase) endif @@ -275,7 +209,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ & max(0.0_pReal, abs(traction_t) - traction_crit) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* & lattice_Scleavage(m,n,2,index_myFamily+i,phase) endif @@ -289,11 +223,10 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ & max(0.0_pReal, abs(traction_n) - traction_crit) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* & lattice_Scleavage(m,n,3,index_myFamily+i,phase) endif - enddo enddo diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 61ff84b9f..573fe7d78 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -11,20 +11,22 @@ module kinematics_slipplane_opening implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - kinematics_slipplane_opening_sizePostResults, & !< cumulative size of post results - kinematics_slipplane_opening_offset, & !< which kinematics is my current damage mechanism? - kinematics_slipplane_opening_instance !< instance of damage kinematics mechanism - - integer(pInt), dimension(:,:), allocatable, target, public :: & - kinematics_slipplane_opening_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - kinematics_slipplane_opening_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - kinematics_slipplane_opening_Noutput !< number of outputs per instance of this damage + integer(pInt), dimension(:), allocatable, private :: kinematics_slipplane_opening_instance + type, private :: tParameters !< container type for internal constitutive parameters + integer(pInt) :: & + totalNslip + integer(pInt), dimension(:), allocatable :: & + Nslip !< active number of slip systems per family + real(pReal) :: & + sdot0, & + n + real(pReal), dimension(:), allocatable :: & + critDip, & + critPlasticStrain + end type + +! Begin Deprecated integer(pInt), dimension(:), allocatable, private :: & kinematics_slipplane_opening_totalNslip !< total number of slip systems @@ -38,6 +40,7 @@ module kinematics_slipplane_opening real(pReal), dimension(:,:), allocatable, private :: & kinematics_slipplane_opening_critPlasticStrain, & kinematics_slipplane_opening_critLoad +! End Deprecated public :: & kinematics_slipplane_opening_init, & @@ -50,7 +53,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine kinematics_slipplane_opening_init(fileUnit) +subroutine kinematics_slipplane_opening_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -60,41 +63,25 @@ subroutine kinematics_slipplane_opening_init(fileUnit) debug_level,& debug_constitutive,& debug_levelBasic + use config, only: & + config_phase use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & phase_kinematics, & - phase_Nkinematics, & - phase_Noutput, & KINEMATICS_slipplane_opening_label, & KINEMATICS_slipplane_opening_ID - use config, only: & - material_Nphase, & - MATERIAL_partPhase use lattice, only: & lattice_maxNslipFamily, & lattice_NslipSystem implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), allocatable, dimension(:) :: tempInt + real(pReal), allocatable, dimension(:) :: tempFloat - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,kinematics - integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j - character(len=65536) :: & - tag = '', & - line = '' + integer(pInt) :: maxNinstance,p,instance,kinematics write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -106,21 +93,11 @@ subroutine kinematics_slipplane_opening_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(kinematics_slipplane_opening_offset(material_Nphase), source=0_pInt) - allocate(kinematics_slipplane_opening_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - kinematics_slipplane_opening_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_slipplane_opening_ID) - do kinematics = 1, phase_Nkinematics(phase) - if (phase_kinematics(kinematics,phase) == kinematics_slipplane_opening_ID) & - kinematics_slipplane_opening_offset(phase) = kinematics - enddo + allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0_pInt) + do p = 1_pInt, size(config_phase) + kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct? enddo - allocate(kinematics_slipplane_opening_sizePostResults(maxNinstance), source=0_pInt) - allocate(kinematics_slipplane_opening_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(kinematics_slipplane_opening_output(maxval(phase_Noutput),maxNinstance)) - kinematics_slipplane_opening_output = '' - allocate(kinematics_slipplane_opening_Noutput(maxNinstance), source=0_pInt) allocate(kinematics_slipplane_opening_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(kinematics_slipplane_opening_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) allocate(kinematics_slipplane_opening_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) @@ -128,61 +105,22 @@ subroutine kinematics_slipplane_opening_init(fileUnit) allocate(kinematics_slipplane_opening_N(maxNinstance), source=0.0_pReal) allocate(kinematics_slipplane_opening_sdot_0(maxNinstance), source=0.0_pReal) - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_slipplane_opening_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = kinematics_slipplane_opening_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('nslip') ! - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_SlipFamilies - kinematics_slipplane_opening_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo + do p = 1_pInt, size(config_phase) + if (all(phase_kinematics(:,p) /= KINEMATICS_slipplane_opening_ID)) cycle + instance = kinematics_slipplane_opening_instance(p) + kinematics_slipplane_opening_sdot_0(instance) = config_phase(p)%getFloat('anisoductile_sdot0') + kinematics_slipplane_opening_N(instance) = config_phase(p)%getFloat('anisoductile_ratesensitivity') + tempInt = config_phase(p)%getInts('ncleavage') + kinematics_slipplane_opening_Nslip(1:size(tempInt),instance) = tempInt - case ('anisoductile_sdot0') - kinematics_slipplane_opening_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('anisoductile_criticalplasticstrain') - do j = 1_pInt, Nchunks_SlipFamilies - kinematics_slipplane_opening_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('anisoductile_ratesensitivity') - kinematics_slipplane_opening_N(instance) = IO_floatValue(line,chunkPos,2_pInt) + tempFloat = config_phase(p)%getFloats('anisoductile_criticalplasticstrain',requiredShape=shape(tempInt)) + kinematics_slipplane_opening_critPlasticStrain(1:size(tempInt),instance) = tempFloat - case ('anisoductile_criticalload') - do j = 1_pInt, Nchunks_SlipFamilies - kinematics_slipplane_opening_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - end select - endif; endif - enddo parsingFile + tempFloat = config_phase(p)%getFloats('anisoductile_criticalload',requiredShape=shape(tempInt)) + kinematics_slipplane_opening_critLoad(1:size(tempInt),instance) = tempFloat -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, material_Nphase - myPhase: if (any(phase_kinematics(:,phase) == KINEMATICS_slipplane_opening_ID)) then - instance = kinematics_slipplane_opening_instance(phase) kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance) = & - min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active cleavage systems per family to min of available and requested + min(lattice_NslipSystem(1:lattice_maxNslipFamily,p),& ! limit active cleavage systems per family to min of available and requested kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance)) kinematics_slipplane_opening_totalNslip(instance) = sum(kinematics_slipplane_opening_Nslip(:,instance)) if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) & @@ -191,16 +129,14 @@ subroutine kinematics_slipplane_opening_init(fileUnit) call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')') if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')') - endif myPhase - enddo sanityChecks + enddo - end subroutine kinematics_slipplane_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tstar_v, ipc, ip, el) +subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, ip, el) use prec, only: & tol_math_check use lattice, only: & @@ -210,19 +146,15 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta lattice_st, & lattice_sn use material, only: & - phaseAt, phasememberAt, & + material_phase, & material_homog, & damage, & damageMapping use math, only: & math_Plain3333to99, & - math_I3, & - math_identity4th, & math_symmetric33, & math_Mandel33to6, & - math_tensorproduct33, & - math_det33, & - math_mul33x33 + math_tensorproduct33 implicit none integer(pInt), intent(in) :: & @@ -234,29 +166,26 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta real(pReal), intent(out), dimension(3,3) :: & Ld !< damage velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & - dLd_dTstar3333 !< derivative of Ld with respect to Tstar (4th-order tensor) + dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) real(pReal), dimension(3,3) :: & projection_d, projection_t, projection_n !< projection modes 3x3 tensor real(pReal), dimension(6) :: & projection_d_v, projection_t_v, projection_n_v !< projection modes 3x3 vector integer(pInt) :: & - phase, & - constituent, & - instance, & + instance, phase, & homog, damageOffset, & f, i, index_myFamily, k, l, m, n real(pReal) :: & traction_d, traction_t, traction_n, traction_crit, & udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) + phase = material_phase(ipc,ip,el) instance = kinematics_slipplane_opening_instance(phase) homog = material_homog(ip,el) damageOffset = damageMapping(homog)%p(ip,el) Ld = 0.0_pReal - dLd_dTstar3333 = 0.0_pReal + dLd_dTstar = 0.0_pReal do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,kinematics_slipplane_opening_Nslip(f,instance) ! process each (active) slip system in family @@ -287,7 +216,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta Ld = Ld + udotd*projection_d dudotd_dt = udotd*kinematics_slipplane_opening_N(instance)/traction_d forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotd_dt*projection_d(k,l)*projection_d(m,n) endif @@ -300,9 +229,10 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta Ld = Ld + udott*projection_t dudott_dt = udott*kinematics_slipplane_opening_N(instance)/traction_t forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudott_dt*projection_t(k,l)*projection_t(m,n) endif + udotn = & kinematics_slipplane_opening_sdot_0(instance)* & (max(0.0_pReal,traction_n)/traction_crit - & @@ -311,7 +241,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar3333, Tsta Ld = Ld + udotn*projection_n dudotn_dt = udotn*kinematics_slipplane_opening_N(instance)/traction_n forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLd_dTstar3333(k,l,m,n) = dLd_dTstar3333(k,l,m,n) + & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & dudotn_dt*projection_n(k,l)*projection_n(m,n) endif enddo diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 6b222c37c..b8bd3246d 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -49,6 +49,23 @@ module source_damage_anisoBrittle source_damage_anisoBrittle_outputID !< ID of each post result output + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + aTol, & + sdot_0, & + N + real(pReal), dimension(:), allocatable :: & + critDisp, & + critLoad + integer(pInt) :: & + totalNcleavage + integer(pInt), dimension(:), allocatable :: & + Ncleavage + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + public :: & source_damage_anisoBrittle_init, & source_damage_anisoBrittle_dotState, & @@ -94,6 +111,7 @@ subroutine source_damage_anisoBrittle_init(fileUnit) material_phase, & sourceState use config, only: & + config_phase, & material_Nphase, & MATERIAL_partPhase use numerics,only: & @@ -106,9 +124,9 @@ subroutine source_damage_anisoBrittle_init(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase + integer(pInt) :: NofMyPhase,p integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j character(len=65536) :: & tag = '', & @@ -118,11 +136,11 @@ subroutine source_damage_anisoBrittle_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0_pInt) allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0_pInt) @@ -134,19 +152,24 @@ subroutine source_damage_anisoBrittle_init(fileUnit) enddo enddo - allocate(source_damage_anisoBrittle_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt) - allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),maxNinstance)) + allocate(source_damage_anisoBrittle_sizePostResults(Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoBrittle_output = '' - allocate(source_damage_anisoBrittle_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(source_damage_anisoBrittle_Noutput(maxNinstance), source=0_pInt) - allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt) - allocate(source_damage_anisoBrittle_totalNcleavage(maxNinstance), source=0_pInt) - allocate(source_damage_anisoBrittle_aTol(maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_sdot_0(maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_N(maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) + allocate(source_damage_anisoBrittle_Noutput(Ninstance), source=0_pInt) + + allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_totalNcleavage(Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_aTol(Ninstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_sdot_0(Ninstance), source=0.0_pReal) + allocate(source_damage_anisoBrittle_N(Ninstance), source=0.0_pReal) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_damage_anisoBrittle_ID)) cycle + enddo rewind(fileUnit) phase = 0_pInt @@ -349,26 +372,22 @@ end subroutine source_damage_anisoBrittle_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) +subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + phase, & + constituent real(pReal), intent(in) :: & phi real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi integer(pInt) :: & - phase, constituent, sourceOffset + sourceOffset - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) sourceOffset = source_damage_anisoBrittle_offset(phase) localphiDot = 1.0_pReal - & @@ -381,25 +400,21 @@ end subroutine source_damage_anisobrittle_getRateAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- -function source_damage_anisoBrittle_postResults(ipc,ip,el) +function source_damage_anisoBrittle_postResults(phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + integer(pInt), intent(in) :: & + phase, & + constituent real(pReal), dimension(source_damage_anisoBrittle_sizePostResults( & - source_damage_anisoBrittle_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_anisoBrittle_instance(phase))) :: & source_damage_anisoBrittle_postResults integer(pInt) :: & - instance, phase, constituent, sourceOffset, o, c + instance, sourceOffset, o, c - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_damage_anisoBrittle_instance(phase) sourceOffset = source_damage_anisoBrittle_offset(phase) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 5978960fb..c52dd4ff4 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -53,6 +53,23 @@ module source_damage_anisoDuctile source_damage_anisoDuctile_outputID !< ID of each post result output + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + aTol, & + sdot_0, & + N + real(pReal), dimension(:), allocatable :: & + critPlasticStrain, & + critLoad + integer(pInt) :: & + totalNslip + integer(pInt), dimension(:), allocatable :: & + Nslip + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + public :: & source_damage_anisoDuctile_init, & source_damage_anisoDuctile_dotState, & @@ -98,6 +115,7 @@ subroutine source_damage_anisoDuctile_init(fileUnit) material_phase, & sourceState use config, only: & + config_phase, & material_Nphase, & MATERIAL_partPhase use numerics,only: & @@ -110,9 +128,9 @@ subroutine source_damage_anisoDuctile_init(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase + integer(pInt) :: NofMyPhase,p integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j character(len=65536) :: & tag = '', & @@ -122,11 +140,11 @@ subroutine source_damage_anisoDuctile_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_damage_anisoDuctile_offset(material_Nphase), source=0_pInt) allocate(source_damage_anisoDuctile_instance(material_Nphase), source=0_pInt) @@ -138,19 +156,24 @@ subroutine source_damage_anisoDuctile_init(fileUnit) enddo enddo - allocate(source_damage_anisoDuctile_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),maxNinstance)) + allocate(source_damage_anisoDuctile_sizePostResults(Ninstance), source=0_pInt) + allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoDuctile_output = '' - allocate(source_damage_anisoDuctile_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(source_damage_anisoDuctile_Noutput(maxNinstance), source=0_pInt) - allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(source_damage_anisoDuctile_totalNslip(maxNinstance), source=0_pInt) - allocate(source_damage_anisoDuctile_N(maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoDuctile_sdot_0(maxNinstance), source=0.0_pReal) - allocate(source_damage_anisoDuctile_aTol(maxNinstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) + allocate(source_damage_anisoDuctile_Noutput(Ninstance), source=0_pInt) + + allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,Ninstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,Ninstance),source=0.0_pReal) + allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) + allocate(source_damage_anisoDuctile_totalNslip(Ninstance), source=0_pInt) + allocate(source_damage_anisoDuctile_N(Ninstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_sdot_0(Ninstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_aTol(Ninstance), source=0.0_pReal) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_damage_anisoDuctile_ID)) cycle + enddo rewind(fileUnit) phase = 0_pInt @@ -338,26 +361,22 @@ end subroutine source_damage_anisoDuctile_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) +subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + phase, & + constituent real(pReal), intent(in) :: & phi real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi integer(pInt) :: & - phase, constituent, sourceOffset + sourceOffset - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) sourceOffset = source_damage_anisoDuctile_offset(phase) localphiDot = 1.0_pReal - & @@ -371,25 +390,21 @@ end subroutine source_damage_anisoDuctile_getRateAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- -function source_damage_anisoDuctile_postResults(ipc,ip,el) +function source_damage_anisoDuctile_postResults(phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + integer(pInt), intent(in) :: & + phase, & + constituent real(pReal), dimension(source_damage_anisoDuctile_sizePostResults( & - source_damage_anisoDuctile_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_anisoDuctile_instance(phase))) :: & source_damage_anisoDuctile_postResults integer(pInt) :: & - instance, phase, constituent, sourceOffset, o, c + instance, sourceOffset, o, c - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 041761afe..6f572c72b 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -39,6 +39,16 @@ module source_damage_isoBrittle source_damage_isoBrittle_outputID !< ID of each post result output + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + critStrainEnergy, & + N, & + aTol + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + public :: & source_damage_isoBrittle_init, & source_damage_isoBrittle_deltaState, & @@ -84,6 +94,7 @@ subroutine source_damage_isoBrittle_init(fileUnit) material_phase, & sourceState use config, only: & + config_phase, & material_Nphase, & MATERIAL_partPhase use numerics,only: & @@ -93,9 +104,9 @@ subroutine source_damage_isoBrittle_init(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase + integer(pInt) :: NofMyPhase,p character(len=65536) :: & tag = '', & line = '' @@ -104,11 +115,11 @@ subroutine source_damage_isoBrittle_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_damage_isoBrittle_offset(material_Nphase), source=0_pInt) allocate(source_damage_isoBrittle_instance(material_Nphase), source=0_pInt) @@ -120,15 +131,20 @@ subroutine source_damage_isoBrittle_init(fileUnit) enddo enddo - allocate(source_damage_isoBrittle_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),maxNinstance)) + allocate(source_damage_isoBrittle_sizePostResults(Ninstance), source=0_pInt) + allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_isoBrittle_output = '' - allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(source_damage_isoBrittle_Noutput(maxNinstance), source=0_pInt) - allocate(source_damage_isoBrittle_critStrainEnergy(maxNinstance), source=0.0_pReal) - allocate(source_damage_isoBrittle_N(maxNinstance), source=1.0_pReal) - allocate(source_damage_isoBrittle_aTol(maxNinstance), source=0.0_pReal) + allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) + allocate(source_damage_isoBrittle_Noutput(Ninstance), source=0_pInt) + + allocate(source_damage_isoBrittle_critStrainEnergy(Ninstance), source=0.0_pReal) + allocate(source_damage_isoBrittle_N(Ninstance), source=1.0_pReal) + allocate(source_damage_isoBrittle_aTol(Ninstance), source=0.0_pReal) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_damage_isoBrittle_ID)) cycle + enddo rewind(fileUnit) phase = 0_pInt @@ -306,26 +322,22 @@ end subroutine source_damage_isoBrittle_deltaState !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) +subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + phase, & + constituent real(pReal), intent(in) :: & phi real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi integer(pInt) :: & - phase, constituent, instance, sourceOffset + instance, sourceOffset - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) @@ -340,25 +352,21 @@ end subroutine source_damage_isoBrittle_getRateAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- -function source_damage_isoBrittle_postResults(ipc,ip,el) +function source_damage_isoBrittle_postResults(phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + integer(pInt), intent(in) :: & + phase, & + constituent real(pReal), dimension(source_damage_isoBrittle_sizePostResults( & - source_damage_isoBrittle_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_isoBrittle_instance(phase))) :: & source_damage_isoBrittle_postResults integer(pInt) :: & - instance, phase, constituent, sourceOffset, o, c + instance, sourceOffset, o, c - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index e843be728..b4ecb53e4 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -39,6 +39,16 @@ module source_damage_isoDuctile source_damage_isoDuctile_outputID !< ID of each post result output + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + critPlasticStrain, & + N, & + aTol + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + public :: & source_damage_isoDuctile_init, & source_damage_isoDuctile_dotState, & @@ -84,6 +94,7 @@ subroutine source_damage_isoDuctile_init(fileUnit) material_phase, & sourceState use config, only: & + config_phase, & material_Nphase, & MATERIAL_partPhase @@ -94,9 +105,9 @@ subroutine source_damage_isoDuctile_init(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase + integer(pInt) :: NofMyPhase,p character(len=65536) :: & tag = '', & line = '' @@ -105,11 +116,11 @@ subroutine source_damage_isoDuctile_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance allocate(source_damage_isoDuctile_offset(material_Nphase), source=0_pInt) allocate(source_damage_isoDuctile_instance(material_Nphase), source=0_pInt) @@ -121,15 +132,20 @@ subroutine source_damage_isoDuctile_init(fileUnit) enddo enddo - allocate(source_damage_isoDuctile_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),maxNinstance)) + allocate(source_damage_isoDuctile_sizePostResults(Ninstance), source=0_pInt) + allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_isoDuctile_output = '' - allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(source_damage_isoDuctile_Noutput(maxNinstance), source=0_pInt) - allocate(source_damage_isoDuctile_critPlasticStrain(maxNinstance), source=0.0_pReal) - allocate(source_damage_isoDuctile_N(maxNinstance), source=0.0_pReal) - allocate(source_damage_isoDuctile_aTol(maxNinstance), source=0.0_pReal) + allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) + allocate(source_damage_isoDuctile_Noutput(Ninstance), source=0_pInt) + + allocate(source_damage_isoDuctile_critPlasticStrain(Ninstance), source=0.0_pReal) + allocate(source_damage_isoDuctile_N(Ninstance), source=0.0_pReal) + allocate(source_damage_isoDuctile_aTol(Ninstance), source=0.0_pReal) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_damage_isoDuctile_ID)) cycle + enddo rewind(fileUnit) phase = 0_pInt @@ -275,26 +291,22 @@ end subroutine source_damage_isoDuctile_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ipc, ip, el) +subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + phase, & + constituent real(pReal), intent(in) :: & phi real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi integer(pInt) :: & - phase, constituent, sourceOffset + sourceOffset - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) sourceOffset = source_damage_isoDuctile_offset(phase) localphiDot = 1.0_pReal - & @@ -308,25 +320,21 @@ end subroutine source_damage_isoDuctile_getRateAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- -function source_damage_isoDuctile_postResults(ipc,ip,el) +function source_damage_isoDuctile_postResults(phase, constituent) use material, only: & - phaseAt, phasememberAt, & sourceState implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + integer(pInt), intent(in) :: & + phase, & + constituent real(pReal), dimension(source_damage_isoDuctile_sizePostResults( & - source_damage_isoDuctile_instance(phaseAt(ipc,ip,el)))) :: & + source_damage_isoDuctile_instance(phase))) :: & source_damage_isoDuctile_postResults integer(pInt) :: & - instance, phase, constituent, sourceOffset, o, c + instance, sourceOffset, o, c - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) From ced7da4d62815f6c5663da612a0c4b46120fd45f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 30 Dec 2018 21:54:50 +0100 Subject: [PATCH 010/309] avoid mappings in bottom end functions --- src/homogenization.f90 | 10 +++-- src/thermal_adiabatic.f90 | 35 ++++++--------- src/thermal_conduction.f90 | 90 ++++++++++++++++++-------------------- src/thermal_isothermal.f90 | 30 ++++++------- 4 files changed, 77 insertions(+), 88 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 82a97dc53..0bf0f80be 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -1091,6 +1091,8 @@ function homogenization_postResults(ip,el) use mesh, only: & mesh_element use material, only: & + thermalMapping, & + thermal_typeInstance, & mappingHomogenization, & homogState, & thermalState, & @@ -1153,7 +1155,7 @@ function homogenization_postResults(ip,el) + hydrogenfluxState(mappingHomogenization(2,ip,el))%sizePostResults) :: & homogenization_postResults integer(pInt) :: & - startPos, endPos + startPos, endPos, homog homogenization_postResults = 0.0_pReal @@ -1184,11 +1186,13 @@ function homogenization_postResults(ip,el) case (THERMAL_isothermal_ID) chosenThermal case (THERMAL_adiabatic_ID) chosenThermal + homog = mappingHomogenization(2,ip,el) homogenization_postResults(startPos:endPos) = & - thermal_adiabatic_postResults(ip, el) + thermal_adiabatic_postResults(homog,thermal_typeInstance(homog),thermalMapping(homog)%p(ip,el)) case (THERMAL_conduction_ID) chosenThermal + homog = mappingHomogenization(2,ip,el) homogenization_postResults(startPos:endPos) = & - thermal_conduction_postResults(ip, el) + thermal_conduction_postResults(homog,thermal_typeInstance(homog),thermalMapping(homog)%p(ip,el)) end select chosenThermal startPos = endPos + 1_pInt diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index dd52293eb..e44030e64 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -10,8 +10,6 @@ module thermal_adiabatic implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - thermal_adiabatic_sizePostResults !< cumulative size of post results integer(pInt), dimension(:,:), allocatable, target, public :: & thermal_adiabatic_sizePostResult !< size of each post result output @@ -98,7 +96,6 @@ subroutine thermal_adiabatic_init(fileUnit) maxNinstance = int(count(thermal_type == THERMAL_adiabatic_ID),pInt) if (maxNinstance == 0_pInt) return - allocate(thermal_adiabatic_sizePostResults(maxNinstance), source=0_pInt) allocate(thermal_adiabatic_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) allocate(thermal_adiabatic_output (maxval(homogenization_Noutput),maxNinstance)) thermal_adiabatic_output = '' @@ -157,14 +154,13 @@ subroutine thermal_adiabatic_init(fileUnit) if (mySize > 0_pInt) then ! any meaningful output found thermal_adiabatic_sizePostResult(o,instance) = mySize - thermal_adiabatic_sizePostResults(instance) = thermal_adiabatic_sizePostResults(instance) + mySize endif enddo outputsLoop ! allocate state arrays sizeState = 1_pInt thermalState(section)%sizeState = sizeState - thermalState(section)%sizePostResults = thermal_adiabatic_sizePostResults(instance) + thermalState(section)%sizePostResults = sum(thermal_adiabatic_sizePostResult(:,instance)) allocate(thermalState(section)%state0 (sizeState,NofMyHomog), source=thermal_initialT(section)) allocate(thermalState(section)%subState0(sizeState,NofMyHomog), source=thermal_initialT(section)) allocate(thermalState(section)%state (sizeState,NofMyHomog), source=thermal_initialT(section)) @@ -344,6 +340,7 @@ function thermal_adiabatic_getSpecificHeat(ip,el) end function thermal_adiabatic_getSpecificHeat + !-------------------------------------------------------------------------------------------------- !> @brief returns homogenized mass density !-------------------------------------------------------------------------------------------------- @@ -381,42 +378,38 @@ function thermal_adiabatic_getMassDensity(ip,el) thermal_adiabatic_getMassDensity/real(homogenization_Ngrains(mesh_element(3,el)),pReal) end function thermal_adiabatic_getMassDensity - + + !-------------------------------------------------------------------------------------------------- !> @brief return array of thermal results !-------------------------------------------------------------------------------------------------- -function thermal_adiabatic_postResults(ip,el) +function thermal_adiabatic_postResults(homog,instance,of) result(postResults) use material, only: & - mappingHomogenization, & - thermal_typeInstance, & - thermalMapping, & temperature implicit none integer(pInt), intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(thermal_adiabatic_sizePostResults(thermal_typeInstance(mappingHomogenization(2,ip,el)))) :: & - thermal_adiabatic_postResults + homog, & + instance, & + of + + real(pReal), dimension(sum(thermal_adiabatic_sizePostResult(:,instance))) :: & + postResults integer(pInt) :: & - instance, homog, offset, o, c - - homog = mappingHomogenization(2,ip,el) - offset = thermalMapping(homog)%p(ip,el) - instance = thermal_typeInstance(homog) + o, c c = 0_pInt - thermal_adiabatic_postResults = 0.0_pReal do o = 1_pInt,thermal_adiabatic_Noutput(instance) select case(thermal_adiabatic_outputID(o,instance)) case (temperature_ID) - thermal_adiabatic_postResults(c+1_pInt) = temperature(homog)%p(offset) + postResults(c+1_pInt) = temperature(homog)%p(of) c = c + 1 end select enddo + end function thermal_adiabatic_postResults end module thermal_adiabatic diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 1a9014e89..d9e10eece 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -10,8 +10,6 @@ module thermal_conduction implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - thermal_conduction_sizePostResults !< cumulative size of post results integer(pInt), dimension(:,:), allocatable, target, public :: & thermal_conduction_sizePostResult !< size of each post result output @@ -99,7 +97,6 @@ subroutine thermal_conduction_init(fileUnit) maxNinstance = int(count(thermal_type == THERMAL_conduction_ID),pInt) if (maxNinstance == 0_pInt) return - allocate(thermal_conduction_sizePostResults(maxNinstance), source=0_pInt) allocate(thermal_conduction_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) allocate(thermal_conduction_output (maxval(homogenization_Noutput),maxNinstance)) thermal_conduction_output = '' @@ -144,42 +141,40 @@ subroutine thermal_conduction_init(fileUnit) enddo parsingFile initializeInstances: do section = 1_pInt, size(thermal_type) - if (thermal_type(section) == THERMAL_conduction_ID) then - NofMyHomog=count(material_homog==section) - instance = thermal_typeInstance(section) + if (thermal_type(section) /= THERMAL_conduction_ID) cycle + NofMyHomog=count(material_homog==section) + instance = thermal_typeInstance(section) !-------------------------------------------------------------------------------------------------- ! Determine size of postResults array - outputsLoop: do o = 1_pInt,thermal_conduction_Noutput(instance) - select case(thermal_conduction_outputID(o,instance)) - case(temperature_ID) - mySize = 1_pInt - end select + outputsLoop: do o = 1_pInt,thermal_conduction_Noutput(instance) + select case(thermal_conduction_outputID(o,instance)) + case(temperature_ID) + mySize = 1_pInt + end select - if (mySize > 0_pInt) then ! any meaningful output found - thermal_conduction_sizePostResult(o,instance) = mySize - thermal_conduction_sizePostResults(instance) = thermal_conduction_sizePostResults(instance) + mySize - endif - enddo outputsLoop + if (mySize > 0_pInt) then ! any meaningful output found + thermal_conduction_sizePostResult(o,instance) = mySize + endif + enddo outputsLoop ! allocate state arrays - sizeState = 0_pInt - thermalState(section)%sizeState = sizeState - thermalState(section)%sizePostResults = thermal_conduction_sizePostResults(instance) - allocate(thermalState(section)%state0 (sizeState,NofMyHomog)) - allocate(thermalState(section)%subState0(sizeState,NofMyHomog)) - allocate(thermalState(section)%state (sizeState,NofMyHomog)) + sizeState = 0_pInt + thermalState(section)%sizeState = sizeState + thermalState(section)%sizePostResults = sum(thermal_conduction_sizePostResult(:,instance)) + allocate(thermalState(section)%state0 (sizeState,NofMyHomog)) + allocate(thermalState(section)%subState0(sizeState,NofMyHomog)) + allocate(thermalState(section)%state (sizeState,NofMyHomog)) - nullify(thermalMapping(section)%p) - thermalMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(temperature (section)%p) - allocate (temperature (section)%p(NofMyHomog), source=thermal_initialT(section)) - deallocate(temperatureRate(section)%p) - allocate (temperatureRate(section)%p(NofMyHomog), source=0.0_pReal) + nullify(thermalMapping(section)%p) + thermalMapping(section)%p => mappingHomogenization(1,:,:) + deallocate(temperature (section)%p) + allocate (temperature (section)%p(NofMyHomog), source=thermal_initialT(section)) + deallocate(temperatureRate(section)%p) + allocate (temperatureRate(section)%p(NofMyHomog), source=0.0_pReal) - endif - enddo initializeInstances + end subroutine thermal_conduction_init !-------------------------------------------------------------------------------------------------- @@ -261,6 +256,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) end subroutine thermal_conduction_getSourceAndItsTangent + !-------------------------------------------------------------------------------------------------- !> @brief returns homogenized thermal conductivity in reference configuration !-------------------------------------------------------------------------------------------------- @@ -298,7 +294,8 @@ function thermal_conduction_getConductivity33(ip,el) thermal_conduction_getConductivity33/real(homogenization_Ngrains(mesh_element(3,el)),pReal) end function thermal_conduction_getConductivity33 - + + !-------------------------------------------------------------------------------------------------- !> @brief returns homogenized specific heat capacity !-------------------------------------------------------------------------------------------------- @@ -374,7 +371,8 @@ function thermal_conduction_getMassDensity(ip,el) thermal_conduction_getMassDensity/real(homogenization_Ngrains(mesh_element(3,el)),pReal) end function thermal_conduction_getMassDensity - + + !-------------------------------------------------------------------------------------------------- !> @brief updates thermal state with solution from heat conduction PDE !-------------------------------------------------------------------------------------------------- @@ -403,41 +401,37 @@ subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el) end subroutine thermal_conduction_putTemperatureAndItsRate + !-------------------------------------------------------------------------------------------------- !> @brief return array of thermal results !-------------------------------------------------------------------------------------------------- -function thermal_conduction_postResults(ip,el) +function thermal_conduction_postResults(homog,instance,of) result(postResults) use material, only: & - mappingHomogenization, & - thermal_typeInstance, & - temperature, & - thermalMapping + temperature implicit none integer(pInt), intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(thermal_conduction_sizePostResults(thermal_typeInstance(mappingHomogenization(2,ip,el)))) :: & - thermal_conduction_postResults + homog, & + instance, & + of + + real(pReal), dimension(sum(thermal_conduction_sizePostResult(:,instance))) :: & + postResults integer(pInt) :: & - instance, homog, offset, o, c - - homog = mappingHomogenization(2,ip,el) - offset = thermalMapping(homog)%p(ip,el) - instance = thermal_typeInstance(homog) + o, c c = 0_pInt - thermal_conduction_postResults = 0.0_pReal do o = 1_pInt,thermal_conduction_Noutput(instance) select case(thermal_conduction_outputID(o,instance)) case (temperature_ID) - thermal_conduction_postResults(c+1_pInt) = temperature(homog)%p(offset) + postResults(c+1_pInt) = temperature(homog)%p(of) c = c + 1 end select enddo + end function thermal_conduction_postResults end module thermal_conduction diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index fb518fe24..7485cd34f 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -26,14 +26,14 @@ subroutine thermal_isothermal_init() pInt use IO, only: & IO_timeStamp + use config, only: & + material_Nhomogenization use material - use config implicit none integer(pInt) :: & homog, & - NofMyHomog, & - sizeState + NofMyHomog write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -41,21 +41,19 @@ subroutine thermal_isothermal_init() initializeInstances: do homog = 1_pInt, material_Nhomogenization - myhomog: if (thermal_type(homog) == THERMAL_isothermal_ID) then - NofMyHomog = count(material_homog == homog) - sizeState = 0_pInt - thermalState(homog)%sizeState = sizeState - thermalState(homog)%sizePostResults = sizeState - allocate(thermalState(homog)%state0 (sizeState,NofMyHomog), source=0.0_pReal) - allocate(thermalState(homog)%subState0(sizeState,NofMyHomog), source=0.0_pReal) - allocate(thermalState(homog)%state (sizeState,NofMyHomog), source=0.0_pReal) + if (thermal_type(homog) /= THERMAL_isothermal_ID) cycle + NofMyHomog = count(material_homog == homog) + thermalState(homog)%sizeState = 0_pInt + thermalState(homog)%sizePostResults = 0_pInt + allocate(thermalState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) + allocate(thermalState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) + allocate(thermalState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal) - deallocate(temperature (homog)%p) - allocate (temperature (homog)%p(1), source=thermal_initialT(homog)) - deallocate(temperatureRate(homog)%p) - allocate (temperatureRate(homog)%p(1), source=0.0_pReal) + deallocate(temperature (homog)%p) + allocate (temperature (homog)%p(1), source=thermal_initialT(homog)) + deallocate(temperatureRate(homog)%p) + allocate (temperatureRate(homog)%p(1), source=0.0_pReal) - endif myhomog enddo initializeInstances From 9d2c60e943e9471b47a7d016e76003bdf0037c8c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 30 Dec 2018 22:30:21 +0100 Subject: [PATCH 011/309] don't read material.config during init --- src/homogenization.f90 | 6 +-- src/thermal_adiabatic.f90 | 84 ++++++++++---------------------------- src/thermal_conduction.f90 | 73 ++++++++------------------------- 3 files changed, 40 insertions(+), 123 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 0bf0f80be..3f20ef7b4 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -139,11 +139,11 @@ subroutine homogenization_init ! parse thermal from config file call IO_checkAndRewind(FILEUNIT) if (any(thermal_type == THERMAL_isothermal_ID)) & - call thermal_isothermal_init() + call thermal_isothermal_init if (any(thermal_type == THERMAL_adiabatic_ID)) & - call thermal_adiabatic_init(FILEUNIT) + call thermal_adiabatic_init if (any(thermal_type == THERMAL_conduction_ID)) & - call thermal_conduction_init(FILEUNIT) + call thermal_conduction_init !-------------------------------------------------------------------------------------------------- ! parse damage from config file diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index e44030e64..e0ad3214f 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -13,7 +13,6 @@ module thermal_adiabatic integer(pInt), dimension(:,:), allocatable, target, public :: & thermal_adiabatic_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & thermal_adiabatic_output !< name of each post result output @@ -43,27 +42,15 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine thermal_adiabatic_init(fileUnit) +subroutine thermal_adiabatic_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & compiler_options #endif use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF - use config, only: & - material_partHomogenization + IO_timeStamp use material, only: & thermal_type, & thermal_typeInstance, & @@ -77,17 +64,16 @@ subroutine thermal_adiabatic_init(fileUnit) thermal_initialT, & temperature, & temperatureRate + use config, only: & + material_partHomogenization, & + config_homogenization implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o + integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o,i integer(pInt) :: sizeState integer(pInt) :: NofMyHomog - character(len=65536) :: & - tag = '', & - line = '' + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + character(len=65536), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_ADIABATIC_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -102,47 +88,20 @@ subroutine thermal_adiabatic_init(fileUnit) allocate(thermal_adiabatic_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) allocate(thermal_adiabatic_Noutput (maxNinstance), source=0_pInt) - rewind(fileUnit) - section = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homog part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next homog section - section = section + 1_pInt ! advance homog section counter - cycle ! skip to next line - endif - - if (section > 0_pInt ) then; if (thermal_type(section) == THERMAL_adiabatic_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = thermal_typeInstance(section) ! which instance of my thermal is present homog - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('temperature') - thermal_adiabatic_Noutput(instance) = thermal_adiabatic_Noutput(instance) + 1_pInt - thermal_adiabatic_outputID(thermal_adiabatic_Noutput(instance),instance) = temperature_ID - thermal_adiabatic_output(thermal_adiabatic_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - end select - endif; endif - enddo parsingFile initializeInstances: do section = 1_pInt, size(thermal_type) - if (thermal_type(section) == THERMAL_adiabatic_ID) then - NofMyHomog=count(material_homog==section) - instance = thermal_typeInstance(section) + if (thermal_type(section) /= THERMAL_adiabatic_ID) cycle + NofMyHomog=count(material_homog==section) + instance = thermal_typeInstance(section) + outputs = config_homogenization(section)%getStrings('(output)',defaultVal=emptyStringArray) + do i=1_pInt, size(outputs) + select case(outputs(i)) + case('temperature') + thermal_adiabatic_Noutput(instance) = thermal_adiabatic_Noutput(instance) + 1_pInt + thermal_adiabatic_outputID(thermal_adiabatic_Noutput(instance),instance) = temperature_ID + thermal_adiabatic_output(thermal_adiabatic_Noutput(instance),instance) = outputs(i) + end select + enddo !-------------------------------------------------------------------------------------------------- ! Determine size of postResults array @@ -172,9 +131,8 @@ subroutine thermal_adiabatic_init(fileUnit) deallocate(temperatureRate(section)%p) allocate (temperatureRate(section)%p(NofMyHomog), source=0.0_pReal) - endif - enddo initializeInstances + end subroutine thermal_adiabatic_init !-------------------------------------------------------------------------------------------------- diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index d9e10eece..067871c59 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -13,7 +13,6 @@ module thermal_conduction integer(pInt), dimension(:,:), allocatable, target, public :: & thermal_conduction_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & thermal_conduction_output !< name of each post result output @@ -44,25 +43,15 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_init(fileUnit) +subroutine thermal_conduction_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & compiler_options #endif use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & thermal_type, & thermal_typeInstance, & @@ -77,18 +66,15 @@ subroutine thermal_conduction_init(fileUnit) temperature, & temperatureRate use config, only: & - material_partHomogenization + material_partHomogenization, & + config_homogenization implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o + integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o,i integer(pInt) :: sizeState integer(pInt) :: NofMyHomog - character(len=65536) :: & - tag = '', & - line = '' + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + character(len=65536), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_CONDUCTION_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -103,47 +89,20 @@ subroutine thermal_conduction_init(fileUnit) allocate(thermal_conduction_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) allocate(thermal_conduction_Noutput (maxNinstance), source=0_pInt) - rewind(fileUnit) - section = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homog part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next homog section - section = section + 1_pInt ! advance homog section counter - cycle ! skip to next line - endif - - if (section > 0_pInt ) then; if (thermal_type(section) == THERMAL_conduction_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = thermal_typeInstance(section) ! which instance of my thermal is present homog - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('temperature') - thermal_conduction_Noutput(instance) = thermal_conduction_Noutput(instance) + 1_pInt - thermal_conduction_outputID(thermal_conduction_Noutput(instance),instance) = temperature_ID - thermal_conduction_output(thermal_conduction_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - end select - endif; endif - enddo parsingFile initializeInstances: do section = 1_pInt, size(thermal_type) if (thermal_type(section) /= THERMAL_conduction_ID) cycle NofMyHomog=count(material_homog==section) instance = thermal_typeInstance(section) + outputs = config_homogenization(section)%getStrings('(output)',defaultVal=emptyStringArray) + do i=1_pInt, size(outputs) + select case(outputs(i)) + case('temperature') + thermal_conduction_Noutput(instance) = thermal_conduction_Noutput(instance) + 1_pInt + thermal_conduction_outputID(thermal_conduction_Noutput(instance),instance) = temperature_ID + thermal_conduction_output(thermal_conduction_Noutput(instance),instance) = outputs(i) + end select + enddo !-------------------------------------------------------------------------------------------------- ! Determine size of postResults array From efb07e0b93c83e3c0e2afacf8d32fad4c76ba5b6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 15 Jan 2019 04:55:40 +0100 Subject: [PATCH 012/309] only output direct quantities derived quantities can be easily calculated during post processing --- src/plastic_nonlocal.f90 | 573 +-------------------------------------- 1 file changed, 4 insertions(+), 569 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index e1355da8f..a7288bde0 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -150,61 +150,34 @@ module plastic_nonlocal enum, bind(c) enumerator :: undefined_ID, & - rho_ID, & - delta_ID, & - rho_edge_ID, & - rho_screw_ID, & - rho_sgl_ID, & - delta_sgl_ID, & - rho_sgl_edge_ID, & - rho_sgl_edge_pos_ID, & - rho_sgl_edge_neg_ID, & - rho_sgl_screw_ID, & - rho_sgl_screw_pos_ID, & - rho_sgl_screw_neg_ID, & - rho_sgl_mobile_ID, & - rho_sgl_edge_mobile_ID, & rho_sgl_edge_pos_mobile_ID, & rho_sgl_edge_neg_mobile_ID, & - rho_sgl_screw_mobile_ID, & rho_sgl_screw_pos_mobile_ID, & rho_sgl_screw_neg_mobile_ID, & - rho_sgl_immobile_ID, & - rho_sgl_edge_immobile_ID, & rho_sgl_edge_pos_immobile_ID, & rho_sgl_edge_neg_immobile_ID, & - rho_sgl_screw_immobile_ID, & rho_sgl_screw_pos_immobile_ID, & rho_sgl_screw_neg_immobile_ID, & - rho_dip_ID, & - delta_dip_ID, & rho_dip_edge_ID, & rho_dip_screw_ID, & - excess_rho_ID, & - excess_rho_edge_ID, & - excess_rho_screw_ID, & rho_forest_ID, & shearrate_ID, & resolvedstress_ID, & resolvedstress_external_ID, & resolvedstress_back_ID, & resistance_ID, & - rho_dot_ID, & rho_dot_sgl_ID, & rho_dot_sgl_mobile_ID, & rho_dot_dip_ID, & rho_dot_gen_ID, & rho_dot_gen_edge_ID, & rho_dot_gen_screw_ID, & - rho_dot_sgl2dip_ID, & rho_dot_sgl2dip_edge_ID, & rho_dot_sgl2dip_screw_ID, & rho_dot_ann_ath_ID, & - rho_dot_ann_the_ID, & rho_dot_ann_the_edge_ID, & rho_dot_ann_the_screw_ID, & rho_dot_edgejogs_ID, & - rho_dot_flux_ID, & rho_dot_flux_mobile_ID, & rho_dot_flux_edge_ID, & rho_dot_flux_screw_ID, & @@ -212,28 +185,9 @@ module plastic_nonlocal velocity_edge_neg_ID, & velocity_screw_pos_ID, & velocity_screw_neg_ID, & - slipdirectionx_ID, & - slipdirectiony_ID, & - slipdirectionz_ID, & - slipnormalx_ID, & - slipnormaly_ID, & - slipnormalz_ID, & - fluxdensity_edge_posx_ID, & - fluxdensity_edge_posy_ID, & - fluxdensity_edge_posz_ID, & - fluxdensity_edge_negx_ID, & - fluxdensity_edge_negy_ID, & - fluxdensity_edge_negz_ID, & - fluxdensity_screw_posx_ID, & - fluxdensity_screw_posy_ID, & - fluxdensity_screw_posz_ID, & - fluxdensity_screw_negx_ID, & - fluxdensity_screw_negy_ID, & - fluxdensity_screw_negz_ID, & maximumdipoleheight_edge_ID, & maximumdipoleheight_screw_ID, & - accumulatedshear_ID, & - dislocationstress_ID + accumulatedshear_ID end enum integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & plastic_nonlocal_outputID !< ID of each post result output @@ -426,76 +380,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s select case(tag) case ('(output)') select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('rho') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('delta') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('delta_sgl') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_sgl_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_pos') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_neg') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_pos') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_neg') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_pos_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_mobile_ID @@ -506,11 +390,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_pos_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_mobile_ID @@ -521,31 +400,11 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_mobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_edge_pos_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_neg_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_pos_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID @@ -556,16 +415,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dip') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('delta_dip') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_dip_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dip_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_edge_ID @@ -576,21 +425,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('excess_rho') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('excess_rho_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('excess_rho_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_forest') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_forest_ID @@ -621,11 +455,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resistance_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_sgl') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl_ID @@ -656,11 +485,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_screw_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_sgl2dip') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_sgl2dip_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_edge_ID @@ -676,11 +500,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_ath_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_ann_the') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_ann_the_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_edge_ID @@ -696,11 +515,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_edgejogs_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_flux') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_dot_flux_mobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_mobile_ID @@ -736,96 +550,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_screw_neg_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipdirection.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipdirection.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectiony_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipdirection.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipnormal.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipnormal.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormaly_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('slipnormal.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_pos.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_pos.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posy_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_pos.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_neg.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_neg.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negy_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_edge_neg.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_pos.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_pos.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posy_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_pos.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_neg.x') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negx_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_neg.y') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negy_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('fluxdensity_screw_neg.z') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negz_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('maximumdipoleheight_edge') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = maximumdipoleheight_edge_ID @@ -841,11 +565,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = accumulatedshear_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('dislocationstress') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = dislocationstress_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select case ('nslip') if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) & @@ -1195,93 +914,8 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) select case(plastic_nonlocal_outputID(o,instance)) - case( rho_ID, & - delta_ID, & - rho_edge_ID, & - rho_screw_ID, & - rho_sgl_ID, & - delta_sgl_ID, & - rho_sgl_edge_ID, & - rho_sgl_edge_pos_ID, & - rho_sgl_edge_neg_ID, & - rho_sgl_screw_ID, & - rho_sgl_screw_pos_ID, & - rho_sgl_screw_neg_ID, & - rho_sgl_mobile_ID, & - rho_sgl_edge_mobile_ID, & - rho_sgl_edge_pos_mobile_ID, & - rho_sgl_edge_neg_mobile_ID, & - rho_sgl_screw_mobile_ID, & - rho_sgl_screw_pos_mobile_ID, & - rho_sgl_screw_neg_mobile_ID, & - rho_sgl_immobile_ID, & - rho_sgl_edge_immobile_ID, & - rho_sgl_edge_pos_immobile_ID, & - rho_sgl_edge_neg_immobile_ID, & - rho_sgl_screw_immobile_ID, & - rho_sgl_screw_pos_immobile_ID, & - rho_sgl_screw_neg_immobile_ID, & - rho_dip_ID, & - delta_dip_ID, & - rho_dip_edge_ID, & - rho_dip_screw_ID, & - excess_rho_ID, & - excess_rho_edge_ID, & - excess_rho_screw_ID, & - rho_forest_ID, & - shearrate_ID, & - resolvedstress_ID, & - resolvedstress_external_ID, & - resolvedstress_back_ID, & - resistance_ID, & - rho_dot_ID, & - rho_dot_sgl_ID, & - rho_dot_sgl_mobile_ID, & - rho_dot_dip_ID, & - rho_dot_gen_ID, & - rho_dot_gen_edge_ID, & - rho_dot_gen_screw_ID, & - rho_dot_sgl2dip_ID, & - rho_dot_sgl2dip_edge_ID, & - rho_dot_sgl2dip_screw_ID, & - rho_dot_ann_ath_ID, & - rho_dot_ann_the_ID, & - rho_dot_ann_the_edge_ID, & - rho_dot_ann_the_screw_ID, & - rho_dot_edgejogs_ID, & - rho_dot_flux_ID, & - rho_dot_flux_mobile_ID, & - rho_dot_flux_edge_ID, & - rho_dot_flux_screw_ID, & - velocity_edge_pos_ID, & - velocity_edge_neg_ID, & - velocity_screw_pos_ID, & - velocity_screw_neg_ID, & - slipdirectionx_ID, & - slipdirectiony_ID, & - slipdirectionz_ID, & - slipnormalx_ID, & - slipnormaly_ID, & - slipnormalz_ID, & - fluxdensity_edge_posx_ID, & - fluxdensity_edge_posy_ID, & - fluxdensity_edge_posz_ID, & - fluxdensity_edge_negx_ID, & - fluxdensity_edge_negy_ID, & - fluxdensity_edge_negz_ID, & - fluxdensity_screw_posx_ID, & - fluxdensity_screw_posy_ID, & - fluxdensity_screw_posz_ID, & - fluxdensity_screw_negx_ID, & - fluxdensity_screw_negy_ID, & - fluxdensity_screw_negz_ID, & - maximumdipoleheight_edge_ID, & - maximumdipoleheight_screw_ID, & - accumulatedshear_ID ) - mySize = totalNslip(instance) - case(dislocationstress_ID) - mySize = 6_pInt case default + mySize = totalNslip(instance) end select if (mySize > 0_pInt) then ! any meaningful output found @@ -3655,45 +3289,6 @@ forall (s = 1_pInt:ns) & outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) select case(plastic_nonlocal_outputID(o,instance)) - case (rho_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2) + sum(rhoDip,2) - cs = cs + ns - - case (rho_sgl_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2) - cs = cs + ns - - case (rho_sgl_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,1:4)),2) - cs = cs + ns - - case (rho_sgl_immobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:8),2) - cs = cs + ns - - case (rho_dip_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDip,2) - cs = cs + ns - - case (rho_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) + rhoDip(1:ns,1) - cs = cs + ns - - case (rho_sgl_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) - cs = cs + ns - - case (rho_sgl_edge_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,1:2),2) - cs = cs + ns - - case (rho_sgl_edge_immobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:6),2) - cs = cs + ns - - case (rho_sgl_edge_pos_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5)) - cs = cs + ns case (rho_sgl_edge_pos_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) @@ -3703,10 +3298,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,5) cs = cs + ns - case (rho_sgl_edge_neg_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6)) - cs = cs + ns - case (rho_sgl_edge_neg_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) cs = cs + ns @@ -3719,26 +3310,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,1) cs = cs + ns - case (rho_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) + rhoDip(1:ns,2) - cs = cs + ns - - case (rho_sgl_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) - cs = cs + ns - - case (rho_sgl_screw_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,3:4),2) - cs = cs + ns - - case (rho_sgl_screw_immobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,7:8),2) - cs = cs + ns - - case (rho_sgl_screw_pos_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7)) - cs = cs + ns - case (rho_sgl_screw_pos_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) cs = cs + ns @@ -3746,10 +3317,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) case (rho_sgl_screw_pos_immobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,7) cs = cs + ns - - case (rho_sgl_screw_neg_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8)) - cs = cs + ns case (rho_sgl_screw_neg_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) @@ -3763,38 +3330,9 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,2) cs = cs + ns - case (excess_rho_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) & - - (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))) & - + (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) & - - (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8))) - cs = cs + ns - - case (excess_rho_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) & - - (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))) - cs = cs + ns - - case (excess_rho_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) & - - (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8))) - cs = cs + ns - case (rho_forest_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoForest cs = cs + ns - - case (delta_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2) + sum(rhoDip,2)) - cs = cs + ns - - case (delta_sgl_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2)) - cs = cs + ns - - case (delta_dip_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(rhoDip,2)) - cs = cs + ns case (shearrate_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(gdot,2) @@ -3818,12 +3356,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) case (resistance_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = tauThreshold cs = cs + ns - - case (rho_dot_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & - + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) & - + sum(rhoDotDip,2) - cs = cs + ns case (rho_dot_sgl_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & @@ -3838,7 +3370,7 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotDip,2) cs = cs + ns - case (rho_dot_gen_ID) + case (rho_dot_gen_ID) ! Obsolete plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) & + rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns @@ -3850,11 +3382,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) case (rho_dot_gen_screw_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns - - case (rho_dot_sgl2dip_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) & - + rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el) - cs = cs + ns case (rho_dot_sgl2dip_edge_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) @@ -3868,11 +3395,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & + rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns - - case (rho_dot_ann_the_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & - + rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) - cs = cs + ns case (rho_dot_ann_the_edge_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) @@ -3890,11 +3412,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) cs = cs + ns - case (rho_dot_flux_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) & - + sum(rhoDotFluxOutput(1:ns,5:8,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) - cs = cs + ns - case (rho_dot_flux_edge_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,1_pInt,ip,el),2) & + sum(rhoDotFluxOutput(1:ns,5:6,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2) @@ -3921,78 +3438,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,4) cs = cs + ns - case (slipdirectionx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(1,1:ns,1) - cs = cs + ns - - case (slipdirectiony_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(2,1:ns,1) - cs = cs + ns - - case (slipdirectionz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(3,1:ns,1) - cs = cs + ns - - case (slipnormalx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(1,1:ns) - cs = cs + ns - - case (slipnormaly_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(2,1:ns) - cs = cs + ns - - case (slipnormalz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(3,1:ns) - cs = cs + ns - - case (fluxdensity_edge_posx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(1,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_posy_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(2,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_posz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(3,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_negx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(1,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_negy_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(2,1:ns,1) - cs = cs + ns - - case (fluxdensity_edge_negz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(3,1:ns,1) - cs = cs + ns - - case (fluxdensity_screw_posx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(1,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_posy_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(2,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_posz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(3,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_negx_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(1,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_negy_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(2,1:ns,2) - cs = cs + ns - - case (fluxdensity_screw_negz_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(3,1:ns,2) - cs = cs + ns - case (maximumdipoleheight_edge_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,1) cs = cs + ns @@ -4000,17 +3445,7 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) case (maximumdipoleheight_screw_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,2) cs = cs + ns - - case(dislocationstress_ID) - sigma = plastic_nonlocal_dislocationstress(Fe, ip, el) - plastic_nonlocal_postResults(cs+1_pInt) = sigma(1,1) - plastic_nonlocal_postResults(cs+2_pInt) = sigma(2,2) - plastic_nonlocal_postResults(cs+3_pInt) = sigma(3,3) - plastic_nonlocal_postResults(cs+4_pInt) = sigma(1,2) - plastic_nonlocal_postResults(cs+5_pInt) = sigma(2,3) - plastic_nonlocal_postResults(cs+6_pInt) = sigma(3,1) - cs = cs + 6_pInt - + case(accumulatedshear_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = plasticState(ph)%state(iGamma(1:ns,instance),of) cs = cs + ns From 854afb7107612ae75c3ef312b8825839374dc140 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 15 Jan 2019 15:54:05 +0100 Subject: [PATCH 013/309] removed on output too much --- src/plastic_nonlocal.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index a7288bde0..c43de6627 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -405,6 +405,11 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('rho_sgl_edge_neg_immobile') + plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt + plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID + plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) case ('rho_sgl_screw_pos_immobile') plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID From 558a610df1dce05e7a132b6cdf00cb1aec8ef045 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 09:49:21 +0100 Subject: [PATCH 014/309] underscore for separation --- src/CMakeLists.txt | 2 +- src/{meshFEM.f90 => mesh_FEM.f90} | 0 2 files changed, 1 insertion(+), 1 deletion(-) rename src/{meshFEM.f90 => mesh_FEM.f90} (100%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 23c7a5643..9e8926d0a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -66,7 +66,7 @@ elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") add_dependencies(FEZoo DAMASK_MATH) list(APPEND OBJECTFILES $) - add_library(MESH OBJECT "meshFEM.f90") + add_library(MESH OBJECT "mesh_FEM.f90") add_dependencies(MESH FEZoo) list(APPEND OBJECTFILES $) endif() diff --git a/src/meshFEM.f90 b/src/mesh_FEM.f90 similarity index 100% rename from src/meshFEM.f90 rename to src/mesh_FEM.f90 From 612fa31188c68882e691f801b5dfc95382b60393 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 09:52:18 +0100 Subject: [PATCH 015/309] preparing solver-specific mesh functionality --- src/CMakeLists.txt | 2 +- src/commercialFEM_fileList.f90 | 7 +- src/{mesh.f90 => mesh_abaqus.f90} | 0 src/mesh_grid.f90 | 4280 +++++++++++++++++++++++++++++ src/mesh_marc.f90 | 4280 +++++++++++++++++++++++++++++ 5 files changed, 8567 insertions(+), 2 deletions(-) rename src/{mesh.f90 => mesh_abaqus.f90} (100%) create mode 100644 src/mesh_grid.f90 create mode 100644 src/mesh_marc.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9e8926d0a..3818130da 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -59,7 +59,7 @@ list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") - add_library(MESH OBJECT "mesh.f90") + add_library(MESH OBJECT "mesh_grid.f90") add_dependencies(MESH DAMASK_MATH) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 4feb52bed..a7a61c2f7 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -12,7 +12,12 @@ #endif #include "math.f90" #include "FEsolving.f90" -#include "mesh.f90" +#ifdef Abaqus +#include "mesh_abaqus.f90" +#endif +#ifdef Marc4DAMASK +#include "mesh_marc.f90" +#endif #include "material.f90" #include "lattice.f90" #include "source_thermal_dissipation.f90" diff --git a/src/mesh.f90 b/src/mesh_abaqus.f90 similarity index 100% rename from src/mesh.f90 rename to src/mesh_abaqus.f90 diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 new file mode 100644 index 000000000..e55165d51 --- /dev/null +++ b/src/mesh_grid.f90 @@ -0,0 +1,4280 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver +!-------------------------------------------------------------------------------------------------- +module mesh + use, intrinsic :: iso_c_binding + use prec, only: pReal, pInt + + implicit none + private + integer(pInt), public, protected :: & + mesh_NcpElems, & !< total number of CP elements in local mesh + mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes) + mesh_Nnodes, & !< total number of nodes in mesh + mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) + mesh_Ncells, & !< total number of cells in mesh + mesh_NipsPerElem, & !< number of IPs in per element + mesh_NcellnodesPerElem, & !< number of cell nodes per element + mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element + mesh_maxNsharedElems !< max number of CP elements sharing a node +!!!! BEGIN DEPRECATED !!!!! + integer(pInt), public, protected :: & + mesh_maxNips, & !< max number of IPs in any CP element + mesh_maxNcellnodes !< max number of cell nodes in any CP element +!!!! BEGIN DEPRECATED !!!!! + + integer(pInt), dimension(:), allocatable, public, protected :: & + mesh_homogenizationAt, & !< homogenization ID of each element + mesh_microstructureAt !< microstructure ID of each element + + integer(pInt), dimension(:,:), allocatable, public, protected :: & + mesh_CPnodeID, & !< nodes forming an element + mesh_element, & !DEPRECATED + mesh_sharedElem, & !< entryCount and list of elements containing node + mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) + + integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] + + real(pReal), public, protected :: & + mesh_unitlength !< physical length of one unit in mesh + + real(pReal), dimension(:,:), allocatable, public :: & + mesh_node, & !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + mesh_cellnode !< cell node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + + real(pReal), dimension(:,:), allocatable, public, protected :: & + mesh_ipVolume, & !< volume associated with IP (initially!) + mesh_node0 !< node x,y,z coordinates (initially!) + + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + mesh_ipArea !< area of interface to neighboring IP (initially!) + + real(pReal), dimension(:,:,:), allocatable, public :: & + mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) + + real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) + + logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) + +#if defined(Marc4DAMASK) || defined(Abaqus) + integer(pInt), private :: & + mesh_maxNelemInSet, & + mesh_Nmaterials +#endif + + integer(pInt), dimension(2), private :: & + mesh_maxValStateVar = 0_pInt + +integer(pInt), dimension(:,:), allocatable, private :: & + mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID + + integer(pInt),dimension(:,:,:), allocatable, private :: & + mesh_cell !< cell connectivity for each element,ip/cell + + integer(pInt), dimension(:,:,:), allocatable, private :: & + FE_nodesAtIP, & !< map IP index to node indices in a specific type of element + FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element + FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry + FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell + + real(pReal), dimension(:,:,:), allocatable, private :: & + FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes + + integer(pInt), dimension(:,:,:,:), allocatable, private :: & + FE_subNodeOnIPFace + +! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) +! Hence, I suggest to prefix with "FE_" + + integer(pInt), parameter, public :: & + FE_Nelemtypes = 13_pInt, & + FE_Ngeomtypes = 10_pInt, & + FE_Ncelltypes = 4_pInt, & + FE_maxNnodes = 20_pInt, & + FE_maxNips = 27_pInt, & + FE_maxNipNeighbors = 6_pInt, & + FE_maxmaxNnodesAtIP = 8_pInt, & !< max number of (equivalent) nodes attached to an IP + FE_maxNmatchingNodesPerFace = 4_pInt, & + FE_maxNfaces = 6_pInt, & + FE_maxNcellnodes = 64_pInt, & + FE_maxNcellnodesPerCell = 8_pInt, & + FE_maxNcellfaces = 6_pInt, & + FE_maxNcellnodesPerCellface = 4_pInt + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type + int([ & + 1, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 3, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 3, & ! element 54 (2D 8node 4ip) + 5, & ! element 134 (3D 4node 1ip) + 6, & ! element 157 (3D 5node 4ip) + 6, & ! element 127 (3D 10node 4ip) + 7, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 9, & ! element 7 (3D 8node 8ip) + 9, & ! element 57 (3D 20node 8ip) + 10 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type + int([ & + 1, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 4, & ! element 136 (3D 6node 6ip) + 4, & ! element 117 (3D 8node 1ip) + 4, & ! element 7 (3D 8node 8ip) + 4 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type + int([ & + 2, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 3, & ! element 127 (3D 10node 4ip) + 3, & ! element 136 (3D 6node 6ip) + 3, & ! element 117 (3D 8node 1ip) + 3, & ! element 7 (3D 8node 8ip) + 3 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element + int([ & + 3, & ! element 6 (2D 3node 1ip) + 6, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 8, & ! element 27 (2D 8node 9ip) + 8, & ! element 54 (2D 8node 4ip) + 4, & ! element 134 (3D 4node 1ip) + 5, & ! element 157 (3D 5node 4ip) + 10, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 20, & ! element 57 (3D 20node 8ip) + 20 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nfaces = & !< number of faces of a specific type of element geometry + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 5, & ! element 136 (3D 6node 6ip) + 6, & ! element 117 (3D 8node 1ip) + 6, & ! element 7 (3D 8node 8ip) + 6 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 8 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: & + FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry + reshape(int([ & + 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) + 2,2,2,0,0,0, & ! element 125 (2D 6node 3ip) + 2,2,2,2,0,0, & ! element 11 (2D 4node 4ip) + 2,2,2,2,0,0, & ! element 27 (2D 8node 9ip) + 3,3,3,3,0,0, & ! element 134 (3D 4node 1ip) + 3,3,3,3,0,0, & ! element 127 (3D 10node 4ip) + 3,4,4,4,3,0, & ! element 136 (3D 6node 6ip) + 4,4,4,4,4,4, & ! element 117 (3D 8node 1ip) + 4,4,4,4,4,4, & ! element 7 (3D 8node 8ip) + 4,4,4,4,4,4 & ! element 21 (3D 20node 27ip) + ],pInt),[FE_maxNipNeighbors,FE_Ngeomtypes]) + + integer(pInt), dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & + parameter, private :: FE_face = & !< List of node indices on each face of a specific type of element geometry + reshape(int([& + 1,2,0,0 , & ! element 6 (2D 3node 1ip) + 2,3,0,0 , & + 3,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 125 (2D 6node 3ip) + 2,3,0,0 , & + 3,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 11 (2D 4node 4ip) + 2,3,0,0 , & + 3,4,0,0 , & + 4,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 27 (2D 8node 9ip) + 2,3,0,0 , & + 3,4,0,0 , & + 4,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 134 (3D 4node 1ip) + 1,4,2,0 , & + 2,3,4,0 , & + 1,3,4,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 127 (3D 10node 4ip) + 1,4,2,0 , & + 2,4,3,0 , & + 1,3,4,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 136 (3D 6node 6ip) + 1,4,5,2 , & + 2,5,6,3 , & + 1,3,6,4 , & + 4,6,5,0 , & + 0,0,0,0 , & + 1,2,3,4 , & ! element 117 (3D 8node 1ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 , & + 1,2,3,4 , & ! element 7 (3D 8node 8ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 , & + 1,2,3,4 , & ! element 21 (3D 20node 27ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 & + ],pInt),[FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes]) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type + int([ & + 3, & ! element 6 (2D 3node 1ip) + 7, & ! element 125 (2D 6node 3ip) + 9, & ! element 11 (2D 4node 4ip) + 16, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 15, & ! element 127 (3D 10node 4ip) + 21, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 27, & ! element 7 (3D 8node 8ip) + 64 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCell = & !< number of cell nodes in a specific cell type + int([ & + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 8 & ! (3D 8node) + ],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type + int([& + 2, & ! (2D 3node) + 2, & ! (2D 4node) + 3, & ! (3D 4node) + 4 & ! (3D 8node) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element + int([ & + 1, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 9, & ! element 27 (2D 8node 9ip) + 1, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 1, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 27 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + int([& + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 6 & ! (3D 8node) + ],pInt) + + + integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_maxNnodesAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element + int([ & + 3, & ! element 6 (2D 3node 1ip) + 1, & ! element 125 (2D 6node 3ip) + 1, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 1, & ! element 127 (3D 10node 4ip) + 1, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 1, & ! element 7 (3D 8node 8ip) + 4 & ! element 21 (3D 20node 27ip) + ],pInt) + +#if defined(Spectral) + integer(pInt), dimension(3), public, protected :: & + grid !< (global) grid + integer(pInt), public, protected :: & + mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh + grid3, & !< (local) grid in 3rd direction + grid3Offset !< (local) grid offset in 3rd direction + real(pReal), dimension(3), public, protected :: & + geomSize + real(pReal), public, protected :: & + size3, & !< (local) size in 3rd direction + size3offset !< (local) size offset in 3rd direction +#elif defined(Marc4DAMASK) || defined(Abaqus) + integer(pInt), private :: & + mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) + mesh_maxNnodes, & !< max number of nodes in any CP element + mesh_NelemSets + character(len=64), dimension(:), allocatable, private :: & + mesh_nameElemSet, & !< names of elementSet + mesh_nameMaterial, & !< names of material in solid section + mesh_mapMaterial !< name of elementSet for material + integer(pInt), dimension(:,:), allocatable, private :: & + mesh_mapElemSet !< list of elements in elementSet + integer(pInt), dimension(:,:), allocatable, target, private :: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] +#endif +#if defined(Marc4DAMASK) + integer(pInt), private :: & + MarcVersion, & !< Version of input file format (Marc only) + hypoelasticTableStyle, & !< Table style (Marc only) + initialcondTableStyle !< Table style (Marc only) + integer(pInt), dimension(:), allocatable, private :: & + Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) +#elif defined(Abaqus) + logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information +#endif + + public :: & + mesh_init, & + mesh_build_cellnodes, & + mesh_build_ipVolumes, & + mesh_build_ipCoordinates, & + mesh_cellCenterCoordinates, & + mesh_get_Ncellnodes, & + mesh_get_unitlength, & + mesh_get_nodeAtIP, & +#if defined(Spectral) + mesh_spectral_getGrid, & + mesh_spectral_getSize +#elif defined(Marc4DAMASK) || defined(Abaqus) + mesh_FEasCP +#endif + + private :: & + mesh_get_damaskOptions, & + mesh_build_cellconnectivity, & + mesh_build_ipAreas, & + mesh_tell_statistics, & + FE_mapElemtype, & + mesh_faceMatch, & + mesh_build_FEdata, & +#if defined(Spectral) + mesh_spectral_getHomogenization, & + mesh_spectral_count, & + mesh_spectral_count_cpSizes, & + mesh_spectral_build_nodes, & + mesh_spectral_build_elements, & + mesh_spectral_build_ipNeighborhood +#elif defined(Marc4DAMASK) || defined(Abaqus) + mesh_build_nodeTwins, & + mesh_build_sharedElems, & + mesh_build_ipNeighborhood, & +#endif +#if defined(Marc4DAMASK) + mesh_marc_get_fileFormat, & + mesh_marc_get_tableStyles, & + mesh_marc_get_matNumber, & + mesh_marc_count_nodesAndElements, & + mesh_marc_count_elementSets, & + mesh_marc_map_elementSets, & + mesh_marc_count_cpElements, & + mesh_marc_map_Elements, & + mesh_marc_map_nodes, & + mesh_marc_build_nodes, & + mesh_marc_count_cpSizes, & + mesh_marc_build_elements +#elif defined(Abaqus) + mesh_abaqus_count_nodesAndElements, & + mesh_abaqus_count_elementSets, & + mesh_abaqus_count_materials, & + mesh_abaqus_map_elementSets, & + mesh_abaqus_map_materials, & + mesh_abaqus_count_cpElements, & + mesh_abaqus_map_elements, & + mesh_abaqus_map_nodes, & + mesh_abaqus_build_nodes, & + mesh_abaqus_count_cpSizes, & + mesh_abaqus_build_elements +#endif + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes the mesh by calling all necessary private routines the mesh module +!! Order and routines strongly depend on type of solver +!-------------------------------------------------------------------------------------------------- +subroutine mesh_init(ip,el) +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif +#ifdef Spectral +#include + use PETScsys +#endif + use DAMASK_interface + use IO, only: & +#ifdef Abaqus + IO_abaqus_hasNoPart, & +#endif +#ifdef Spectral + IO_open_file, & + IO_error, & +#else + IO_open_InputFile, & +#endif + IO_timeStamp, & + IO_error, & + IO_write_jobFile + use debug, only: & + debug_e, & + debug_i, & + debug_level, & + debug_mesh, & + debug_levelBasic + use numerics, only: & + usePingPong, & + numerics_unitlength, & + worldrank + use FEsolving, only: & +#ifndef Spectral + modelName, & + calcMode, & +#endif + FEsolving_execElem, & + FEsolving_execIP + + implicit none +#ifdef Spectral + include 'fftw3-mpi.f03' + integer(C_INTPTR_T) :: devNull, local_K, local_K_offset + integer :: ierr, worldsize +#endif + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt), intent(in), optional :: el, ip + integer(pInt) :: j + logical :: myDebug + + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + + call mesh_build_FEdata ! get properties of the different types of elements + mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh + + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) + +#ifdef Spectral + call fftw_mpi_init() + call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... + if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) + grid = mesh_spectral_getGrid(fileUnit) + call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') + if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') + + geomSize = mesh_spectral_getSize(fileUnit) + devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & + int(grid(2),C_INTPTR_T), & + int(grid(1),C_INTPTR_T)/2+1, & + PETSC_COMM_WORLD, & + local_K, & ! domain grid size along z + local_K_offset) ! domain grid offset along z + grid3 = int(local_K,pInt) + grid3Offset = int(local_K_offset,pInt) + size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) + size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) + if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) + call mesh_spectral_count() + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_spectral_count_cpSizes + if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) + call mesh_spectral_build_nodes() + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_spectral_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#elif defined Marc4DAMASK + call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... + if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) + call mesh_marc_get_fileFormat(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) + call mesh_marc_get_tableStyles(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) + if (MarcVersion > 12) then + call mesh_marc_get_matNumber(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) + endif + call mesh_marc_count_nodesAndElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_marc_count_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + call mesh_marc_map_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + call mesh_marc_count_cpElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + call mesh_marc_map_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + call mesh_marc_map_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + call mesh_marc_build_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_marc_count_cpSizes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + call mesh_marc_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#elif defined Abaqus + call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... + if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) + noPart = IO_abaqus_hasNoPart(FILEUNIT) + call mesh_abaqus_count_nodesAndElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_abaqus_count_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + call mesh_abaqus_count_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) + call mesh_abaqus_map_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + call mesh_abaqus_map_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) + call mesh_abaqus_count_cpElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + call mesh_abaqus_map_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + call mesh_abaqus_map_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + call mesh_abaqus_build_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_abaqus_count_cpSizes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + call mesh_abaqus_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#endif + + call mesh_get_damaskOptions(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + call mesh_build_cellconnectivity + if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) + mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) + if (myDebug) write(6,'(a)') ' Built cell nodes'; flush(6) + call mesh_build_ipCoordinates + if (myDebug) write(6,'(a)') ' Built IP coordinates'; flush(6) + call mesh_build_ipVolumes + if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) + call mesh_build_ipAreas + if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) + close (FILEUNIT) + +#if defined(Marc4DAMASK) || defined(Abaqus) + call mesh_build_nodeTwins + if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) + call mesh_build_sharedElems + if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) + call mesh_build_ipNeighborhood +#else + call mesh_spectral_build_ipNeighborhood +#endif + if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) + + if (worldrank == 0_pInt) then + call mesh_tell_statistics + endif + +#if defined(Marc4DAMASK) || defined(Abaqus) + if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & + call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements +#endif + if (debug_e < 1 .or. debug_e > mesh_NcpElems) & + call IO_error(602_pInt,ext_msg='element') ! selected element does not exist + if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & + call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP + + FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements + allocate(FEsolving_execIP(2_pInt,mesh_NcpElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... + forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element + +#if defined(Marc4DAMASK) || defined(Abaqus) + allocate(calcMode(mesh_maxNips,mesh_NcpElems)) + calcMode = .false. ! pretend to have collected what first call is asking (F = I) + calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" +#endif + +!!!! COMPATIBILITY HACK !!!! +! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. +! hence, xxPerElem instead of maxXX + mesh_NipsPerElem = mesh_maxNips + mesh_NcellnodesPerElem = mesh_maxNcellnodes +! better name + mesh_homogenizationAt = mesh_element(3,:) + mesh_microstructureAt = mesh_element(4,:) + mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) +!!!!!!!!!!!!!!!!!!!!!!!! + +end subroutine mesh_init + + +#if defined(Marc4DAMASK) || defined(Abaqus) +!-------------------------------------------------------------------------------------------------- +!> @brief Gives the FE to CP ID mapping by binary search through lookup array +!! valid questions (what) are 'elem', 'node' +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_FEasCP(what,myID) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),pInt) + + if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2_pInt,lower) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP +#endif + +!-------------------------------------------------------------------------------------------------- +!> @brief Split CP elements into cells. +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> all others (currently) might be stored more than once. +!> Also allocates the 'mesh_node' array. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_cellconnectivity + + implicit none + integer(pInt), dimension(:), allocatable :: & + matchingNode2cellnode + integer(pInt), dimension(:,:), allocatable :: & + cellnodeParent + integer(pInt), dimension(mesh_maxNcellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + e,t,g,c,n,i, & + matchingNodeID, & + localCellnodeID + + allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) + allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) + allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) + +!-------------------------------------------------------------------------------------------------- +! Count cell nodes (including duplicates) and generate cell connectivity list + mesh_Ncellnodes = 0_pInt + mesh_Ncells = 0_pInt + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + localCellnode2globalCellnode = 0_pInt + mesh_Ncells = mesh_Ncells + FE_Nips(g) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + localCellnodeID = FE_cell(n,i,g) + if (localCellnodeID <= FE_NmatchingNodes(g)) then ! this cell node is a matching node + matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) + if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) + else ! this cell node is no matching node + if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) + endif + enddo + enddo + enddo + + allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + forall(n = 1_pInt:mesh_Ncellnodes) + mesh_cellnodeParent(1,n) = cellnodeParent(1,n) + mesh_cellnodeParent(2,n) = cellnodeParent(2,n) + endforall + +end subroutine mesh_build_cellconnectivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate position of cellnodes from the given position of nodes +!> Build list of cellnodes' coordinates. +!> Cellnode coordinates are calculated from a weighted sum of node coordinates. +!-------------------------------------------------------------------------------------------------- +function mesh_build_cellnodes(nodes,Ncellnodes) + + implicit none + integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes + real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes + real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes + + integer(pInt) :: & + e,t,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) + do n = 1_pInt,Ncellnodes ! loop over cell nodes + e = mesh_cellnodeParent(1,n) + localCellnodeID = mesh_cellnodeParent(2,n) + t = mesh_element(2,e) ! get element type + myCoords = 0.0_pReal + do m = 1_pInt,FE_Nnodes(t) + myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + enddo +!$OMP END PARALLEL DO + +end function mesh_build_cellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipVolumes + use math, only: & + math_volTetrahedron, & + math_areaTriangle + + implicit none + integer(pInt) :: e,t,g,c,i,m,f,n + real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume + + if (.not. allocated(mesh_ipVolume)) then + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) + mesh_ipVolume = 0.0_pReal + endif + + !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + select case (c) + + case (1_pInt) ! 2D 3node + forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) + + case (2_pInt) ! 2D 4node + forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) & + + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e)), & + mesh_cellnode(1:3,mesh_cell(1,i,e))) + + case (3_pInt) ! 3D 4node + forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e))) + + case (4_pInt) ! 3D 8node + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + subvolume = 0.0_pReal + forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & + subvolume(n,f) = math_volTetrahedron(& + mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & + mesh_ipCoordinates(1:3,i,e)) + mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipCoordinates + + implicit none + integer(pInt) :: e,t,g,c,i,n + real(pReal), dimension(3) :: myCoords + + if (.not. allocated(mesh_ipCoordinates)) & + allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + myCoords = 0.0_pReal + 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 / real(FE_NcellnodesPerCell(c),pReal) + enddo + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), intent(in) :: el, & !< element number + ip !< integration point number + real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell + integer(pInt) :: t,g,c,n + + t = mesh_element(2_pInt,el) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + mesh_cellCenterCoordinates = 0.0_pReal + 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 / real(FE_NcellnodesPerCell(c),pReal) + + end function mesh_cellCenterCoordinates + + +#ifdef Spectral +!-------------------------------------------------------------------------------------------------- +!> @brief Reads grid information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +function mesh_spectral_getGrid(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_floatValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + integer(pInt), dimension(3) :: mesh_spectral_getGrid + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, j, myFileUnit + logical :: gotGrid = .false. + + mesh_spectral_getGrid = -1_pInt + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) + case ('grid') + gotGrid = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('a') + mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) + case('b') + mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) + case('c') + mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) + end select + enddo + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotGrid) & + call IO_error(error_ID = 845_pInt, ext_msg='grid') + if(any(mesh_spectral_getGrid < 1_pInt)) & + call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') + +end function mesh_spectral_getGrid + + +!-------------------------------------------------------------------------------------------------- +!> @brief Reads size information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +function mesh_spectral_getSize(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_floatValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + real(pReal), dimension(3) :: mesh_spectral_getSize + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, j, myFileUnit + logical :: gotSize = .false. + + mesh_spectral_getSize = -1.0_pReal + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) + case ('size') + gotSize = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('x') + mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) + case('y') + mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) + case('z') + mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) + end select + enddo + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotSize) & + call IO_error(error_ID = 845_pInt, ext_msg='size') + if (any(mesh_spectral_getSize<=0.0_pReal)) & + call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') + +end function mesh_spectral_getSize + + +!-------------------------------------------------------------------------------------------------- +!> @brief Reads homogenization information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_spectral_getHomogenization(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, myFileUnit + logical :: gotHomogenization = .false. + + mesh_spectral_getHomogenization = -1_pInt + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) + case ('homogenization') + gotHomogenization = .true. + mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotHomogenization ) & + call IO_error(error_ID = 845_pInt, ext_msg='homogenization') + if (mesh_spectral_getHomogenization<1_pInt) & + call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') + +end function mesh_spectral_getHomogenization + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores them in +!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_count() + + implicit none + + mesh_NcpElems= product(grid(1:2))*grid3 + mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) + + mesh_NcpElemsGlobal = product(grid) + +end subroutine mesh_spectral_count + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. +!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_count_cpSizes + + implicit none + integer(pInt) :: t,g,c + + t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element + g = FE_geomtype(t) + c = FE_celltype(g) + + mesh_maxNips = FE_Nips(g) + mesh_maxNipNeighbors = FE_NipNeighbors(c) + mesh_maxNcellnodes = FE_Ncellnodes(g) + +end subroutine mesh_spectral_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_nodes() + + implicit none + integer(pInt) :: n + + allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) + allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) + + forall (n = 0_pInt:mesh_Nnodes-1_pInt) + mesh_node0(1,n+1_pInt) = mesh_unitlength * & + geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & + / real(grid(1),pReal) + mesh_node0(2,n+1_pInt) = mesh_unitlength * & + geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) & + / real(grid(2),pReal) + mesh_node0(3,n+1_pInt) = mesh_unitlength * & + size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & + / real(grid3,pReal) + & + size3offset + end forall + + mesh_node = mesh_node0 + +end subroutine mesh_spectral_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, material, texture, and node list per element. +!! Allocates global array 'mesh_element' +!> @todo does the IO_error makes sense? +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_elements(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error, & + IO_continuousIntValues, & + IO_intValue, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: & + fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + e, i, & + headerLength = 0_pInt, & + maxDataPerLine, & + homog, & + elemType, & + elemOffset + integer(pInt), dimension(:), allocatable :: & + microstructures, & + microGlobal + integer(pInt), dimension(1,1) :: & + dummySet = 0_pInt + character(len=65536) :: & + line, & + keyword + character(len=64), dimension(1) :: & + dummyName = '' + + homog = mesh_spectral_getHomogenization(fileUnit) + +!-------------------------------------------------------------------------------------------------- +! get header length + call IO_checkAndRewind(fileUnit) + read(fileUnit,'(a65536)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') + endif + +!-------------------------------------------------------------------------------------------------- +! get maximum microstructure index + call IO_checkAndRewind(fileUnit) + do i = 1_pInt, headerLength + read(fileUnit,'(a65536)') line + enddo + + maxDataPerLine = 0_pInt + i = 1_pInt + + do while (i > 0_pInt) + i = IO_countContinuousIntValues(fileUnit) + maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? + enddo + allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) + allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size + allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) + +!-------------------------------------------------------------------------------------------------- +! read in microstructures + call IO_checkAndRewind(fileUnit) + do i=1_pInt,headerLength + read(fileUnit,'(a65536)') line + enddo + + e = 0_pInt + do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) + microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements + do i = 1_pInt,microstructures(1_pInt) + e = e+1_pInt ! valid element entry + microGlobal(e) = microstructures(1_pInt+i) + enddo + enddo + + elemType = FE_mapElemtype('C3D8R') + elemOffset = product(grid(1:2))*grid3Offset + e = 0_pInt + do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) + e = e+1_pInt ! valid element entry + mesh_element( 1,e) = -1_pInt ! DEPRECATED + mesh_element( 2,e) = elemType ! elem type + mesh_element( 3,e) = homog ! homogenization + mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure + mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & + ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node + mesh_element( 6,e) = mesh_element(5,e) + 1_pInt + mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt + mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt + mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node + mesh_element(10,e) = mesh_element(9,e) + 1_pInt + mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt + mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt + mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) + enddo + + if (e /= mesh_NcpElems) call IO_error(880_pInt,e) + +end subroutine mesh_spectral_build_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief build neighborhood relations for spectral +!> @details assign globals: mesh_ipNeighborhood +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_ipNeighborhood + + implicit none + integer(pInt) :: & + x,y,z, & + e + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) + + e = 0_pInt + do z = 0_pInt,grid3-1_pInt + do y = 0_pInt,grid(2)-1_pInt + do x = 0_pInt,grid(1)-1_pInt + e = e + 1_pInt + mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & + + y * grid(1) & + + modulo(x+1_pInt,grid(1)) & + + 1_pInt + mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & + + y * grid(1) & + + modulo(x-1_pInt,grid(1)) & + + 1_pInt + mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & + + modulo(y+1_pInt,grid(2)) * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & + + modulo(y-1_pInt,grid(2)) * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) & + + y * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) & + + y * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt + mesh_ipNeighborhood(3,1,1,e) = 2_pInt + mesh_ipNeighborhood(3,2,1,e) = 1_pInt + mesh_ipNeighborhood(3,3,1,e) = 4_pInt + mesh_ipNeighborhood(3,4,1,e) = 3_pInt + mesh_ipNeighborhood(3,5,1,e) = 6_pInt + mesh_ipNeighborhood(3,6,1,e) = 5_pInt + enddo + enddo + enddo + +end subroutine mesh_spectral_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) +!-------------------------------------------------------------------------------------------------- +function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) + use debug, only: & + debug_mesh, & + debug_level, & + debug_levelBasic + use math, only: & + math_mul33x3 + + implicit none + real(pReal), intent(in), dimension(:,:,:,:) :: & + centres + real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: & + nodes + real(pReal), intent(in), dimension(3) :: & + gDim + real(pReal), intent(in), dimension(3,3) :: & + Favg + real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: & + wrappedCentres + + integer(pInt) :: & + i,j,k,n + integer(pInt), dimension(3), parameter :: & + diag = 1_pInt + integer(pInt), dimension(3) :: & + shift = 0_pInt, & + lookup = 0_pInt, & + me = 0_pInt, & + iRes = 0_pInt + integer(pInt), dimension(3,8) :: & + neighbor = reshape([ & + 0_pInt, 0_pInt, 0_pInt, & + 1_pInt, 0_pInt, 0_pInt, & + 1_pInt, 1_pInt, 0_pInt, & + 0_pInt, 1_pInt, 0_pInt, & + 0_pInt, 0_pInt, 1_pInt, & + 1_pInt, 0_pInt, 1_pInt, & + 1_pInt, 1_pInt, 1_pInt, & + 0_pInt, 1_pInt, 1_pInt ], [3,8]) + +!-------------------------------------------------------------------------------------------------- +! initializing variables + iRes = [size(centres,2),size(centres,3),size(centres,4)] + nodes = 0.0_pReal + wrappedCentres = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! report + if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then + write(6,'(a)') ' Meshing cubes around centroids' + write(6,'(a,3(e12.5))') ' Dimension: ', gDim + write(6,'(a,3(i5))') ' Resolution:', iRes + endif + +!-------------------------------------------------------------------------------------------------- +! building wrappedCentres = centroids + ghosts + wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres + do k = 0_pInt,iRes(3)+1_pInt + do j = 0_pInt,iRes(2)+1_pInt + do i = 0_pInt,iRes(1)+1_pInt + if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin + j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin + i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin + me = [i,j,k] ! me on skin + shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me) + lookup = me-diag+shift*iRes + wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = & + centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) & + - math_mul33x3(Favg, real(shift,pReal)*gDim) + endif + enddo; enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! averaging + do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) + do n = 1_pInt,8_pInt + nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = & + nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), & + j+1_pInt+neighbor(2,n), & + k+1_pInt+neighbor(3,n) ) + enddo + enddo; enddo; enddo + nodes = nodes/8.0_pReal + +end function mesh_nodesAroundCentres +#endif + +#ifdef Marc4DAMASK +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out version of Marc input file format and stores ist as MarcVersion +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_fileFormat(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then + MarcVersion = IO_intValue(line,chunkPos,2_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_fileFormat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and +!! 'hypoelasticTableStyle' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_tableStyles(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + initialcondTableStyle = 0_pInt + hypoelasticTableStyle = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then + initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) + hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_tableStyles + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_matNumber(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i, j, data_blocks + character(len=300) line + +610 FORMAT(A300) + + rewind(fileUnit) + + data_blocks = 1_pInt + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + read (fileUnit,610,END=620) line + if (len(trim(line))/=0_pInt) then + chunkPos = IO_stringPos(line) + data_blocks = IO_intValue(line,chunkPos,1_pInt) + endif + allocate(Marc_matNumber(data_blocks)) + do i=1_pInt,data_blocks ! read all data blocks + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) + do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block + read (fileUnit,610,END=620) line + enddo + enddo + exit + endif + enddo + +620 end subroutine mesh_marc_get_matNumber + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores the numbers in +!! 'mesh_Nelems' and 'mesh_Nnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_nodesAndElements(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_IntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & + mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) + exit ! assumes that "coordinates" comes later in file + endif + enddo + +620 end subroutine mesh_marc_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- + subroutine mesh_marc_count_elementSets(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then + mesh_NelemSets = mesh_NelemSets + 1_pInt + mesh_maxNelemInSet = max(mesh_maxNelemInSet, & + IO_countContinuousIntValues(fileUnit)) + endif + enddo + +620 end subroutine mesh_marc_count_elementSets + + +!******************************************************************** +! map element sets +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!******************************************************************** +subroutine mesh_marc_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet = 0_pInt + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=640) line + chunkPos = IO_stringPos(line) + if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & + (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then + elemSet = elemSet+1_pInt + mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + mesh_mapElemSet(:,elemSet) = & + IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + endif + enddo + +640 end subroutine mesh_marc_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues, & + IO_error, & + IO_intValue, & + IO_countNumericalDataLines + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i + character(len=300):: line + + mesh_NcpElems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + if (MarcVersion < 13) then ! Marc 2016 or earlier + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines + read (fileUnit,610,END=620) line + enddo + mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update + exit + endif + enddo + else ! Marc2017 and later + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) + endif + endif + enddo + end if + +620 end subroutine mesh_marc_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line, & + tmp + + integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,cpElem = 0_pInt + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + +610 FORMAT(A300) + + contInts = 0_pInt + rewind(fileUnit) + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + if (MarcVersion < 13) then ! Marc 2016 or earlier + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines + read (fileUnit,610,END=660) line + enddo + contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& + mesh_mapElemSet,mesh_NelemSets) + exit + endif + else ! Marc2017 and later + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword + exit + else + contInts(1) = contInts(1) + 1_pInt + read (tmp,*) contInts(contInts(1)+1) + endif + enddo + endif + endif + endif + enddo +660 do i = 1_pInt,contInts(1) + cpElem = cpElem+1_pInt + mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) + mesh_mapFEtoCPelem(2,cpElem) = cpElem + enddo + +call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + +end subroutine mesh_marc_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt) :: i + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + +610 FORMAT(A300) + + node_count = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,610,END=650) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,610,END=650) line ! skip crap line + do i = 1_pInt,mesh_Nnodes + read (fileUnit,610,END=650) line + mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) + mesh_mapFEtoCPnode(2_pInt,i) = i + enddo + exit + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + +end subroutine mesh_marc_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_nodes(fileUnit) + + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue, & + IO_fixedNoEFloatValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=670) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,610,END=670) line ! skip crap line + do i=1_pInt,mesh_Nnodes + read (fileUnit,610,END=670) line + m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) + do j = 1_pInt,3_pInt + mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) + enddo + enddo + exit + endif + enddo + +670 mesh_node = mesh_node0 + +end subroutine mesh_marc_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_intValue, & + IO_skipChunks + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,t,g,e,c + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + +610 FORMAT(A300) + rewind(fileUnit) + do + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,610,END=630) line ! Garbage line + do i=1_pInt,mesh_Nelems ! read all elements + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) ! limit to id and type + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line + endif + enddo + exit + endif + enddo + +630 end subroutine mesh_marc_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per element. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_fixedNoEFloatValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead + + allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,610,END=620) line ! garbage line + do i = 1_pInt,mesh_Nelems + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then ! disregard non CP elems + mesh_element(1,e) = -1_pInt ! DEPRECATED + t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type + if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + call IO_error(191,el=t,ip=mesh_elemType) + mesh_elemType = t + mesh_element(2,e) = t + nNodesAlreadyRead = 0_pInt + do j = 1_pInt,chunkPos(1)-2_pInt + mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes + enddo + nNodesAlreadyRead = chunkPos(1) - 2_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + exit + endif + enddo + +620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" + read (fileUnit,610,END=620) line + do + chunkPos = IO_stringPos(line) + if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & + (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then + if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style + read (fileUnit,610,END=630) line ! read line with index of state var + chunkPos = IO_stringPos(line) + sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index + if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest + read (fileUnit,610,END=620) line ! read line with value of state var + chunkPos = IO_stringPos(line) + do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? + myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value + mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index + if (initialcondTableStyle == 2_pInt) then + read (fileUnit,610,END=630) line ! read extra line + read (fileUnit,610,END=630) line ! read extra line + endif + contInts = IO_continuousIntValues& ! get affected elements + (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + do i = 1_pInt,contInts(1) + e = mesh_FEasCP('elem',contInts(1_pInt+i)) + mesh_element(1_pInt+sv,e) = myVal + enddo + if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + enddo + endif + else + read (fileUnit,610,END=630) line + endif + enddo + +630 end subroutine mesh_marc_build_elements +#endif + +#ifdef Abaqus +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores them in +!! 'mesh_Nelems' and 'mesh_Nnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_nodesAndElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countDataLines, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical :: inPart + + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if (inPart .or. noPart) then + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) + case('*node') + if( & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & + ) & + mesh_Nnodes = mesh_Nnodes + IO_countDataLines(fileUnit) + case('*element') + if( & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & + ) then + mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) + endif + endselect + endif + enddo + +620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) + if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) + +end subroutine mesh_abaqus_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief count overall number of element sets in mesh and write 'mesh_NelemSets' and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical :: inPart + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & + mesh_NelemSets = mesh_NelemSets + 1_pInt + enddo + +620 continue + if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) + +end subroutine mesh_abaqus_count_elementSets + + +!-------------------------------------------------------------------------------------------------- +! count overall number of solid sections sets in mesh (Abaqus only) +! +! mesh_Nmaterials +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_materials(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical inPart + + mesh_Nmaterials = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. & + IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) & + mesh_Nmaterials = mesh_Nmaterials + 1_pInt + enddo + +620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) + +end subroutine mesh_abaqus_count_materials + + +!-------------------------------------------------------------------------------------------------- +! Build element set mapping +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet = 0_pInt,i + logical :: inPart = .false. + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + +610 FORMAT(A300) + + + rewind(fileUnit) + do + read (fileUnit,610,END=640) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) then + elemSet = elemSet + 1_pInt + mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'elset')) + mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& + mesh_mapElemSet,elemSet-1_pInt) + endif + enddo + +640 do i = 1_pInt,elemSet + if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) + enddo + +end subroutine mesh_abaqus_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +! map solid section (Abaqus only) +! +! allocate globals: mesh_nameMaterial, mesh_mapMaterial +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_materials(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt) :: i,c = 0_pInt + logical :: inPart = .false. + character(len=64) :: elemSetName,materialName + + allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' + allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. & + IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then + + elemSetName = '' + materialName = '' + + do i = 3_pInt,chunkPos(1_pInt) + if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset') /= '') & + elemSetName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset')) + if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material') /= '') & + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) + enddo + + if (elemSetName /= '' .and. materialName /= '') then + c = c + 1_pInt + mesh_nameMaterial(c) = materialName ! name of material used for this section + mesh_mapMaterial(c) = elemSetName ! mapped to respective element set + endif + endif + enddo + +620 if (c==0_pInt) call IO_error(error_ID=905_pInt) + do i=1_pInt,c + if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905_pInt) + enddo + + end subroutine mesh_abaqus_map_materials + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error, & + IO_extractValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + integer(pInt) :: i,k + logical :: materialFound = .false. + character(len=64) ::materialName,elemSetName + + mesh_NcpElems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if (IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then + do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (materialName == mesh_nameMaterial(i)) then ! found one + elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet + do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + if (elemSetName == mesh_nameElemSet(k)) & ! matched? + mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) + +end subroutine mesh_abaqus_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) ::i,j,k,cpElem = 0_pInt + logical :: materialFound = .false. + character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then + do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (materialName == mesh_nameMaterial(i)) then ! found one + elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet + do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + if (elemSetName == mesh_nameElemSet(k)) then ! matched? + do j = 1_pInt,mesh_mapElemSet(1,k) + cpElem = cpElem + 1_pInt + mesh_mapFEtoCPelem(1,cpElem) = mesh_mapElemSet(1_pInt+j,k) ! store FE id + mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id + enddo + endif + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + + if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) + +end subroutine mesh_abaqus_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countDataLines, & + IO_intValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt) :: i,c,cpNode = 0_pInt + logical :: inPart = .false. + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=650) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + c = IO_countDataLines(fileUnit) + do i = 1_pInt,c + backspace(fileUnit) + enddo + do i = 1_pInt,c + read (fileUnit,610,END=650) line + chunkPos = IO_stringPos(line) + cpNode = cpNode + 1_pInt + mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) + mesh_mapFEtoCPnode(2_pInt,cpNode) = cpNode + enddo + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + + if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) + +end subroutine mesh_abaqus_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_build_nodes(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_floatValue, & + IO_stringPos, & + IO_error, & + IO_countDataLines, & + IO_intValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m,c + logical :: inPart + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=670) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + c = IO_countDataLines(fileUnit) ! how many nodes are defined here? + do i = 1_pInt,c + backspace(fileUnit) ! rewind to first entry + enddo + do i = 1_pInt,c + read (fileUnit,610,END=670) line + chunkPos = IO_stringPos(line) + m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) + do j=1_pInt, 3_pInt + mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1_pInt) + enddo + enddo + endif + enddo + +670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) + mesh_node = mesh_node0 + +end subroutine mesh_abaqus_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue ,& + IO_error, & + IO_countDataLines, & + IO_intValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,c,t,g + logical :: inPart + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + endif + enddo + +620 end subroutine mesh_abaqus_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per elemen. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_extractValue, & + IO_floatValue, & + IO_countDataLines, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + + integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead + logical inPart,materialFound + character (len=64) :: materialName,elemSetName + character(len=300) :: line + + allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + c = IO_countDataLines(fileUnit) + do i = 1_pInt,c + backspace(fileUnit) + enddo + do i = 1_pInt,c + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) ! limit to 64 nodes max + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then ! disregard non CP elems + mesh_element(1,e) = -1_pInt ! DEPRECATED + if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + call IO_error(191,el=t,ip=mesh_elemType) + mesh_elemType = t + mesh_element(2,e) = t ! elem type + nNodesAlreadyRead = 0_pInt + do j = 1_pInt,chunkPos(1)-1_pInt + mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt+j)) ! put CP ids of nodes to position 5: + enddo + nNodesAlreadyRead = chunkPos(1) - 1_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + endif + enddo + + +620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" + + materialFound = .false. + do + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & + materialFound ) then + read (fileUnit,610,END=630) line ! read homogenization and microstructure + chunkPos = IO_stringPos(line) + homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) + micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) + do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (materialName == mesh_nameMaterial(i)) then ! found one + elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet + do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + if (elemSetName == mesh_nameElemSet(k)) then ! matched? + do j = 1_pInt,mesh_mapElemSet(1,k) + e = mesh_FEasCP('elem',mesh_mapElemSet(1+j,k)) + mesh_element(3,e) = homog ! store homogenization + mesh_element(4,e) = micro ! store microstructure + mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),homog) + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),micro) + enddo + endif + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +630 end subroutine mesh_abaqus_build_elements +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief get any additional damask options from input file, sets mesh_periodicSurface +!-------------------------------------------------------------------------------------------------- +subroutine mesh_get_damaskOptions(fileUnit) + +use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + +#ifdef Spectral + mesh_periodicSurface = .true. + + end subroutine mesh_get_damaskOptions + +#else + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) chunk, Nchunks + character(len=300) :: line, damaskOption, v + character(len=300) :: keyword + + mesh_periodicSurface = .false. +#ifdef Marc4DAMASK + keyword = '$damask' +#endif +#ifdef Abaqus + keyword = '**damask' +#endif + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + Nchunks = chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + select case(damaskOption) + case('periodic') ! damask Option that allows to specify periodic fluxes + do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) + v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? + mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' + mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' + mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' + enddo + endselect + endif + enddo + +610 FORMAT(A300) + +620 end subroutine mesh_get_damaskOptions +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipAreas + use math, only: & + math_crossproduct + + implicit none + integer(pInt) :: e,t,g,c,i,f,n,m + real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals + real(pReal), dimension(3) :: normal + + allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + select case (c) + + case (1_pInt,2_pInt) ! 2D 3 or 4 node + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + normal(1) = nodePos(2,2) - nodePos(2,1) ! x_normal = y_connectingVector + normal(2) = -(nodePos(1,2) - nodePos(1,1)) ! y_normal = -x_connectingVector + normal(3) = 0.0_pReal + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + enddo + enddo + + case (3_pInt) ! 3D 4node + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + normal = math_crossproduct(nodePos(1:3,2) - nodePos(1:3,1), & + nodePos(1:3,3) - nodePos(1:3,1)) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + enddo + enddo + + case (4_pInt) ! 3D 8node + ! for this cell type we get the normal of the quadrilateral face as an average of + ! four normals of triangular subfaces; since the face consists only of two triangles, + ! the sum has to be divided by two; this whole prcedure tries to compensate for + ! probable non-planar cell surfaces + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + normals(1:3,n) = 0.5_pReal & + * math_crossproduct(nodePos(1:3,1+mod(n ,m)) - nodePos(1:3,n), & + nodePos(1:3,1+mod(n+1,m)) - nodePos(1:3,n)) + normal = 0.5_pReal * sum(normals,2) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) + enddo + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipAreas + +#ifndef Spectral +!-------------------------------------------------------------------------------------------------- +!> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_nodeTwins + + implicit none + integer(pInt) dir, & ! direction of periodicity + node, & + minimumNode, & + maximumNode, & + n1, & + n2 + integer(pInt), dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes + real(pReal) minCoord, maxCoord, & ! extreme positions in one dimension + tolerance ! tolerance below which positions are assumed identical + real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates + logical, dimension(mesh_Nnodes) :: unpaired + + allocate(mesh_nodeTwins(3,mesh_Nnodes)) + mesh_nodeTwins = 0_pInt + + tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal + + do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z + if (mesh_periodicSurface(dir)) then ! only if periodicity is requested + + + !*** find out which nodes sit on the surface + !*** and have a minimum or maximum position in this dimension + + minimumNodes = 0_pInt + maximumNodes = 0_pInt + minCoord = minval(mesh_node0(dir,:)) + maxCoord = maxval(mesh_node0(dir,:)) + do node = 1_pInt,mesh_Nnodes ! loop through all nodes and find surface nodes + if (abs(mesh_node0(dir,node) - minCoord) <= tolerance) then + minimumNodes(1) = minimumNodes(1) + 1_pInt + minimumNodes(minimumNodes(1)+1_pInt) = node + elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then + maximumNodes(1) = maximumNodes(1) + 1_pInt + maximumNodes(maximumNodes(1)+1_pInt) = node + endif + enddo + + + !*** find the corresponding node on the other side with the same position in this dimension + + unpaired = .true. + do n1 = 1_pInt,minimumNodes(1) + minimumNode = minimumNodes(n1+1_pInt) + if (unpaired(minimumNode)) then + do n2 = 1_pInt,maximumNodes(1) + maximumNode = maximumNodes(n2+1_pInt) + distance = abs(mesh_node0(:,minimumNode) - mesh_node0(:,maximumNode)) + if (sum(distance) - distance(dir) <= tolerance) then ! minimum possible distance (within tolerance) + mesh_nodeTwins(dir,minimumNode) = maximumNode + mesh_nodeTwins(dir,maximumNode) = minimumNode + unpaired(maximumNode) = .false. ! remember this node, we don't have to look for his partner again + exit + endif + enddo + endif + enddo + + endif + enddo + +end subroutine mesh_build_nodeTwins + + +!-------------------------------------------------------------------------------------------------- +!> @brief get maximum count of shared elements among cpElements and build list of elements shared +!! by each node in mesh. Allocate globals '_maxNsharedElems' and '_sharedElem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_sharedElems + + implicit none + integer(pint) e, & ! element index + g, & ! element type + node, & ! CP node index + n, & ! node index per element + myDim, & ! dimension index + nodeTwin ! node twin in the specified dimension + integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt), dimension(:), allocatable :: node_seen + + allocate(node_seen(maxval(FE_NmatchingNodes))) + + node_count = 0_pInt + + do e = 1_pInt,mesh_NcpElems + g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + node_seen = 0_pInt ! reset node duplicates + do n = 1_pInt,FE_NmatchingNodes(g) ! check each node of element + node = mesh_element(4+n,e) + if (all(node_seen /= node)) then + node_count(node) = node_count(node) + 1_pInt ! if FE node not yet encountered -> count it + do myDim = 1_pInt,3_pInt ! check in each dimension... + nodeTwin = mesh_nodeTwins(myDim,node) + if (nodeTwin > 0_pInt) & ! if I am a twin of some node... + node_count(nodeTwin) = node_count(nodeTwin) + 1_pInt ! -> count me again for the twin node + enddo + endif + node_seen(n) = node ! remember this node to be counted already + enddo + enddo + + mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node + + allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) + + do e = 1_pInt,mesh_NcpElems + g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + node_seen = 0_pInt + do n = 1_pInt,FE_NmatchingNodes(g) + node = mesh_element(4_pInt+n,e) + if (all(node_seen /= node)) then + mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1_pInt ! count for each node the connected elements + mesh_sharedElem(mesh_sharedElem(1,node)+1_pInt,node) = e ! store the respective element id + do myDim = 1_pInt,3_pInt ! check in each dimension... + nodeTwin = mesh_nodeTwins(myDim,node) + if (nodeTwin > 0_pInt) then ! if i am a twin of some node... + mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1_pInt ! ...count me again for the twin + mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id + endif + enddo + endif + node_seen(n) = node + enddo + enddo + +end subroutine mesh_build_sharedElems + + +!-------------------------------------------------------------------------------------------------- +!> @brief build up of IP neighborhood, allocate globals '_ipNeighborhood' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipNeighborhood + use math, only: & + math_mul3x3 + + implicit none + integer(pInt) :: myElem, & ! my CP element index + myIP, & + myType, & ! my element type + myFace, & + neighbor, & ! neighor index + neighboringIPkey, & ! positive integer indicating the neighboring IP (for intra-element) and negative integer indicating the face towards neighbor (for neighboring element) + candidateIP, & + neighboringType, & ! element type of neighbor + NlinkedNodes, & ! number of linked nodes + twin_of_linkedNode, & ! node twin of a specific linkedNode + NmatchingNodes, & ! number of matching nodes + dir, & ! direction of periodicity + matchingElem, & ! CP elem number of matching element + matchingFace, & ! face ID of matching element + a, anchor, & + neighboringIP, & + neighboringElem, & + pointingToMe + integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & + linkedNodes = 0_pInt, & + matchingNodes + logical checkTwins + + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) + mesh_ipNeighborhood = 0_pInt + + + do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems + myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType + do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + + do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) + + !*** if the key is positive, the neighbor is inside the element + !*** that means, we have already found our neighboring IP + + if (neighboringIPkey > 0_pInt) then + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey + + + !*** if the key is negative, the neighbor resides in a neighboring element + !*** that means, we have to look through the face indicated by the key and see which element is behind that face + + elseif (neighboringIPkey < 0_pInt) then ! neighboring element's IP + myFace = -neighboringIPkey + call mesh_faceMatch(myElem, myFace, matchingElem, matchingFace) ! get face and CP elem id of face match + if (matchingElem > 0_pInt) then ! found match? + neighboringType = FE_geomtype(mesh_element(2,matchingElem)) + + !*** trivial solution if neighbor has only one IP + + if (FE_Nips(neighboringType) == 1_pInt) then + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt + cycle + endif + + !*** find those nodes which build the link to the neighbor + + NlinkedNodes = 0_pInt + linkedNodes = 0_pInt + do a = 1_pInt,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face + anchor = FE_nodesAtIP(a,myIP,myType) + if (anchor /= 0_pInt) then ! valid anchor node + if (any(FE_face(:,myFace,myType) == anchor)) then ! ip anchor sits on face? + NlinkedNodes = NlinkedNodes + 1_pInt + linkedNodes(NlinkedNodes) = mesh_element(4_pInt+anchor,myElem) ! CP id of anchor node + else ! something went wrong with the linkage, since not all anchors sit on my face + NlinkedNodes = 0_pInt + linkedNodes = 0_pInt + exit + endif + endif + enddo + + !*** loop through the ips of my neighbor + !*** and try to find an ip with matching nodes + !*** also try to match with node twins + + checkCandidateIP: do candidateIP = 1_pInt,FE_Nips(neighboringType) + NmatchingNodes = 0_pInt + matchingNodes = 0_pInt + do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip + anchor = FE_nodesAtIP(a,candidateIP,neighboringType) + if (anchor /= 0_pInt) then ! valid anchor node + if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? + NmatchingNodes = NmatchingNodes + 1_pInt + matchingNodes(NmatchingNodes) = mesh_element(4+anchor,matchingElem) ! CP id of neighbor's anchor node + else ! no matching, because not all nodes sit on the matching face + NmatchingNodes = 0_pInt + matchingNodes = 0_pInt + exit + endif + endif + enddo + + if (NmatchingNodes /= NlinkedNodes) & ! this ip has wrong count of anchors on face + cycle checkCandidateIP + + !*** check "normal" nodes whether they match or not + + checkTwins = .false. + do a = 1_pInt,NlinkedNodes + if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode + checkTwins = .true. + exit ! no need to search further + endif + enddo + + !*** if no match found, then also check node twins + + if(checkTwins) then + dir = int(maxloc(abs(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem)),1),pInt) ! check for twins only in direction of the surface normal + do a = 1_pInt,NlinkedNodes + twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) + if (twin_of_linkedNode == 0_pInt .or. & ! twin of linkedNode does not exist... + all(matchingNodes /= twin_of_linkedNode)) then ! ... or it does not match any matchingNode + cycle checkCandidateIP ! ... then check next candidateIP + endif + enddo + endif + + !*** we found a match !!! + + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = candidateIP + exit checkCandidateIP + enddo checkCandidateIP + endif ! end of valid external matching + endif ! end of internal/external matching + enddo + enddo + enddo + do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems + myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType + do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + neighboringElem = mesh_ipNeighborhood(1,neighbor,myIP,myElem) + neighboringIP = mesh_ipNeighborhood(2,neighbor,myIP,myElem) + if (neighboringElem > 0_pInt .and. neighboringIP > 0_pInt) then ! if neighbor exists ... + neighboringType = FE_geomtype(mesh_element(2,neighboringElem)) + do pointingToMe = 1_pInt,FE_NipNeighbors(FE_celltype(neighboringType)) ! find neighboring index that points from my neighbor to myself + if ( myElem == mesh_ipNeighborhood(1,pointingToMe,neighboringIP,neighboringElem) & + .and. myIP == mesh_ipNeighborhood(2,pointingToMe,neighboringIP,neighboringElem)) then ! possible candidate + if (math_mul3x3(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem),& + mesh_ipAreaNormal(1:3,pointingToMe,neighboringIP,neighboringElem)) < 0.0_pReal) then ! area normals have opposite orientation (we have to check that because of special case for single element with two ips and periodicity. In this case the neighbor is identical in two different directions.) + mesh_ipNeighborhood(3,neighbor,myIP,myElem) = pointingToMe ! found match + exit ! so no need to search further + endif + endif + enddo + endif + enddo + enddo + enddo + +end subroutine mesh_build_ipNeighborhood +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief write statistics regarding input file parsing to the output file +!-------------------------------------------------------------------------------------------------- +subroutine mesh_tell_statistics + use math, only: & + math_range + use IO, only: & + IO_error + use debug, only: & + debug_level, & + debug_MESH, & + debug_LEVELBASIC, & + debug_LEVELEXTENSIVE, & + debug_LEVELSELECTIVE, & + debug_e, & + debug_i + + implicit none + integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro + character(len=64) :: myFmt + integer(pInt) :: i,e,n,f,t,g,c, myDebug + + myDebug = debug_level(debug_mesh) + + if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified + if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified + + allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) + do e = 1_pInt,mesh_NcpElems + if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified + if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified + mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & + mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure + enddo +!$OMP CRITICAL (write2out) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) then + write(6,'(/,a,/)') ' Input Parser: STATISTICS' + write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' + write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' + write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' + write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' + write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' + write(6,*) + write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' + write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) + write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' + do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations + write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures + enddo + write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' + write(6,*) 'periodic surface : ', mesh_periodicSurface + write(6,*) + flush(6) + endif + + if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then + write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' + write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + t = mesh_element(2,e) ! get elemType + g = FE_geomtype(t) ! get elemGeomType + c = FE_celltype(g) ! get cellType + write(6,'(i8,3(1x,i8))') e,t,g,c + enddo + write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' + write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) + write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + t = mesh_element(2,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + do i = 1_pInt,FE_Nips(g) + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) + do f = 1_pInt,FE_NipNeighbors(c) + write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) + enddo + enddo + enddo + write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' + write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + t = mesh_element(2,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i2)') e,i + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell + write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & + mesh_cellnode(1:3,mesh_cell(n,i,e)) + enddo + enddo + enddo + write(6,'(/,a)') 'Input Parser: IP COORDINATES' + write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) + enddo + enddo +#ifndef Spectral + write(6,'(/,a,/)') 'Input Parser: NODE TWINS' + write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' + do n = 1_pInt,mesh_Nnodes ! loop over cpNodes + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle + write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) + enddo +#endif + write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' + write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + t = mesh_element(2,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP + write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) + enddo + enddo + enddo + endif +!$OMP END CRITICAL (write2out) + +end subroutine mesh_tell_statistics + + +!-------------------------------------------------------------------------------------------------- +!> @brief mapping of FE element types to internal representation +!-------------------------------------------------------------------------------------------------- +integer(pInt) function FE_mapElemtype(what) + use IO, only: IO_lc, IO_error + + implicit none + character(len=*), intent(in) :: what + + select case (IO_lc(what)) + case ( '6') + FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle + case ( '155', & + '125', & + '128') + FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) + case ( '11', & + 'cpe4', & + 'cpe4t') + FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + case ( '27', & + 'cpe8', & + 'cpe8t') + FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + case ( '54') + FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration + case ( '134', & + 'c3d4', & + 'c3d4t') + FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + case ( '157') + FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations + case ( '127') + FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron + case ( '136', & + 'c3d6', & + 'c3d6t') + FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( '117', & + '123', & + 'c3d8r', & + 'c3d8rt') + FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + case ( '7', & + 'c3d8', & + 'c3d8t') + FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + case ( '57', & + 'c3d20r', & + 'c3d20rt') + FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + case ( '21', & + 'c3d20', & + 'c3d20t') + FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + case default + call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + end select + +end function FE_mapElemtype + + +!-------------------------------------------------------------------------------------------------- +!> @brief find face-matching element of same type +!-------------------------------------------------------------------------------------------------- +subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) + +implicit none +integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID + matchingFace ! matching face ID +integer(pInt), intent(in) :: face, & ! face ID + elem ! CP elem ID +integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & + myFaceNodes ! global node ids on my face +integer(pInt) :: myType, & + candidateType, & + candidateElem, & + candidateFace, & + candidateFaceNode, & + minNsharedElems, & + NsharedElems, & + lonelyNode = 0_pInt, & + i, & + n, & + dir ! periodicity direction +integer(pInt), dimension(:), allocatable :: element_seen +logical checkTwins + +matchingElem = 0_pInt +matchingFace = 0_pInt +minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case +myType = FE_geomtype(mesh_element(2_pInt,elem)) ! figure elemGeomType + +do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face + myFaceNodes(n) = mesh_element(4_pInt+FE_face(n,face,myType),elem) ! CP id of face node + NsharedElems = mesh_sharedElem(1_pInt,myFaceNodes(n)) ! figure # shared elements for this node + if (NsharedElems < minNsharedElems) then + minNsharedElems = NsharedElems ! remember min # shared elems + lonelyNode = n ! remember most lonely node + endif +enddo + +allocate(element_seen(minNsharedElems)) +element_seen = 0_pInt + +checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements + candidateElem = mesh_sharedElem(1_pInt+i,myFaceNodes(lonelyNode)) ! present candidate elem + if (all(element_seen /= candidateElem)) then ! element seen for the first time? + element_seen(i) = candidateElem + candidateType = FE_geomtype(mesh_element(2_pInt,candidateElem)) ! figure elemGeomType of candidate +checkCandidateFace: do candidateFace = 1_pInt,FE_maxNipNeighbors ! check each face of candidate + if (FE_NmatchingNodesPerFace(candidateFace,candidateType) & + /= FE_NmatchingNodesPerFace(face,myType) & ! incompatible face + .or. (candidateElem == elem .and. candidateFace == face)) then ! this is my face + cycle checkCandidateFace + endif + checkTwins = .false. + do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face + candidateFaceNode = mesh_element(4_pInt+FE_face(n,candidateFace,candidateType),candidateElem) + if (all(myFaceNodes /= candidateFaceNode)) then ! candidate node does not match any of my face nodes + checkTwins = .true. ! perhaps the twin nodes do match + exit + endif + enddo + if(checkTwins) then +checkCandidateFaceTwins: do dir = 1_pInt,3_pInt + do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face + candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) + if (all(myFaceNodes /= mesh_nodeTwins(dir,candidateFaceNode))) then ! node twin does not match either + if (dir == 3_pInt) then + cycle checkCandidateFace + else + cycle checkCandidateFaceTwins ! try twins in next dimension + endif + endif + enddo + exit checkCandidateFaceTwins + enddo checkCandidateFaceTwins + endif + matchingFace = candidateFace + matchingElem = candidateElem + exit checkCandidate ! found my matching candidate + enddo checkCandidateFace + endif +enddo checkCandidate + +end subroutine mesh_faceMatch + + +!-------------------------------------------------------------------------------------------------- +!> @brief get properties of different types of finite elements +!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_FEdata + + implicit none + integer(pInt) :: me + allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_cellnodeParentnodeWeights(FE_maxNnodes,FE_maxNcellnodes,FE_Nelemtypes), source=0.0_pReal) + allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) + + + !*** fill FE_nodesAtIP with data *** + + me = 0_pInt + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + 1,2,3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, & + 2, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, & + 2, & + 4, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 1,0, & + 1,2, & + 2,0, & + 1,4, & + 0,0, & + 2,3, & + 4,0, & + 3,4, & + 3,0 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + 1,2,3,4 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + reshape(int([& + 1, & + 2, & + 3, & + 4 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + reshape(int([& + 1, & + 2, & + 3, & + 4, & + 5, & + 6 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + 1,2,3,4,5,6,7,8 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + reshape(int([& + 1, & + 2, & + 4, & + 3, & + 5, & + 6, & + 8, & + 7 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + reshape(int([& + 1,0, 0,0, & + 1,2, 0,0, & + 2,0, 0,0, & + 1,4, 0,0, & + 1,3, 2,4, & + 2,3, 0,0, & + 4,0, 0,0, & + 3,4, 0,0, & + 3,0, 0,0, & + 1,5, 0,0, & + 1,6, 2,5, & + 2,6, 0,0, & + 1,8, 4,5, & + 0,0, 0,0, & + 2,7, 3,6, & + 4,8, 0,0, & + 3,8, 4,7, & + 3,7, 0,0, & + 5,0, 0,0, & + 5,6, 0,0, & + 6,0, 0,0, & + 5,8, 0,0, & + 5,7, 6,8, & + 6,7, 0,0, & + 8,0, 0,0, & + 7,8, 0,0, & + 7,0, 0,0 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + + ! *** FE_ipNeighbor *** + ! is a list of the neighborhood of each IP. + ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. + ! Positive integers denote an intra-FE IP identifier. + ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. + me = 0_pInt + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + -2,-3,-1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 2,-3, 3,-1, & + -2, 1, 3,-1, & + 2,-3,-2, 1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 2,-4, 3,-1, & + -2, 1, 4,-1, & + 4,-4,-3, 1, & + -2, 3,-3, 2 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 2,-4, 4,-1, & + 3, 1, 5,-1, & + -2, 2, 6,-1, & + 5,-4, 7, 1, & + 6, 4, 8, 2, & + -2, 5, 9, 3, & + 8,-4,-3, 4, & + 9, 7,-3, 5, & + -2, 8,-3, 6 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + -1,-2,-3,-4 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + reshape(int([& + 2,-4, 3,-2, 4,-1, & + -2, 1, 3,-2, 4,-1, & + 2,-4,-3, 1, 4,-1, & + 2,-4, 3,-2,-3, 1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + reshape(int([& + 2,-4, 3,-2, 4,-1, & + -3, 1, 3,-2, 5,-1, & + 2,-4,-3, 1, 6,-1, & + 5,-4, 6,-2,-5, 1, & + -3, 4, 6,-2,-5, 2, & + 5,-4,-3, 4,-5, 3 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + -3,-5,-4,-2,-6,-1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + reshape(int([& + 2,-5, 3,-2, 5,-1, & + -3, 1, 4,-2, 6,-1, & + 4,-5,-4, 1, 7,-1, & + -3, 3,-4, 2, 8,-1, & + 6,-5, 7,-2,-6, 1, & + -3, 5, 8,-2,-6, 2, & + 8,-5,-4, 5,-6, 3, & + -3, 7,-4, 6,-6, 4 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + reshape(int([& + 2,-5, 4,-2,10,-1, & + 3, 1, 5,-2,11,-1, & + -3, 2, 6,-2,12,-1, & + 5,-5, 7, 1,13,-1, & + 6, 4, 8, 2,14,-1, & + -3, 5, 9, 3,15,-1, & + 8,-5,-4, 4,16,-1, & + 9, 7,-4, 5,17,-1, & + -3, 8,-4, 6,18,-1, & + 11,-5,13,-2,19, 1, & + 12,10,14,-2,20, 2, & + -3,11,15,-2,21, 3, & + 14,-5,16,10,22, 4, & + 15,13,17,11,23, 5, & + -3,14,18,12,24, 6, & + 17,-5,-4,13,25, 7, & + 18,16,-4,14,26, 8, & + -3,17,-4,15,27, 9, & + 20,-5,22,-2,-6,10, & + 21,19,23,-2,-6,11, & + -3,20,24,-2,-6,12, & + 23,-5,25,19,-6,13, & + 24,22,26,20,-6,14, & + -3,23,27,21,-6,15, & + 26,-5,-4,22,-6,16, & + 27,25,-4,23,-6,17, & + -3,26,-4,24,-6,18 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cell *** + me = 0_pInt + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + 1,2,3 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, 4, 7, 6, & + 2, 5, 7, 4, & + 3, 6, 7, 5 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, 5, 9, 8, & + 5, 2, 6, 9, & + 8, 9, 7, 4, & + 9, 6, 3, 7 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 1, 5,13,12, & + 5, 6,14,13, & + 6, 2, 7,14, & + 12,13,16,11, & + 13,14,15,16, & + 14, 7, 8,15, & + 11,16,10, 4, & + 16,15, 9,10, & + 15, 8, 3, 9 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + 1, 2, 3, 4 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + reshape(int([& + 1, 5,11, 7, 8,12,15,14, & + 5, 2, 6,11,12, 9,13,15, & + 7,11, 6, 3,14,15,13,10, & + 8,12,15, 4, 4, 9,13,10 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + reshape(int([& + 1, 7,16, 9,10,17,21,19, & + 7, 2, 8,16,17,11,18,21, & + 9,16, 8, 3,19,21,18,12, & + 10,17,21,19, 4,13,20,15, & + 17,11,18,21,13, 5,14,20, & + 19,21,18,12,15,20,14, 6 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + 1, 2, 3, 4, 5, 6, 7, 8 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + reshape(int([& + 1, 9,21,12,13,22,27,25, & + 9, 2,10,21,22,14,23,27, & + 12,21,11, 4,25,27,24,16, & + 21,10, 3,11,27,23,15,24, & + 13,22,27,25, 5,17,26,20, & + 22,14,23,27,17, 6,18,26, & + 25,27,24,16,20,26,19, 8, & + 27,23,15,24,26,18, 7,19 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + reshape(int([& + 1, 9,33,16,17,37,57,44, & + 9,10,34,33,37,38,58,57, & + 10, 2,11,34,38,18,39,58, & + 16,33,36,15,44,57,60,43, & + 33,34,35,36,57,58,59,60, & + 34,11,12,35,58,39,40,59, & + 15,36,14, 4,43,60,42,20, & + 36,35,13,14,60,59,41,42, & + 35,12, 3,13,59,40,19,41, & + 17,37,57,44,21,45,61,52, & + 37,38,58,57,45,46,62,61, & + 38,18,39,58,46,22,47,62, & + 44,57,60,43,52,61,64,51, & + 57,58,59,60,61,62,63,64, & + 58,39,40,59,62,47,48,63, & + 43,60,42,20,51,64,50,24, & + 60,59,41,42,64,63,49,50, & + 59,40,19,41,63,48,23,49, & + 21,45,61,52, 5,25,53,32, & + 45,46,62,61,25,26,54,53, & + 46,22,47,62,26, 6,27,54, & + 52,61,64,51,32,53,56,31, & + 61,62,63,64,53,54,55,56, & + 62,47,48,63,54,27,28,55, & + 51,64,50,24,31,56,30, 8, & + 64,63,49,50,56,55,29,30, & + 63,48,23,49,55,28, 7,29 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cellnodeParentnodeWeights *** + ! center of gravity of the weighted nodes gives the position of the cell node. + ! fill with 0. + ! example: face-centered cell node with face nodes 1,2,5,6 to be used in, + ! e.g., an 8 node element, would be encoded: + ! 1, 1, 0, 0, 1, 1, 0, 0 + me = 0_pInt + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) + reshape(real([& + 1, 0, 0, & + 0, 1, 0, & + 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 2, 2, 2 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1, & + 1, 1, 0, 0, & + 0, 1, 1, 0, & + 0, 0, 1, 1, & + 1, 0, 0, 1, & + 1, 1, 1, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 27 (2D 8node 9ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 1, 0, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 0, 2, & + 1, 0, 0, 0, 0, 0, 0, 2, & + 4, 1, 1, 1, 8, 2, 2, 8, & + 1, 4, 1, 1, 8, 8, 2, 2, & + 1, 1, 4, 1, 2, 8, 8, 2, & + 1, 1, 1, 4, 2, 2, 8, 8 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 54 (2D 8node 4ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 1, 2, 2, 2, 2 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) + reshape(real([& + 1, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, & + 0, 0, 1, 0, 0, & + 0, 0, 0, 1, 0, & + 1, 1, 0, 0, 0, & + 0, 1, 1, 0, 0, & + 1, 0, 1, 0, 0, & + 1, 0, 0, 1, 0, & + 0, 1, 0, 1, 0, & + 0, 0, 1, 1, 0, & + 1, 1, 1, 0, 0, & + 1, 1, 0, 1, 0, & + 0, 1, 1, 1, 0, & + 1, 0, 1, 1, 0, & + 0, 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 127 (3D 10node 4ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & + 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & + 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & + 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & + 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 136 (3D 6node 6ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 0, 0, 0, 0, & + 0, 1, 1, 0, 0, 0, & + 1, 0, 1, 0, 0, 0, & + 1, 0, 0, 1, 0, 0, & + 0, 1, 0, 0, 1, 0, & + 0, 0, 1, 0, 0, 1, & + 0, 0, 0, 1, 1, 0, & + 0, 0, 0, 0, 1, 1, & + 0, 0, 0, 1, 0, 1, & + 1, 1, 1, 0, 0, 0, & + 1, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 1, & + 1, 0, 1, 1, 0, 1, & + 0, 0, 0, 1, 1, 1, & + 1, 1, 1, 1, 1, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, & ! + 1, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 1, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 1, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 1, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 1, & ! + 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, & ! + 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, & ! + 1, 1, 1, 1, 1, 1, 1, 1 & ! + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! + 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! + 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 + 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! + 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 + 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! + 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! + 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! + 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 + 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! + 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 + 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! + 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! + 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 + 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! + 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! + 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! + 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! + 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 + 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! + 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! + 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! + 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + + + ! *** FE_cellface *** + me = 0_pInt + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 3node, VTK_TRIANGLE (5) + reshape(int([& + 2,3, & + 3,1, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 4node, VTK_QUAD (9) + reshape(int([& + 2,3, & + 4,1, & + 3,4, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 4node, VTK_TETRA (10) + reshape(int([& + 1,3,2, & + 1,2,4, & + 2,3,4, & + 1,4,3 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 8node, VTK_HEXAHEDRON (12) + reshape(int([& + 2,3,7,6, & + 4,1,5,8, & + 3,4,8,7, & + 1,2,6,5, & + 5,6,7,8, & + 1,4,3,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + +end subroutine mesh_build_FEdata + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns global variable mesh_Ncellnodes +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_get_Ncellnodes() + + implicit none + + mesh_get_Ncellnodes = mesh_Ncellnodes + +end function mesh_get_Ncellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns global variable mesh_unitlength +!-------------------------------------------------------------------------------------------------- +real(pReal) function mesh_get_unitlength() + + implicit none + + mesh_get_unitlength = mesh_unitlength + +end function mesh_get_unitlength + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns node that is located at an ip +!> @details return zero if requested ip does not exist or not available (more ips than nodes) +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) + + implicit none + character(len=*), intent(in) :: elemtypeFE + integer(pInt), intent(in) :: ip + integer(pInt) :: elemtype + integer(pInt) :: geomtype + + mesh_get_nodeAtIP = 0_pInt + + elemtype = FE_mapElemtype(elemtypeFE) + geomtype = FE_geomtype(elemtype) + if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & + mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) + +end function mesh_get_nodeAtIP + + +end module mesh diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 new file mode 100644 index 000000000..e55165d51 --- /dev/null +++ b/src/mesh_marc.f90 @@ -0,0 +1,4280 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver +!-------------------------------------------------------------------------------------------------- +module mesh + use, intrinsic :: iso_c_binding + use prec, only: pReal, pInt + + implicit none + private + integer(pInt), public, protected :: & + mesh_NcpElems, & !< total number of CP elements in local mesh + mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes) + mesh_Nnodes, & !< total number of nodes in mesh + mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) + mesh_Ncells, & !< total number of cells in mesh + mesh_NipsPerElem, & !< number of IPs in per element + mesh_NcellnodesPerElem, & !< number of cell nodes per element + mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element + mesh_maxNsharedElems !< max number of CP elements sharing a node +!!!! BEGIN DEPRECATED !!!!! + integer(pInt), public, protected :: & + mesh_maxNips, & !< max number of IPs in any CP element + mesh_maxNcellnodes !< max number of cell nodes in any CP element +!!!! BEGIN DEPRECATED !!!!! + + integer(pInt), dimension(:), allocatable, public, protected :: & + mesh_homogenizationAt, & !< homogenization ID of each element + mesh_microstructureAt !< microstructure ID of each element + + integer(pInt), dimension(:,:), allocatable, public, protected :: & + mesh_CPnodeID, & !< nodes forming an element + mesh_element, & !DEPRECATED + mesh_sharedElem, & !< entryCount and list of elements containing node + mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) + + integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] + + real(pReal), public, protected :: & + mesh_unitlength !< physical length of one unit in mesh + + real(pReal), dimension(:,:), allocatable, public :: & + mesh_node, & !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + mesh_cellnode !< cell node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + + real(pReal), dimension(:,:), allocatable, public, protected :: & + mesh_ipVolume, & !< volume associated with IP (initially!) + mesh_node0 !< node x,y,z coordinates (initially!) + + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + mesh_ipArea !< area of interface to neighboring IP (initially!) + + real(pReal), dimension(:,:,:), allocatable, public :: & + mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) + + real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) + + logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) + +#if defined(Marc4DAMASK) || defined(Abaqus) + integer(pInt), private :: & + mesh_maxNelemInSet, & + mesh_Nmaterials +#endif + + integer(pInt), dimension(2), private :: & + mesh_maxValStateVar = 0_pInt + +integer(pInt), dimension(:,:), allocatable, private :: & + mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID + + integer(pInt),dimension(:,:,:), allocatable, private :: & + mesh_cell !< cell connectivity for each element,ip/cell + + integer(pInt), dimension(:,:,:), allocatable, private :: & + FE_nodesAtIP, & !< map IP index to node indices in a specific type of element + FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element + FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry + FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell + + real(pReal), dimension(:,:,:), allocatable, private :: & + FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes + + integer(pInt), dimension(:,:,:,:), allocatable, private :: & + FE_subNodeOnIPFace + +! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) +! Hence, I suggest to prefix with "FE_" + + integer(pInt), parameter, public :: & + FE_Nelemtypes = 13_pInt, & + FE_Ngeomtypes = 10_pInt, & + FE_Ncelltypes = 4_pInt, & + FE_maxNnodes = 20_pInt, & + FE_maxNips = 27_pInt, & + FE_maxNipNeighbors = 6_pInt, & + FE_maxmaxNnodesAtIP = 8_pInt, & !< max number of (equivalent) nodes attached to an IP + FE_maxNmatchingNodesPerFace = 4_pInt, & + FE_maxNfaces = 6_pInt, & + FE_maxNcellnodes = 64_pInt, & + FE_maxNcellnodesPerCell = 8_pInt, & + FE_maxNcellfaces = 6_pInt, & + FE_maxNcellnodesPerCellface = 4_pInt + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type + int([ & + 1, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 3, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 3, & ! element 54 (2D 8node 4ip) + 5, & ! element 134 (3D 4node 1ip) + 6, & ! element 157 (3D 5node 4ip) + 6, & ! element 127 (3D 10node 4ip) + 7, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 9, & ! element 7 (3D 8node 8ip) + 9, & ! element 57 (3D 20node 8ip) + 10 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type + int([ & + 1, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 4, & ! element 136 (3D 6node 6ip) + 4, & ! element 117 (3D 8node 1ip) + 4, & ! element 7 (3D 8node 8ip) + 4 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type + int([ & + 2, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 3, & ! element 127 (3D 10node 4ip) + 3, & ! element 136 (3D 6node 6ip) + 3, & ! element 117 (3D 8node 1ip) + 3, & ! element 7 (3D 8node 8ip) + 3 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element + int([ & + 3, & ! element 6 (2D 3node 1ip) + 6, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 8, & ! element 27 (2D 8node 9ip) + 8, & ! element 54 (2D 8node 4ip) + 4, & ! element 134 (3D 4node 1ip) + 5, & ! element 157 (3D 5node 4ip) + 10, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 20, & ! element 57 (3D 20node 8ip) + 20 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nfaces = & !< number of faces of a specific type of element geometry + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 5, & ! element 136 (3D 6node 6ip) + 6, & ! element 117 (3D 8node 1ip) + 6, & ! element 7 (3D 8node 8ip) + 6 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 8 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: & + FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry + reshape(int([ & + 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) + 2,2,2,0,0,0, & ! element 125 (2D 6node 3ip) + 2,2,2,2,0,0, & ! element 11 (2D 4node 4ip) + 2,2,2,2,0,0, & ! element 27 (2D 8node 9ip) + 3,3,3,3,0,0, & ! element 134 (3D 4node 1ip) + 3,3,3,3,0,0, & ! element 127 (3D 10node 4ip) + 3,4,4,4,3,0, & ! element 136 (3D 6node 6ip) + 4,4,4,4,4,4, & ! element 117 (3D 8node 1ip) + 4,4,4,4,4,4, & ! element 7 (3D 8node 8ip) + 4,4,4,4,4,4 & ! element 21 (3D 20node 27ip) + ],pInt),[FE_maxNipNeighbors,FE_Ngeomtypes]) + + integer(pInt), dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & + parameter, private :: FE_face = & !< List of node indices on each face of a specific type of element geometry + reshape(int([& + 1,2,0,0 , & ! element 6 (2D 3node 1ip) + 2,3,0,0 , & + 3,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 125 (2D 6node 3ip) + 2,3,0,0 , & + 3,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 11 (2D 4node 4ip) + 2,3,0,0 , & + 3,4,0,0 , & + 4,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 27 (2D 8node 9ip) + 2,3,0,0 , & + 3,4,0,0 , & + 4,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 134 (3D 4node 1ip) + 1,4,2,0 , & + 2,3,4,0 , & + 1,3,4,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 127 (3D 10node 4ip) + 1,4,2,0 , & + 2,4,3,0 , & + 1,3,4,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 136 (3D 6node 6ip) + 1,4,5,2 , & + 2,5,6,3 , & + 1,3,6,4 , & + 4,6,5,0 , & + 0,0,0,0 , & + 1,2,3,4 , & ! element 117 (3D 8node 1ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 , & + 1,2,3,4 , & ! element 7 (3D 8node 8ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 , & + 1,2,3,4 , & ! element 21 (3D 20node 27ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 & + ],pInt),[FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes]) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type + int([ & + 3, & ! element 6 (2D 3node 1ip) + 7, & ! element 125 (2D 6node 3ip) + 9, & ! element 11 (2D 4node 4ip) + 16, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 15, & ! element 127 (3D 10node 4ip) + 21, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 27, & ! element 7 (3D 8node 8ip) + 64 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCell = & !< number of cell nodes in a specific cell type + int([ & + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 8 & ! (3D 8node) + ],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type + int([& + 2, & ! (2D 3node) + 2, & ! (2D 4node) + 3, & ! (3D 4node) + 4 & ! (3D 8node) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element + int([ & + 1, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 9, & ! element 27 (2D 8node 9ip) + 1, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 1, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 27 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + int([& + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 6 & ! (3D 8node) + ],pInt) + + + integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_maxNnodesAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element + int([ & + 3, & ! element 6 (2D 3node 1ip) + 1, & ! element 125 (2D 6node 3ip) + 1, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 1, & ! element 127 (3D 10node 4ip) + 1, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 1, & ! element 7 (3D 8node 8ip) + 4 & ! element 21 (3D 20node 27ip) + ],pInt) + +#if defined(Spectral) + integer(pInt), dimension(3), public, protected :: & + grid !< (global) grid + integer(pInt), public, protected :: & + mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh + grid3, & !< (local) grid in 3rd direction + grid3Offset !< (local) grid offset in 3rd direction + real(pReal), dimension(3), public, protected :: & + geomSize + real(pReal), public, protected :: & + size3, & !< (local) size in 3rd direction + size3offset !< (local) size offset in 3rd direction +#elif defined(Marc4DAMASK) || defined(Abaqus) + integer(pInt), private :: & + mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) + mesh_maxNnodes, & !< max number of nodes in any CP element + mesh_NelemSets + character(len=64), dimension(:), allocatable, private :: & + mesh_nameElemSet, & !< names of elementSet + mesh_nameMaterial, & !< names of material in solid section + mesh_mapMaterial !< name of elementSet for material + integer(pInt), dimension(:,:), allocatable, private :: & + mesh_mapElemSet !< list of elements in elementSet + integer(pInt), dimension(:,:), allocatable, target, private :: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] +#endif +#if defined(Marc4DAMASK) + integer(pInt), private :: & + MarcVersion, & !< Version of input file format (Marc only) + hypoelasticTableStyle, & !< Table style (Marc only) + initialcondTableStyle !< Table style (Marc only) + integer(pInt), dimension(:), allocatable, private :: & + Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) +#elif defined(Abaqus) + logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information +#endif + + public :: & + mesh_init, & + mesh_build_cellnodes, & + mesh_build_ipVolumes, & + mesh_build_ipCoordinates, & + mesh_cellCenterCoordinates, & + mesh_get_Ncellnodes, & + mesh_get_unitlength, & + mesh_get_nodeAtIP, & +#if defined(Spectral) + mesh_spectral_getGrid, & + mesh_spectral_getSize +#elif defined(Marc4DAMASK) || defined(Abaqus) + mesh_FEasCP +#endif + + private :: & + mesh_get_damaskOptions, & + mesh_build_cellconnectivity, & + mesh_build_ipAreas, & + mesh_tell_statistics, & + FE_mapElemtype, & + mesh_faceMatch, & + mesh_build_FEdata, & +#if defined(Spectral) + mesh_spectral_getHomogenization, & + mesh_spectral_count, & + mesh_spectral_count_cpSizes, & + mesh_spectral_build_nodes, & + mesh_spectral_build_elements, & + mesh_spectral_build_ipNeighborhood +#elif defined(Marc4DAMASK) || defined(Abaqus) + mesh_build_nodeTwins, & + mesh_build_sharedElems, & + mesh_build_ipNeighborhood, & +#endif +#if defined(Marc4DAMASK) + mesh_marc_get_fileFormat, & + mesh_marc_get_tableStyles, & + mesh_marc_get_matNumber, & + mesh_marc_count_nodesAndElements, & + mesh_marc_count_elementSets, & + mesh_marc_map_elementSets, & + mesh_marc_count_cpElements, & + mesh_marc_map_Elements, & + mesh_marc_map_nodes, & + mesh_marc_build_nodes, & + mesh_marc_count_cpSizes, & + mesh_marc_build_elements +#elif defined(Abaqus) + mesh_abaqus_count_nodesAndElements, & + mesh_abaqus_count_elementSets, & + mesh_abaqus_count_materials, & + mesh_abaqus_map_elementSets, & + mesh_abaqus_map_materials, & + mesh_abaqus_count_cpElements, & + mesh_abaqus_map_elements, & + mesh_abaqus_map_nodes, & + mesh_abaqus_build_nodes, & + mesh_abaqus_count_cpSizes, & + mesh_abaqus_build_elements +#endif + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes the mesh by calling all necessary private routines the mesh module +!! Order and routines strongly depend on type of solver +!-------------------------------------------------------------------------------------------------- +subroutine mesh_init(ip,el) +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif +#ifdef Spectral +#include + use PETScsys +#endif + use DAMASK_interface + use IO, only: & +#ifdef Abaqus + IO_abaqus_hasNoPart, & +#endif +#ifdef Spectral + IO_open_file, & + IO_error, & +#else + IO_open_InputFile, & +#endif + IO_timeStamp, & + IO_error, & + IO_write_jobFile + use debug, only: & + debug_e, & + debug_i, & + debug_level, & + debug_mesh, & + debug_levelBasic + use numerics, only: & + usePingPong, & + numerics_unitlength, & + worldrank + use FEsolving, only: & +#ifndef Spectral + modelName, & + calcMode, & +#endif + FEsolving_execElem, & + FEsolving_execIP + + implicit none +#ifdef Spectral + include 'fftw3-mpi.f03' + integer(C_INTPTR_T) :: devNull, local_K, local_K_offset + integer :: ierr, worldsize +#endif + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt), intent(in), optional :: el, ip + integer(pInt) :: j + logical :: myDebug + + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + + call mesh_build_FEdata ! get properties of the different types of elements + mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh + + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) + +#ifdef Spectral + call fftw_mpi_init() + call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... + if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) + grid = mesh_spectral_getGrid(fileUnit) + call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') + if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') + + geomSize = mesh_spectral_getSize(fileUnit) + devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & + int(grid(2),C_INTPTR_T), & + int(grid(1),C_INTPTR_T)/2+1, & + PETSC_COMM_WORLD, & + local_K, & ! domain grid size along z + local_K_offset) ! domain grid offset along z + grid3 = int(local_K,pInt) + grid3Offset = int(local_K_offset,pInt) + size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) + size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) + if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) + call mesh_spectral_count() + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_spectral_count_cpSizes + if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) + call mesh_spectral_build_nodes() + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_spectral_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#elif defined Marc4DAMASK + call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... + if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) + call mesh_marc_get_fileFormat(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) + call mesh_marc_get_tableStyles(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) + if (MarcVersion > 12) then + call mesh_marc_get_matNumber(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) + endif + call mesh_marc_count_nodesAndElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_marc_count_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + call mesh_marc_map_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + call mesh_marc_count_cpElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + call mesh_marc_map_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + call mesh_marc_map_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + call mesh_marc_build_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_marc_count_cpSizes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + call mesh_marc_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#elif defined Abaqus + call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... + if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) + noPart = IO_abaqus_hasNoPart(FILEUNIT) + call mesh_abaqus_count_nodesAndElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_abaqus_count_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + call mesh_abaqus_count_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) + call mesh_abaqus_map_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + call mesh_abaqus_map_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) + call mesh_abaqus_count_cpElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + call mesh_abaqus_map_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + call mesh_abaqus_map_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + call mesh_abaqus_build_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_abaqus_count_cpSizes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + call mesh_abaqus_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) +#endif + + call mesh_get_damaskOptions(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + call mesh_build_cellconnectivity + if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) + mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) + if (myDebug) write(6,'(a)') ' Built cell nodes'; flush(6) + call mesh_build_ipCoordinates + if (myDebug) write(6,'(a)') ' Built IP coordinates'; flush(6) + call mesh_build_ipVolumes + if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) + call mesh_build_ipAreas + if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) + close (FILEUNIT) + +#if defined(Marc4DAMASK) || defined(Abaqus) + call mesh_build_nodeTwins + if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) + call mesh_build_sharedElems + if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) + call mesh_build_ipNeighborhood +#else + call mesh_spectral_build_ipNeighborhood +#endif + if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) + + if (worldrank == 0_pInt) then + call mesh_tell_statistics + endif + +#if defined(Marc4DAMASK) || defined(Abaqus) + if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & + call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements +#endif + if (debug_e < 1 .or. debug_e > mesh_NcpElems) & + call IO_error(602_pInt,ext_msg='element') ! selected element does not exist + if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & + call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP + + FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements + allocate(FEsolving_execIP(2_pInt,mesh_NcpElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... + forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element + +#if defined(Marc4DAMASK) || defined(Abaqus) + allocate(calcMode(mesh_maxNips,mesh_NcpElems)) + calcMode = .false. ! pretend to have collected what first call is asking (F = I) + calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" +#endif + +!!!! COMPATIBILITY HACK !!!! +! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. +! hence, xxPerElem instead of maxXX + mesh_NipsPerElem = mesh_maxNips + mesh_NcellnodesPerElem = mesh_maxNcellnodes +! better name + mesh_homogenizationAt = mesh_element(3,:) + mesh_microstructureAt = mesh_element(4,:) + mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) +!!!!!!!!!!!!!!!!!!!!!!!! + +end subroutine mesh_init + + +#if defined(Marc4DAMASK) || defined(Abaqus) +!-------------------------------------------------------------------------------------------------- +!> @brief Gives the FE to CP ID mapping by binary search through lookup array +!! valid questions (what) are 'elem', 'node' +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_FEasCP(what,myID) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),pInt) + + if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2_pInt,lower) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP +#endif + +!-------------------------------------------------------------------------------------------------- +!> @brief Split CP elements into cells. +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> all others (currently) might be stored more than once. +!> Also allocates the 'mesh_node' array. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_cellconnectivity + + implicit none + integer(pInt), dimension(:), allocatable :: & + matchingNode2cellnode + integer(pInt), dimension(:,:), allocatable :: & + cellnodeParent + integer(pInt), dimension(mesh_maxNcellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + e,t,g,c,n,i, & + matchingNodeID, & + localCellnodeID + + allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) + allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) + allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) + +!-------------------------------------------------------------------------------------------------- +! Count cell nodes (including duplicates) and generate cell connectivity list + mesh_Ncellnodes = 0_pInt + mesh_Ncells = 0_pInt + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + localCellnode2globalCellnode = 0_pInt + mesh_Ncells = mesh_Ncells + FE_Nips(g) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + localCellnodeID = FE_cell(n,i,g) + if (localCellnodeID <= FE_NmatchingNodes(g)) then ! this cell node is a matching node + matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) + if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) + else ! this cell node is no matching node + if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) + endif + enddo + enddo + enddo + + allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + forall(n = 1_pInt:mesh_Ncellnodes) + mesh_cellnodeParent(1,n) = cellnodeParent(1,n) + mesh_cellnodeParent(2,n) = cellnodeParent(2,n) + endforall + +end subroutine mesh_build_cellconnectivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate position of cellnodes from the given position of nodes +!> Build list of cellnodes' coordinates. +!> Cellnode coordinates are calculated from a weighted sum of node coordinates. +!-------------------------------------------------------------------------------------------------- +function mesh_build_cellnodes(nodes,Ncellnodes) + + implicit none + integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes + real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes + real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes + + integer(pInt) :: & + e,t,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) + do n = 1_pInt,Ncellnodes ! loop over cell nodes + e = mesh_cellnodeParent(1,n) + localCellnodeID = mesh_cellnodeParent(2,n) + t = mesh_element(2,e) ! get element type + myCoords = 0.0_pReal + do m = 1_pInt,FE_Nnodes(t) + myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + enddo +!$OMP END PARALLEL DO + +end function mesh_build_cellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipVolumes + use math, only: & + math_volTetrahedron, & + math_areaTriangle + + implicit none + integer(pInt) :: e,t,g,c,i,m,f,n + real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume + + if (.not. allocated(mesh_ipVolume)) then + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) + mesh_ipVolume = 0.0_pReal + endif + + !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + select case (c) + + case (1_pInt) ! 2D 3node + forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) + + case (2_pInt) ! 2D 4node + forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) & + + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e)), & + mesh_cellnode(1:3,mesh_cell(1,i,e))) + + case (3_pInt) ! 3D 4node + forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e))) + + case (4_pInt) ! 3D 8node + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + subvolume = 0.0_pReal + forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & + subvolume(n,f) = math_volTetrahedron(& + mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & + mesh_ipCoordinates(1:3,i,e)) + mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipCoordinates + + implicit none + integer(pInt) :: e,t,g,c,i,n + real(pReal), dimension(3) :: myCoords + + if (.not. allocated(mesh_ipCoordinates)) & + allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + myCoords = 0.0_pReal + 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 / real(FE_NcellnodesPerCell(c),pReal) + enddo + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), intent(in) :: el, & !< element number + ip !< integration point number + real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell + integer(pInt) :: t,g,c,n + + t = mesh_element(2_pInt,el) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + mesh_cellCenterCoordinates = 0.0_pReal + 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 / real(FE_NcellnodesPerCell(c),pReal) + + end function mesh_cellCenterCoordinates + + +#ifdef Spectral +!-------------------------------------------------------------------------------------------------- +!> @brief Reads grid information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +function mesh_spectral_getGrid(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_floatValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + integer(pInt), dimension(3) :: mesh_spectral_getGrid + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, j, myFileUnit + logical :: gotGrid = .false. + + mesh_spectral_getGrid = -1_pInt + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) + case ('grid') + gotGrid = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('a') + mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) + case('b') + mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) + case('c') + mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) + end select + enddo + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotGrid) & + call IO_error(error_ID = 845_pInt, ext_msg='grid') + if(any(mesh_spectral_getGrid < 1_pInt)) & + call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') + +end function mesh_spectral_getGrid + + +!-------------------------------------------------------------------------------------------------- +!> @brief Reads size information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +function mesh_spectral_getSize(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_floatValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + real(pReal), dimension(3) :: mesh_spectral_getSize + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, j, myFileUnit + logical :: gotSize = .false. + + mesh_spectral_getSize = -1.0_pReal + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) + case ('size') + gotSize = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('x') + mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) + case('y') + mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) + case('z') + mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) + end select + enddo + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotSize) & + call IO_error(error_ID = 845_pInt, ext_msg='size') + if (any(mesh_spectral_getSize<=0.0_pReal)) & + call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') + +end function mesh_spectral_getSize + + +!-------------------------------------------------------------------------------------------------- +!> @brief Reads homogenization information from geometry file. If fileUnit is given, +!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_spectral_getHomogenization(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_open_file, & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + integer(pInt), intent(in), optional :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: headerLength = 0_pInt + character(len=1024) :: line, & + keyword + integer(pInt) :: i, myFileUnit + logical :: gotHomogenization = .false. + + mesh_spectral_getHomogenization = -1_pInt + if(.not. present(fileUnit)) then + myFileUnit = 289_pInt + call IO_open_file(myFileUnit,trim(geometryFile)) + else + myFileUnit = fileUnit + endif + + call IO_checkAndRewind(myFileUnit) + + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') + endif + rewind(myFileUnit) + do i = 1_pInt, headerLength + read(myFileUnit,'(a1024)') line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) + case ('homogenization') + gotHomogenization = .true. + mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) + end select + enddo + + if(.not. present(fileUnit)) close(myFileUnit) + + if (.not. gotHomogenization ) & + call IO_error(error_ID = 845_pInt, ext_msg='homogenization') + if (mesh_spectral_getHomogenization<1_pInt) & + call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') + +end function mesh_spectral_getHomogenization + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores them in +!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_count() + + implicit none + + mesh_NcpElems= product(grid(1:2))*grid3 + mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) + + mesh_NcpElemsGlobal = product(grid) + +end subroutine mesh_spectral_count + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. +!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_count_cpSizes + + implicit none + integer(pInt) :: t,g,c + + t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element + g = FE_geomtype(t) + c = FE_celltype(g) + + mesh_maxNips = FE_Nips(g) + mesh_maxNipNeighbors = FE_NipNeighbors(c) + mesh_maxNcellnodes = FE_Ncellnodes(g) + +end subroutine mesh_spectral_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_nodes() + + implicit none + integer(pInt) :: n + + allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) + allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) + + forall (n = 0_pInt:mesh_Nnodes-1_pInt) + mesh_node0(1,n+1_pInt) = mesh_unitlength * & + geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & + / real(grid(1),pReal) + mesh_node0(2,n+1_pInt) = mesh_unitlength * & + geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) & + / real(grid(2),pReal) + mesh_node0(3,n+1_pInt) = mesh_unitlength * & + size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & + / real(grid3,pReal) + & + size3offset + end forall + + mesh_node = mesh_node0 + +end subroutine mesh_spectral_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, material, texture, and node list per element. +!! Allocates global array 'mesh_element' +!> @todo does the IO_error makes sense? +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_elements(fileUnit) + use IO, only: & + IO_checkAndRewind, & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error, & + IO_continuousIntValues, & + IO_intValue, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: & + fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + e, i, & + headerLength = 0_pInt, & + maxDataPerLine, & + homog, & + elemType, & + elemOffset + integer(pInt), dimension(:), allocatable :: & + microstructures, & + microGlobal + integer(pInt), dimension(1,1) :: & + dummySet = 0_pInt + character(len=65536) :: & + line, & + keyword + character(len=64), dimension(1) :: & + dummyName = '' + + homog = mesh_spectral_getHomogenization(fileUnit) + +!-------------------------------------------------------------------------------------------------- +! get header length + call IO_checkAndRewind(fileUnit) + read(fileUnit,'(a65536)') line + chunkPos = IO_stringPos(line) + keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) + if (keyword(1:4) == 'head') then + headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt + else + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') + endif + +!-------------------------------------------------------------------------------------------------- +! get maximum microstructure index + call IO_checkAndRewind(fileUnit) + do i = 1_pInt, headerLength + read(fileUnit,'(a65536)') line + enddo + + maxDataPerLine = 0_pInt + i = 1_pInt + + do while (i > 0_pInt) + i = IO_countContinuousIntValues(fileUnit) + maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? + enddo + allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) + allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size + allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) + +!-------------------------------------------------------------------------------------------------- +! read in microstructures + call IO_checkAndRewind(fileUnit) + do i=1_pInt,headerLength + read(fileUnit,'(a65536)') line + enddo + + e = 0_pInt + do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) + microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements + do i = 1_pInt,microstructures(1_pInt) + e = e+1_pInt ! valid element entry + microGlobal(e) = microstructures(1_pInt+i) + enddo + enddo + + elemType = FE_mapElemtype('C3D8R') + elemOffset = product(grid(1:2))*grid3Offset + e = 0_pInt + do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) + e = e+1_pInt ! valid element entry + mesh_element( 1,e) = -1_pInt ! DEPRECATED + mesh_element( 2,e) = elemType ! elem type + mesh_element( 3,e) = homog ! homogenization + mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure + mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & + ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node + mesh_element( 6,e) = mesh_element(5,e) + 1_pInt + mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt + mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt + mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node + mesh_element(10,e) = mesh_element(9,e) + 1_pInt + mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt + mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt + mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) + enddo + + if (e /= mesh_NcpElems) call IO_error(880_pInt,e) + +end subroutine mesh_spectral_build_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief build neighborhood relations for spectral +!> @details assign globals: mesh_ipNeighborhood +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_ipNeighborhood + + implicit none + integer(pInt) :: & + x,y,z, & + e + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) + + e = 0_pInt + do z = 0_pInt,grid3-1_pInt + do y = 0_pInt,grid(2)-1_pInt + do x = 0_pInt,grid(1)-1_pInt + e = e + 1_pInt + mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & + + y * grid(1) & + + modulo(x+1_pInt,grid(1)) & + + 1_pInt + mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & + + y * grid(1) & + + modulo(x-1_pInt,grid(1)) & + + 1_pInt + mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & + + modulo(y+1_pInt,grid(2)) * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & + + modulo(y-1_pInt,grid(2)) * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) & + + y * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) & + + y * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt + mesh_ipNeighborhood(3,1,1,e) = 2_pInt + mesh_ipNeighborhood(3,2,1,e) = 1_pInt + mesh_ipNeighborhood(3,3,1,e) = 4_pInt + mesh_ipNeighborhood(3,4,1,e) = 3_pInt + mesh_ipNeighborhood(3,5,1,e) = 6_pInt + mesh_ipNeighborhood(3,6,1,e) = 5_pInt + enddo + enddo + enddo + +end subroutine mesh_spectral_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) +!-------------------------------------------------------------------------------------------------- +function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) + use debug, only: & + debug_mesh, & + debug_level, & + debug_levelBasic + use math, only: & + math_mul33x3 + + implicit none + real(pReal), intent(in), dimension(:,:,:,:) :: & + centres + real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: & + nodes + real(pReal), intent(in), dimension(3) :: & + gDim + real(pReal), intent(in), dimension(3,3) :: & + Favg + real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: & + wrappedCentres + + integer(pInt) :: & + i,j,k,n + integer(pInt), dimension(3), parameter :: & + diag = 1_pInt + integer(pInt), dimension(3) :: & + shift = 0_pInt, & + lookup = 0_pInt, & + me = 0_pInt, & + iRes = 0_pInt + integer(pInt), dimension(3,8) :: & + neighbor = reshape([ & + 0_pInt, 0_pInt, 0_pInt, & + 1_pInt, 0_pInt, 0_pInt, & + 1_pInt, 1_pInt, 0_pInt, & + 0_pInt, 1_pInt, 0_pInt, & + 0_pInt, 0_pInt, 1_pInt, & + 1_pInt, 0_pInt, 1_pInt, & + 1_pInt, 1_pInt, 1_pInt, & + 0_pInt, 1_pInt, 1_pInt ], [3,8]) + +!-------------------------------------------------------------------------------------------------- +! initializing variables + iRes = [size(centres,2),size(centres,3),size(centres,4)] + nodes = 0.0_pReal + wrappedCentres = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! report + if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then + write(6,'(a)') ' Meshing cubes around centroids' + write(6,'(a,3(e12.5))') ' Dimension: ', gDim + write(6,'(a,3(i5))') ' Resolution:', iRes + endif + +!-------------------------------------------------------------------------------------------------- +! building wrappedCentres = centroids + ghosts + wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres + do k = 0_pInt,iRes(3)+1_pInt + do j = 0_pInt,iRes(2)+1_pInt + do i = 0_pInt,iRes(1)+1_pInt + if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin + j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin + i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin + me = [i,j,k] ! me on skin + shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me) + lookup = me-diag+shift*iRes + wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = & + centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) & + - math_mul33x3(Favg, real(shift,pReal)*gDim) + endif + enddo; enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! averaging + do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) + do n = 1_pInt,8_pInt + nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = & + nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), & + j+1_pInt+neighbor(2,n), & + k+1_pInt+neighbor(3,n) ) + enddo + enddo; enddo; enddo + nodes = nodes/8.0_pReal + +end function mesh_nodesAroundCentres +#endif + +#ifdef Marc4DAMASK +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out version of Marc input file format and stores ist as MarcVersion +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_fileFormat(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then + MarcVersion = IO_intValue(line,chunkPos,2_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_fileFormat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and +!! 'hypoelasticTableStyle' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_tableStyles(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + initialcondTableStyle = 0_pInt + hypoelasticTableStyle = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then + initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) + hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_tableStyles + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_matNumber(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i, j, data_blocks + character(len=300) line + +610 FORMAT(A300) + + rewind(fileUnit) + + data_blocks = 1_pInt + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + read (fileUnit,610,END=620) line + if (len(trim(line))/=0_pInt) then + chunkPos = IO_stringPos(line) + data_blocks = IO_intValue(line,chunkPos,1_pInt) + endif + allocate(Marc_matNumber(data_blocks)) + do i=1_pInt,data_blocks ! read all data blocks + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) + do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block + read (fileUnit,610,END=620) line + enddo + enddo + exit + endif + enddo + +620 end subroutine mesh_marc_get_matNumber + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores the numbers in +!! 'mesh_Nelems' and 'mesh_Nnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_nodesAndElements(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_IntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & + mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) + exit ! assumes that "coordinates" comes later in file + endif + enddo + +620 end subroutine mesh_marc_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- + subroutine mesh_marc_count_elementSets(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then + mesh_NelemSets = mesh_NelemSets + 1_pInt + mesh_maxNelemInSet = max(mesh_maxNelemInSet, & + IO_countContinuousIntValues(fileUnit)) + endif + enddo + +620 end subroutine mesh_marc_count_elementSets + + +!******************************************************************** +! map element sets +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!******************************************************************** +subroutine mesh_marc_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet = 0_pInt + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=640) line + chunkPos = IO_stringPos(line) + if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & + (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then + elemSet = elemSet+1_pInt + mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + mesh_mapElemSet(:,elemSet) = & + IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + endif + enddo + +640 end subroutine mesh_marc_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues, & + IO_error, & + IO_intValue, & + IO_countNumericalDataLines + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i + character(len=300):: line + + mesh_NcpElems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + if (MarcVersion < 13) then ! Marc 2016 or earlier + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines + read (fileUnit,610,END=620) line + enddo + mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update + exit + endif + enddo + else ! Marc2017 and later + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) + endif + endif + enddo + end if + +620 end subroutine mesh_marc_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line, & + tmp + + integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,cpElem = 0_pInt + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + +610 FORMAT(A300) + + contInts = 0_pInt + rewind(fileUnit) + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + if (MarcVersion < 13) then ! Marc 2016 or earlier + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines + read (fileUnit,610,END=660) line + enddo + contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& + mesh_mapElemSet,mesh_NelemSets) + exit + endif + else ! Marc2017 and later + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword + exit + else + contInts(1) = contInts(1) + 1_pInt + read (tmp,*) contInts(contInts(1)+1) + endif + enddo + endif + endif + endif + enddo +660 do i = 1_pInt,contInts(1) + cpElem = cpElem+1_pInt + mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) + mesh_mapFEtoCPelem(2,cpElem) = cpElem + enddo + +call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + +end subroutine mesh_marc_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt) :: i + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + +610 FORMAT(A300) + + node_count = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,610,END=650) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,610,END=650) line ! skip crap line + do i = 1_pInt,mesh_Nnodes + read (fileUnit,610,END=650) line + mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) + mesh_mapFEtoCPnode(2_pInt,i) = i + enddo + exit + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + +end subroutine mesh_marc_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_nodes(fileUnit) + + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue, & + IO_fixedNoEFloatValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=670) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,610,END=670) line ! skip crap line + do i=1_pInt,mesh_Nnodes + read (fileUnit,610,END=670) line + m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) + do j = 1_pInt,3_pInt + mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) + enddo + enddo + exit + endif + enddo + +670 mesh_node = mesh_node0 + +end subroutine mesh_marc_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_intValue, & + IO_skipChunks + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,t,g,e,c + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + +610 FORMAT(A300) + rewind(fileUnit) + do + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,610,END=630) line ! Garbage line + do i=1_pInt,mesh_Nelems ! read all elements + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) ! limit to id and type + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line + endif + enddo + exit + endif + enddo + +630 end subroutine mesh_marc_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per element. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_fixedNoEFloatValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead + + allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,610,END=620) line ! garbage line + do i = 1_pInt,mesh_Nelems + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then ! disregard non CP elems + mesh_element(1,e) = -1_pInt ! DEPRECATED + t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type + if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + call IO_error(191,el=t,ip=mesh_elemType) + mesh_elemType = t + mesh_element(2,e) = t + nNodesAlreadyRead = 0_pInt + do j = 1_pInt,chunkPos(1)-2_pInt + mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes + enddo + nNodesAlreadyRead = chunkPos(1) - 2_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + exit + endif + enddo + +620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" + read (fileUnit,610,END=620) line + do + chunkPos = IO_stringPos(line) + if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & + (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then + if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style + read (fileUnit,610,END=630) line ! read line with index of state var + chunkPos = IO_stringPos(line) + sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index + if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest + read (fileUnit,610,END=620) line ! read line with value of state var + chunkPos = IO_stringPos(line) + do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? + myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value + mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index + if (initialcondTableStyle == 2_pInt) then + read (fileUnit,610,END=630) line ! read extra line + read (fileUnit,610,END=630) line ! read extra line + endif + contInts = IO_continuousIntValues& ! get affected elements + (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + do i = 1_pInt,contInts(1) + e = mesh_FEasCP('elem',contInts(1_pInt+i)) + mesh_element(1_pInt+sv,e) = myVal + enddo + if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + enddo + endif + else + read (fileUnit,610,END=630) line + endif + enddo + +630 end subroutine mesh_marc_build_elements +#endif + +#ifdef Abaqus +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores them in +!! 'mesh_Nelems' and 'mesh_Nnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_nodesAndElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countDataLines, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical :: inPart + + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if (inPart .or. noPart) then + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) + case('*node') + if( & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & + ) & + mesh_Nnodes = mesh_Nnodes + IO_countDataLines(fileUnit) + case('*element') + if( & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & + ) then + mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) + endif + endselect + endif + enddo + +620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) + if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) + +end subroutine mesh_abaqus_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief count overall number of element sets in mesh and write 'mesh_NelemSets' and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical :: inPart + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & + mesh_NelemSets = mesh_NelemSets + 1_pInt + enddo + +620 continue + if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) + +end subroutine mesh_abaqus_count_elementSets + + +!-------------------------------------------------------------------------------------------------- +! count overall number of solid sections sets in mesh (Abaqus only) +! +! mesh_Nmaterials +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_materials(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + logical inPart + + mesh_Nmaterials = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. & + IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) & + mesh_Nmaterials = mesh_Nmaterials + 1_pInt + enddo + +620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) + +end subroutine mesh_abaqus_count_materials + + +!-------------------------------------------------------------------------------------------------- +! Build element set mapping +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet = 0_pInt,i + logical :: inPart = .false. + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + +610 FORMAT(A300) + + + rewind(fileUnit) + do + read (fileUnit,610,END=640) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) then + elemSet = elemSet + 1_pInt + mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'elset')) + mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& + mesh_mapElemSet,elemSet-1_pInt) + endif + enddo + +640 do i = 1_pInt,elemSet + if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) + enddo + +end subroutine mesh_abaqus_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +! map solid section (Abaqus only) +! +! allocate globals: mesh_nameMaterial, mesh_mapMaterial +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_materials(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt) :: i,c = 0_pInt + logical :: inPart = .false. + character(len=64) :: elemSetName,materialName + + allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' + allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. & + IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then + + elemSetName = '' + materialName = '' + + do i = 3_pInt,chunkPos(1_pInt) + if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset') /= '') & + elemSetName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset')) + if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material') /= '') & + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) + enddo + + if (elemSetName /= '' .and. materialName /= '') then + c = c + 1_pInt + mesh_nameMaterial(c) = materialName ! name of material used for this section + mesh_mapMaterial(c) = elemSetName ! mapped to respective element set + endif + endif + enddo + +620 if (c==0_pInt) call IO_error(error_ID=905_pInt) + do i=1_pInt,c + if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905_pInt) + enddo + + end subroutine mesh_abaqus_map_materials + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error, & + IO_extractValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + integer(pInt) :: i,k + logical :: materialFound = .false. + character(len=64) ::materialName,elemSetName + + mesh_NcpElems = 0_pInt + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if (IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then + do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (materialName == mesh_nameMaterial(i)) then ! found one + elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet + do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + if (elemSetName == mesh_nameElemSet(k)) & ! matched? + mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) + +end subroutine mesh_abaqus_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) ::i,j,k,cpElem = 0_pInt + logical :: materialFound = .false. + character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then + do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (materialName == mesh_nameMaterial(i)) then ! found one + elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet + do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + if (elemSetName == mesh_nameElemSet(k)) then ! matched? + do j = 1_pInt,mesh_mapElemSet(1,k) + cpElem = cpElem + 1_pInt + mesh_mapFEtoCPelem(1,cpElem) = mesh_mapElemSet(1_pInt+j,k) ! store FE id + mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id + enddo + endif + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + + if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) + +end subroutine mesh_abaqus_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countDataLines, & + IO_intValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt) :: i,c,cpNode = 0_pInt + logical :: inPart = .false. + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=650) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + c = IO_countDataLines(fileUnit) + do i = 1_pInt,c + backspace(fileUnit) + enddo + do i = 1_pInt,c + read (fileUnit,610,END=650) line + chunkPos = IO_stringPos(line) + cpNode = cpNode + 1_pInt + mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) + mesh_mapFEtoCPnode(2_pInt,cpNode) = cpNode + enddo + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + + if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) + +end subroutine mesh_abaqus_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_build_nodes(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_floatValue, & + IO_stringPos, & + IO_error, & + IO_countDataLines, & + IO_intValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m,c + logical :: inPart + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=670) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + c = IO_countDataLines(fileUnit) ! how many nodes are defined here? + do i = 1_pInt,c + backspace(fileUnit) ! rewind to first entry + enddo + do i = 1_pInt,c + read (fileUnit,610,END=670) line + chunkPos = IO_stringPos(line) + m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) + do j=1_pInt, 3_pInt + mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1_pInt) + enddo + enddo + endif + enddo + +670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) + mesh_node = mesh_node0 + +end subroutine mesh_abaqus_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue ,& + IO_error, & + IO_countDataLines, & + IO_intValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,c,t,g + logical :: inPart + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + endif + enddo + +620 end subroutine mesh_abaqus_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per elemen. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_extractValue, & + IO_floatValue, & + IO_countDataLines, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + + integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead + logical inPart,materialFound + character (len=64) :: materialName,elemSetName + character(len=300) :: line + + allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + +610 FORMAT(A300) + + inPart = .false. + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + c = IO_countDataLines(fileUnit) + do i = 1_pInt,c + backspace(fileUnit) + enddo + do i = 1_pInt,c + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) ! limit to 64 nodes max + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then ! disregard non CP elems + mesh_element(1,e) = -1_pInt ! DEPRECATED + if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + call IO_error(191,el=t,ip=mesh_elemType) + mesh_elemType = t + mesh_element(2,e) = t ! elem type + nNodesAlreadyRead = 0_pInt + do j = 1_pInt,chunkPos(1)-1_pInt + mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt+j)) ! put CP ids of nodes to position 5: + enddo + nNodesAlreadyRead = chunkPos(1) - 1_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + endif + enddo + + +620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" + + materialFound = .false. + do + read (fileUnit,610,END=630) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & + materialFound ) then + read (fileUnit,610,END=630) line ! read homogenization and microstructure + chunkPos = IO_stringPos(line) + homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) + micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) + do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (materialName == mesh_nameMaterial(i)) then ! found one + elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet + do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + if (elemSetName == mesh_nameElemSet(k)) then ! matched? + do j = 1_pInt,mesh_mapElemSet(1,k) + e = mesh_FEasCP('elem',mesh_mapElemSet(1+j,k)) + mesh_element(3,e) = homog ! store homogenization + mesh_element(4,e) = micro ! store microstructure + mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),homog) + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),micro) + enddo + endif + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +630 end subroutine mesh_abaqus_build_elements +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief get any additional damask options from input file, sets mesh_periodicSurface +!-------------------------------------------------------------------------------------------------- +subroutine mesh_get_damaskOptions(fileUnit) + +use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + +#ifdef Spectral + mesh_periodicSurface = .true. + + end subroutine mesh_get_damaskOptions + +#else + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) chunk, Nchunks + character(len=300) :: line, damaskOption, v + character(len=300) :: keyword + + mesh_periodicSurface = .false. +#ifdef Marc4DAMASK + keyword = '$damask' +#endif +#ifdef Abaqus + keyword = '**damask' +#endif + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + Nchunks = chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + select case(damaskOption) + case('periodic') ! damask Option that allows to specify periodic fluxes + do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) + v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? + mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' + mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' + mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' + enddo + endselect + endif + enddo + +610 FORMAT(A300) + +620 end subroutine mesh_get_damaskOptions +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipAreas + use math, only: & + math_crossproduct + + implicit none + integer(pInt) :: e,t,g,c,i,f,n,m + real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals + real(pReal), dimension(3) :: normal + + allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + select case (c) + + case (1_pInt,2_pInt) ! 2D 3 or 4 node + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + normal(1) = nodePos(2,2) - nodePos(2,1) ! x_normal = y_connectingVector + normal(2) = -(nodePos(1,2) - nodePos(1,1)) ! y_normal = -x_connectingVector + normal(3) = 0.0_pReal + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + enddo + enddo + + case (3_pInt) ! 3D 4node + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + normal = math_crossproduct(nodePos(1:3,2) - nodePos(1:3,1), & + nodePos(1:3,3) - nodePos(1:3,1)) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + enddo + enddo + + case (4_pInt) ! 3D 8node + ! for this cell type we get the normal of the quadrilateral face as an average of + ! four normals of triangular subfaces; since the face consists only of two triangles, + ! the sum has to be divided by two; this whole prcedure tries to compensate for + ! probable non-planar cell surfaces + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + normals(1:3,n) = 0.5_pReal & + * math_crossproduct(nodePos(1:3,1+mod(n ,m)) - nodePos(1:3,n), & + nodePos(1:3,1+mod(n+1,m)) - nodePos(1:3,n)) + normal = 0.5_pReal * sum(normals,2) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) + enddo + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipAreas + +#ifndef Spectral +!-------------------------------------------------------------------------------------------------- +!> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_nodeTwins + + implicit none + integer(pInt) dir, & ! direction of periodicity + node, & + minimumNode, & + maximumNode, & + n1, & + n2 + integer(pInt), dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes + real(pReal) minCoord, maxCoord, & ! extreme positions in one dimension + tolerance ! tolerance below which positions are assumed identical + real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates + logical, dimension(mesh_Nnodes) :: unpaired + + allocate(mesh_nodeTwins(3,mesh_Nnodes)) + mesh_nodeTwins = 0_pInt + + tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal + + do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z + if (mesh_periodicSurface(dir)) then ! only if periodicity is requested + + + !*** find out which nodes sit on the surface + !*** and have a minimum or maximum position in this dimension + + minimumNodes = 0_pInt + maximumNodes = 0_pInt + minCoord = minval(mesh_node0(dir,:)) + maxCoord = maxval(mesh_node0(dir,:)) + do node = 1_pInt,mesh_Nnodes ! loop through all nodes and find surface nodes + if (abs(mesh_node0(dir,node) - minCoord) <= tolerance) then + minimumNodes(1) = minimumNodes(1) + 1_pInt + minimumNodes(minimumNodes(1)+1_pInt) = node + elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then + maximumNodes(1) = maximumNodes(1) + 1_pInt + maximumNodes(maximumNodes(1)+1_pInt) = node + endif + enddo + + + !*** find the corresponding node on the other side with the same position in this dimension + + unpaired = .true. + do n1 = 1_pInt,minimumNodes(1) + minimumNode = minimumNodes(n1+1_pInt) + if (unpaired(minimumNode)) then + do n2 = 1_pInt,maximumNodes(1) + maximumNode = maximumNodes(n2+1_pInt) + distance = abs(mesh_node0(:,minimumNode) - mesh_node0(:,maximumNode)) + if (sum(distance) - distance(dir) <= tolerance) then ! minimum possible distance (within tolerance) + mesh_nodeTwins(dir,minimumNode) = maximumNode + mesh_nodeTwins(dir,maximumNode) = minimumNode + unpaired(maximumNode) = .false. ! remember this node, we don't have to look for his partner again + exit + endif + enddo + endif + enddo + + endif + enddo + +end subroutine mesh_build_nodeTwins + + +!-------------------------------------------------------------------------------------------------- +!> @brief get maximum count of shared elements among cpElements and build list of elements shared +!! by each node in mesh. Allocate globals '_maxNsharedElems' and '_sharedElem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_sharedElems + + implicit none + integer(pint) e, & ! element index + g, & ! element type + node, & ! CP node index + n, & ! node index per element + myDim, & ! dimension index + nodeTwin ! node twin in the specified dimension + integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt), dimension(:), allocatable :: node_seen + + allocate(node_seen(maxval(FE_NmatchingNodes))) + + node_count = 0_pInt + + do e = 1_pInt,mesh_NcpElems + g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + node_seen = 0_pInt ! reset node duplicates + do n = 1_pInt,FE_NmatchingNodes(g) ! check each node of element + node = mesh_element(4+n,e) + if (all(node_seen /= node)) then + node_count(node) = node_count(node) + 1_pInt ! if FE node not yet encountered -> count it + do myDim = 1_pInt,3_pInt ! check in each dimension... + nodeTwin = mesh_nodeTwins(myDim,node) + if (nodeTwin > 0_pInt) & ! if I am a twin of some node... + node_count(nodeTwin) = node_count(nodeTwin) + 1_pInt ! -> count me again for the twin node + enddo + endif + node_seen(n) = node ! remember this node to be counted already + enddo + enddo + + mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node + + allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) + + do e = 1_pInt,mesh_NcpElems + g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + node_seen = 0_pInt + do n = 1_pInt,FE_NmatchingNodes(g) + node = mesh_element(4_pInt+n,e) + if (all(node_seen /= node)) then + mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1_pInt ! count for each node the connected elements + mesh_sharedElem(mesh_sharedElem(1,node)+1_pInt,node) = e ! store the respective element id + do myDim = 1_pInt,3_pInt ! check in each dimension... + nodeTwin = mesh_nodeTwins(myDim,node) + if (nodeTwin > 0_pInt) then ! if i am a twin of some node... + mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1_pInt ! ...count me again for the twin + mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id + endif + enddo + endif + node_seen(n) = node + enddo + enddo + +end subroutine mesh_build_sharedElems + + +!-------------------------------------------------------------------------------------------------- +!> @brief build up of IP neighborhood, allocate globals '_ipNeighborhood' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipNeighborhood + use math, only: & + math_mul3x3 + + implicit none + integer(pInt) :: myElem, & ! my CP element index + myIP, & + myType, & ! my element type + myFace, & + neighbor, & ! neighor index + neighboringIPkey, & ! positive integer indicating the neighboring IP (for intra-element) and negative integer indicating the face towards neighbor (for neighboring element) + candidateIP, & + neighboringType, & ! element type of neighbor + NlinkedNodes, & ! number of linked nodes + twin_of_linkedNode, & ! node twin of a specific linkedNode + NmatchingNodes, & ! number of matching nodes + dir, & ! direction of periodicity + matchingElem, & ! CP elem number of matching element + matchingFace, & ! face ID of matching element + a, anchor, & + neighboringIP, & + neighboringElem, & + pointingToMe + integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & + linkedNodes = 0_pInt, & + matchingNodes + logical checkTwins + + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) + mesh_ipNeighborhood = 0_pInt + + + do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems + myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType + do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + + do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) + + !*** if the key is positive, the neighbor is inside the element + !*** that means, we have already found our neighboring IP + + if (neighboringIPkey > 0_pInt) then + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey + + + !*** if the key is negative, the neighbor resides in a neighboring element + !*** that means, we have to look through the face indicated by the key and see which element is behind that face + + elseif (neighboringIPkey < 0_pInt) then ! neighboring element's IP + myFace = -neighboringIPkey + call mesh_faceMatch(myElem, myFace, matchingElem, matchingFace) ! get face and CP elem id of face match + if (matchingElem > 0_pInt) then ! found match? + neighboringType = FE_geomtype(mesh_element(2,matchingElem)) + + !*** trivial solution if neighbor has only one IP + + if (FE_Nips(neighboringType) == 1_pInt) then + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt + cycle + endif + + !*** find those nodes which build the link to the neighbor + + NlinkedNodes = 0_pInt + linkedNodes = 0_pInt + do a = 1_pInt,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face + anchor = FE_nodesAtIP(a,myIP,myType) + if (anchor /= 0_pInt) then ! valid anchor node + if (any(FE_face(:,myFace,myType) == anchor)) then ! ip anchor sits on face? + NlinkedNodes = NlinkedNodes + 1_pInt + linkedNodes(NlinkedNodes) = mesh_element(4_pInt+anchor,myElem) ! CP id of anchor node + else ! something went wrong with the linkage, since not all anchors sit on my face + NlinkedNodes = 0_pInt + linkedNodes = 0_pInt + exit + endif + endif + enddo + + !*** loop through the ips of my neighbor + !*** and try to find an ip with matching nodes + !*** also try to match with node twins + + checkCandidateIP: do candidateIP = 1_pInt,FE_Nips(neighboringType) + NmatchingNodes = 0_pInt + matchingNodes = 0_pInt + do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip + anchor = FE_nodesAtIP(a,candidateIP,neighboringType) + if (anchor /= 0_pInt) then ! valid anchor node + if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? + NmatchingNodes = NmatchingNodes + 1_pInt + matchingNodes(NmatchingNodes) = mesh_element(4+anchor,matchingElem) ! CP id of neighbor's anchor node + else ! no matching, because not all nodes sit on the matching face + NmatchingNodes = 0_pInt + matchingNodes = 0_pInt + exit + endif + endif + enddo + + if (NmatchingNodes /= NlinkedNodes) & ! this ip has wrong count of anchors on face + cycle checkCandidateIP + + !*** check "normal" nodes whether they match or not + + checkTwins = .false. + do a = 1_pInt,NlinkedNodes + if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode + checkTwins = .true. + exit ! no need to search further + endif + enddo + + !*** if no match found, then also check node twins + + if(checkTwins) then + dir = int(maxloc(abs(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem)),1),pInt) ! check for twins only in direction of the surface normal + do a = 1_pInt,NlinkedNodes + twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) + if (twin_of_linkedNode == 0_pInt .or. & ! twin of linkedNode does not exist... + all(matchingNodes /= twin_of_linkedNode)) then ! ... or it does not match any matchingNode + cycle checkCandidateIP ! ... then check next candidateIP + endif + enddo + endif + + !*** we found a match !!! + + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = candidateIP + exit checkCandidateIP + enddo checkCandidateIP + endif ! end of valid external matching + endif ! end of internal/external matching + enddo + enddo + enddo + do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems + myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType + do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + neighboringElem = mesh_ipNeighborhood(1,neighbor,myIP,myElem) + neighboringIP = mesh_ipNeighborhood(2,neighbor,myIP,myElem) + if (neighboringElem > 0_pInt .and. neighboringIP > 0_pInt) then ! if neighbor exists ... + neighboringType = FE_geomtype(mesh_element(2,neighboringElem)) + do pointingToMe = 1_pInt,FE_NipNeighbors(FE_celltype(neighboringType)) ! find neighboring index that points from my neighbor to myself + if ( myElem == mesh_ipNeighborhood(1,pointingToMe,neighboringIP,neighboringElem) & + .and. myIP == mesh_ipNeighborhood(2,pointingToMe,neighboringIP,neighboringElem)) then ! possible candidate + if (math_mul3x3(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem),& + mesh_ipAreaNormal(1:3,pointingToMe,neighboringIP,neighboringElem)) < 0.0_pReal) then ! area normals have opposite orientation (we have to check that because of special case for single element with two ips and periodicity. In this case the neighbor is identical in two different directions.) + mesh_ipNeighborhood(3,neighbor,myIP,myElem) = pointingToMe ! found match + exit ! so no need to search further + endif + endif + enddo + endif + enddo + enddo + enddo + +end subroutine mesh_build_ipNeighborhood +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief write statistics regarding input file parsing to the output file +!-------------------------------------------------------------------------------------------------- +subroutine mesh_tell_statistics + use math, only: & + math_range + use IO, only: & + IO_error + use debug, only: & + debug_level, & + debug_MESH, & + debug_LEVELBASIC, & + debug_LEVELEXTENSIVE, & + debug_LEVELSELECTIVE, & + debug_e, & + debug_i + + implicit none + integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro + character(len=64) :: myFmt + integer(pInt) :: i,e,n,f,t,g,c, myDebug + + myDebug = debug_level(debug_mesh) + + if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified + if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified + + allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) + do e = 1_pInt,mesh_NcpElems + if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified + if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified + mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & + mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure + enddo +!$OMP CRITICAL (write2out) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) then + write(6,'(/,a,/)') ' Input Parser: STATISTICS' + write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' + write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' + write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' + write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' + write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' + write(6,*) + write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' + write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) + write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' + do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations + write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures + enddo + write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' + write(6,*) 'periodic surface : ', mesh_periodicSurface + write(6,*) + flush(6) + endif + + if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then + write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' + write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + t = mesh_element(2,e) ! get elemType + g = FE_geomtype(t) ! get elemGeomType + c = FE_celltype(g) ! get cellType + write(6,'(i8,3(1x,i8))') e,t,g,c + enddo + write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' + write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) + write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + t = mesh_element(2,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + do i = 1_pInt,FE_Nips(g) + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) + do f = 1_pInt,FE_NipNeighbors(c) + write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) + enddo + enddo + enddo + write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' + write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + t = mesh_element(2,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i2)') e,i + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell + write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & + mesh_cellnode(1:3,mesh_cell(n,i,e)) + enddo + enddo + enddo + write(6,'(/,a)') 'Input Parser: IP COORDINATES' + write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' + do e = 1_pInt,mesh_NcpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) + enddo + enddo +#ifndef Spectral + write(6,'(/,a,/)') 'Input Parser: NODE TWINS' + write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' + do n = 1_pInt,mesh_Nnodes ! loop over cpNodes + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle + write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) + enddo +#endif + write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' + write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle + t = mesh_element(2,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem + if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle + do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP + write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) + enddo + enddo + enddo + endif +!$OMP END CRITICAL (write2out) + +end subroutine mesh_tell_statistics + + +!-------------------------------------------------------------------------------------------------- +!> @brief mapping of FE element types to internal representation +!-------------------------------------------------------------------------------------------------- +integer(pInt) function FE_mapElemtype(what) + use IO, only: IO_lc, IO_error + + implicit none + character(len=*), intent(in) :: what + + select case (IO_lc(what)) + case ( '6') + FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle + case ( '155', & + '125', & + '128') + FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) + case ( '11', & + 'cpe4', & + 'cpe4t') + FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + case ( '27', & + 'cpe8', & + 'cpe8t') + FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + case ( '54') + FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration + case ( '134', & + 'c3d4', & + 'c3d4t') + FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + case ( '157') + FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations + case ( '127') + FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron + case ( '136', & + 'c3d6', & + 'c3d6t') + FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( '117', & + '123', & + 'c3d8r', & + 'c3d8rt') + FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + case ( '7', & + 'c3d8', & + 'c3d8t') + FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + case ( '57', & + 'c3d20r', & + 'c3d20rt') + FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + case ( '21', & + 'c3d20', & + 'c3d20t') + FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + case default + call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + end select + +end function FE_mapElemtype + + +!-------------------------------------------------------------------------------------------------- +!> @brief find face-matching element of same type +!-------------------------------------------------------------------------------------------------- +subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) + +implicit none +integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID + matchingFace ! matching face ID +integer(pInt), intent(in) :: face, & ! face ID + elem ! CP elem ID +integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & + myFaceNodes ! global node ids on my face +integer(pInt) :: myType, & + candidateType, & + candidateElem, & + candidateFace, & + candidateFaceNode, & + minNsharedElems, & + NsharedElems, & + lonelyNode = 0_pInt, & + i, & + n, & + dir ! periodicity direction +integer(pInt), dimension(:), allocatable :: element_seen +logical checkTwins + +matchingElem = 0_pInt +matchingFace = 0_pInt +minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case +myType = FE_geomtype(mesh_element(2_pInt,elem)) ! figure elemGeomType + +do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face + myFaceNodes(n) = mesh_element(4_pInt+FE_face(n,face,myType),elem) ! CP id of face node + NsharedElems = mesh_sharedElem(1_pInt,myFaceNodes(n)) ! figure # shared elements for this node + if (NsharedElems < minNsharedElems) then + minNsharedElems = NsharedElems ! remember min # shared elems + lonelyNode = n ! remember most lonely node + endif +enddo + +allocate(element_seen(minNsharedElems)) +element_seen = 0_pInt + +checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements + candidateElem = mesh_sharedElem(1_pInt+i,myFaceNodes(lonelyNode)) ! present candidate elem + if (all(element_seen /= candidateElem)) then ! element seen for the first time? + element_seen(i) = candidateElem + candidateType = FE_geomtype(mesh_element(2_pInt,candidateElem)) ! figure elemGeomType of candidate +checkCandidateFace: do candidateFace = 1_pInt,FE_maxNipNeighbors ! check each face of candidate + if (FE_NmatchingNodesPerFace(candidateFace,candidateType) & + /= FE_NmatchingNodesPerFace(face,myType) & ! incompatible face + .or. (candidateElem == elem .and. candidateFace == face)) then ! this is my face + cycle checkCandidateFace + endif + checkTwins = .false. + do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face + candidateFaceNode = mesh_element(4_pInt+FE_face(n,candidateFace,candidateType),candidateElem) + if (all(myFaceNodes /= candidateFaceNode)) then ! candidate node does not match any of my face nodes + checkTwins = .true. ! perhaps the twin nodes do match + exit + endif + enddo + if(checkTwins) then +checkCandidateFaceTwins: do dir = 1_pInt,3_pInt + do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face + candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) + if (all(myFaceNodes /= mesh_nodeTwins(dir,candidateFaceNode))) then ! node twin does not match either + if (dir == 3_pInt) then + cycle checkCandidateFace + else + cycle checkCandidateFaceTwins ! try twins in next dimension + endif + endif + enddo + exit checkCandidateFaceTwins + enddo checkCandidateFaceTwins + endif + matchingFace = candidateFace + matchingElem = candidateElem + exit checkCandidate ! found my matching candidate + enddo checkCandidateFace + endif +enddo checkCandidate + +end subroutine mesh_faceMatch + + +!-------------------------------------------------------------------------------------------------- +!> @brief get properties of different types of finite elements +!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_FEdata + + implicit none + integer(pInt) :: me + allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_cellnodeParentnodeWeights(FE_maxNnodes,FE_maxNcellnodes,FE_Nelemtypes), source=0.0_pReal) + allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) + + + !*** fill FE_nodesAtIP with data *** + + me = 0_pInt + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + 1,2,3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, & + 2, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, & + 2, & + 4, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 1,0, & + 1,2, & + 2,0, & + 1,4, & + 0,0, & + 2,3, & + 4,0, & + 3,4, & + 3,0 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + 1,2,3,4 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + reshape(int([& + 1, & + 2, & + 3, & + 4 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + reshape(int([& + 1, & + 2, & + 3, & + 4, & + 5, & + 6 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + 1,2,3,4,5,6,7,8 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + reshape(int([& + 1, & + 2, & + 4, & + 3, & + 5, & + 6, & + 8, & + 7 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + reshape(int([& + 1,0, 0,0, & + 1,2, 0,0, & + 2,0, 0,0, & + 1,4, 0,0, & + 1,3, 2,4, & + 2,3, 0,0, & + 4,0, 0,0, & + 3,4, 0,0, & + 3,0, 0,0, & + 1,5, 0,0, & + 1,6, 2,5, & + 2,6, 0,0, & + 1,8, 4,5, & + 0,0, 0,0, & + 2,7, 3,6, & + 4,8, 0,0, & + 3,8, 4,7, & + 3,7, 0,0, & + 5,0, 0,0, & + 5,6, 0,0, & + 6,0, 0,0, & + 5,8, 0,0, & + 5,7, 6,8, & + 6,7, 0,0, & + 8,0, 0,0, & + 7,8, 0,0, & + 7,0, 0,0 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + + ! *** FE_ipNeighbor *** + ! is a list of the neighborhood of each IP. + ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. + ! Positive integers denote an intra-FE IP identifier. + ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. + me = 0_pInt + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + -2,-3,-1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 2,-3, 3,-1, & + -2, 1, 3,-1, & + 2,-3,-2, 1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 2,-4, 3,-1, & + -2, 1, 4,-1, & + 4,-4,-3, 1, & + -2, 3,-3, 2 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 2,-4, 4,-1, & + 3, 1, 5,-1, & + -2, 2, 6,-1, & + 5,-4, 7, 1, & + 6, 4, 8, 2, & + -2, 5, 9, 3, & + 8,-4,-3, 4, & + 9, 7,-3, 5, & + -2, 8,-3, 6 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + -1,-2,-3,-4 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + reshape(int([& + 2,-4, 3,-2, 4,-1, & + -2, 1, 3,-2, 4,-1, & + 2,-4,-3, 1, 4,-1, & + 2,-4, 3,-2,-3, 1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + reshape(int([& + 2,-4, 3,-2, 4,-1, & + -3, 1, 3,-2, 5,-1, & + 2,-4,-3, 1, 6,-1, & + 5,-4, 6,-2,-5, 1, & + -3, 4, 6,-2,-5, 2, & + 5,-4,-3, 4,-5, 3 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + -3,-5,-4,-2,-6,-1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + reshape(int([& + 2,-5, 3,-2, 5,-1, & + -3, 1, 4,-2, 6,-1, & + 4,-5,-4, 1, 7,-1, & + -3, 3,-4, 2, 8,-1, & + 6,-5, 7,-2,-6, 1, & + -3, 5, 8,-2,-6, 2, & + 8,-5,-4, 5,-6, 3, & + -3, 7,-4, 6,-6, 4 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + reshape(int([& + 2,-5, 4,-2,10,-1, & + 3, 1, 5,-2,11,-1, & + -3, 2, 6,-2,12,-1, & + 5,-5, 7, 1,13,-1, & + 6, 4, 8, 2,14,-1, & + -3, 5, 9, 3,15,-1, & + 8,-5,-4, 4,16,-1, & + 9, 7,-4, 5,17,-1, & + -3, 8,-4, 6,18,-1, & + 11,-5,13,-2,19, 1, & + 12,10,14,-2,20, 2, & + -3,11,15,-2,21, 3, & + 14,-5,16,10,22, 4, & + 15,13,17,11,23, 5, & + -3,14,18,12,24, 6, & + 17,-5,-4,13,25, 7, & + 18,16,-4,14,26, 8, & + -3,17,-4,15,27, 9, & + 20,-5,22,-2,-6,10, & + 21,19,23,-2,-6,11, & + -3,20,24,-2,-6,12, & + 23,-5,25,19,-6,13, & + 24,22,26,20,-6,14, & + -3,23,27,21,-6,15, & + 26,-5,-4,22,-6,16, & + 27,25,-4,23,-6,17, & + -3,26,-4,24,-6,18 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cell *** + me = 0_pInt + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + 1,2,3 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, 4, 7, 6, & + 2, 5, 7, 4, & + 3, 6, 7, 5 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, 5, 9, 8, & + 5, 2, 6, 9, & + 8, 9, 7, 4, & + 9, 6, 3, 7 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 1, 5,13,12, & + 5, 6,14,13, & + 6, 2, 7,14, & + 12,13,16,11, & + 13,14,15,16, & + 14, 7, 8,15, & + 11,16,10, 4, & + 16,15, 9,10, & + 15, 8, 3, 9 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + 1, 2, 3, 4 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + reshape(int([& + 1, 5,11, 7, 8,12,15,14, & + 5, 2, 6,11,12, 9,13,15, & + 7,11, 6, 3,14,15,13,10, & + 8,12,15, 4, 4, 9,13,10 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + reshape(int([& + 1, 7,16, 9,10,17,21,19, & + 7, 2, 8,16,17,11,18,21, & + 9,16, 8, 3,19,21,18,12, & + 10,17,21,19, 4,13,20,15, & + 17,11,18,21,13, 5,14,20, & + 19,21,18,12,15,20,14, 6 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + 1, 2, 3, 4, 5, 6, 7, 8 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + reshape(int([& + 1, 9,21,12,13,22,27,25, & + 9, 2,10,21,22,14,23,27, & + 12,21,11, 4,25,27,24,16, & + 21,10, 3,11,27,23,15,24, & + 13,22,27,25, 5,17,26,20, & + 22,14,23,27,17, 6,18,26, & + 25,27,24,16,20,26,19, 8, & + 27,23,15,24,26,18, 7,19 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + reshape(int([& + 1, 9,33,16,17,37,57,44, & + 9,10,34,33,37,38,58,57, & + 10, 2,11,34,38,18,39,58, & + 16,33,36,15,44,57,60,43, & + 33,34,35,36,57,58,59,60, & + 34,11,12,35,58,39,40,59, & + 15,36,14, 4,43,60,42,20, & + 36,35,13,14,60,59,41,42, & + 35,12, 3,13,59,40,19,41, & + 17,37,57,44,21,45,61,52, & + 37,38,58,57,45,46,62,61, & + 38,18,39,58,46,22,47,62, & + 44,57,60,43,52,61,64,51, & + 57,58,59,60,61,62,63,64, & + 58,39,40,59,62,47,48,63, & + 43,60,42,20,51,64,50,24, & + 60,59,41,42,64,63,49,50, & + 59,40,19,41,63,48,23,49, & + 21,45,61,52, 5,25,53,32, & + 45,46,62,61,25,26,54,53, & + 46,22,47,62,26, 6,27,54, & + 52,61,64,51,32,53,56,31, & + 61,62,63,64,53,54,55,56, & + 62,47,48,63,54,27,28,55, & + 51,64,50,24,31,56,30, 8, & + 64,63,49,50,56,55,29,30, & + 63,48,23,49,55,28, 7,29 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cellnodeParentnodeWeights *** + ! center of gravity of the weighted nodes gives the position of the cell node. + ! fill with 0. + ! example: face-centered cell node with face nodes 1,2,5,6 to be used in, + ! e.g., an 8 node element, would be encoded: + ! 1, 1, 0, 0, 1, 1, 0, 0 + me = 0_pInt + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) + reshape(real([& + 1, 0, 0, & + 0, 1, 0, & + 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 2, 2, 2 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1, & + 1, 1, 0, 0, & + 0, 1, 1, 0, & + 0, 0, 1, 1, & + 1, 0, 0, 1, & + 1, 1, 1, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 27 (2D 8node 9ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 1, 0, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 0, 2, & + 1, 0, 0, 0, 0, 0, 0, 2, & + 4, 1, 1, 1, 8, 2, 2, 8, & + 1, 4, 1, 1, 8, 8, 2, 2, & + 1, 1, 4, 1, 2, 8, 8, 2, & + 1, 1, 1, 4, 2, 2, 8, 8 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 54 (2D 8node 4ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 1, 2, 2, 2, 2 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) + reshape(real([& + 1, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, & + 0, 0, 1, 0, 0, & + 0, 0, 0, 1, 0, & + 1, 1, 0, 0, 0, & + 0, 1, 1, 0, 0, & + 1, 0, 1, 0, 0, & + 1, 0, 0, 1, 0, & + 0, 1, 0, 1, 0, & + 0, 0, 1, 1, 0, & + 1, 1, 1, 0, 0, & + 1, 1, 0, 1, 0, & + 0, 1, 1, 1, 0, & + 1, 0, 1, 1, 0, & + 0, 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 127 (3D 10node 4ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & + 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & + 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & + 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & + 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 136 (3D 6node 6ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 0, 0, 0, 0, & + 0, 1, 1, 0, 0, 0, & + 1, 0, 1, 0, 0, 0, & + 1, 0, 0, 1, 0, 0, & + 0, 1, 0, 0, 1, 0, & + 0, 0, 1, 0, 0, 1, & + 0, 0, 0, 1, 1, 0, & + 0, 0, 0, 0, 1, 1, & + 0, 0, 0, 1, 0, 1, & + 1, 1, 1, 0, 0, 0, & + 1, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 1, & + 1, 0, 1, 1, 0, 1, & + 0, 0, 0, 1, 1, 1, & + 1, 1, 1, 1, 1, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, & ! + 1, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 1, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 1, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 1, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 1, & ! + 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, & ! + 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, & ! + 1, 1, 1, 1, 1, 1, 1, 1 & ! + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! + 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! + 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 + 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! + 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 + 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! + 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! + 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! + 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 + 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! + 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 + 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! + 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! + 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 + 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! + 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! + 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! + 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! + 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 + 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! + 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! + 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! + 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + + + ! *** FE_cellface *** + me = 0_pInt + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 3node, VTK_TRIANGLE (5) + reshape(int([& + 2,3, & + 3,1, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 4node, VTK_QUAD (9) + reshape(int([& + 2,3, & + 4,1, & + 3,4, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 4node, VTK_TETRA (10) + reshape(int([& + 1,3,2, & + 1,2,4, & + 2,3,4, & + 1,4,3 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 8node, VTK_HEXAHEDRON (12) + reshape(int([& + 2,3,7,6, & + 4,1,5,8, & + 3,4,8,7, & + 1,2,6,5, & + 5,6,7,8, & + 1,4,3,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + +end subroutine mesh_build_FEdata + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns global variable mesh_Ncellnodes +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_get_Ncellnodes() + + implicit none + + mesh_get_Ncellnodes = mesh_Ncellnodes + +end function mesh_get_Ncellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns global variable mesh_unitlength +!-------------------------------------------------------------------------------------------------- +real(pReal) function mesh_get_unitlength() + + implicit none + + mesh_get_unitlength = mesh_unitlength + +end function mesh_get_unitlength + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns node that is located at an ip +!> @details return zero if requested ip does not exist or not available (more ips than nodes) +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) + + implicit none + character(len=*), intent(in) :: elemtypeFE + integer(pInt), intent(in) :: ip + integer(pInt) :: elemtype + integer(pInt) :: geomtype + + mesh_get_nodeAtIP = 0_pInt + + elemtype = FE_mapElemtype(elemtypeFE) + geomtype = FE_geomtype(elemtype) + if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & + mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) + +end function mesh_get_nodeAtIP + + +end module mesh From 012759d0360a92ff8b10d1cf4f9740b9f4201a0f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:04:43 +0100 Subject: [PATCH 016/309] remove non-marc specific code --- src/mesh_marc.f90 | 1520 +-------------------------------------------- 1 file changed, 5 insertions(+), 1515 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index e55165d51..b993b43d6 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -62,11 +62,9 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) -#if defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), private :: & mesh_maxNelemInSet, & mesh_Nmaterials -#endif integer(pInt), dimension(2), private :: & mesh_maxValStateVar = 0_pInt @@ -344,19 +342,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) -#if defined(Spectral) - integer(pInt), dimension(3), public, protected :: & - grid !< (global) grid - integer(pInt), public, protected :: & - mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh - grid3, & !< (local) grid in 3rd direction - grid3Offset !< (local) grid offset in 3rd direction - real(pReal), dimension(3), public, protected :: & - geomSize - real(pReal), public, protected :: & - size3, & !< (local) size in 3rd direction - size3offset !< (local) size offset in 3rd direction -#elif defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), private :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element @@ -370,17 +355,14 @@ integer(pInt), dimension(:,:), allocatable, private :: & integer(pInt), dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] -#endif -#if defined(Marc4DAMASK) + + integer(pInt), private :: & MarcVersion, & !< Version of input file format (Marc only) hypoelasticTableStyle, & !< Table style (Marc only) initialcondTableStyle !< Table style (Marc only) integer(pInt), dimension(:), allocatable, private :: & Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) -#elif defined(Abaqus) - logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information -#endif public :: & mesh_init, & @@ -391,12 +373,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_Ncellnodes, & mesh_get_unitlength, & mesh_get_nodeAtIP, & -#if defined(Spectral) - mesh_spectral_getGrid, & - mesh_spectral_getSize -#elif defined(Marc4DAMASK) || defined(Abaqus) mesh_FEasCP -#endif + private :: & mesh_get_damaskOptions, & @@ -406,19 +384,9 @@ integer(pInt), dimension(:,:), allocatable, private :: & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & -#if defined(Spectral) - mesh_spectral_getHomogenization, & - mesh_spectral_count, & - mesh_spectral_count_cpSizes, & - mesh_spectral_build_nodes, & - mesh_spectral_build_elements, & - mesh_spectral_build_ipNeighborhood -#elif defined(Marc4DAMASK) || defined(Abaqus) mesh_build_nodeTwins, & mesh_build_sharedElems, & mesh_build_ipNeighborhood, & -#endif -#if defined(Marc4DAMASK) mesh_marc_get_fileFormat, & mesh_marc_get_tableStyles, & mesh_marc_get_matNumber, & @@ -431,19 +399,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_marc_build_nodes, & mesh_marc_count_cpSizes, & mesh_marc_build_elements -#elif defined(Abaqus) - mesh_abaqus_count_nodesAndElements, & - mesh_abaqus_count_elementSets, & - mesh_abaqus_count_materials, & - mesh_abaqus_map_elementSets, & - mesh_abaqus_map_materials, & - mesh_abaqus_count_cpElements, & - mesh_abaqus_map_elements, & - mesh_abaqus_map_nodes, & - mesh_abaqus_build_nodes, & - mesh_abaqus_count_cpSizes, & - mesh_abaqus_build_elements -#endif contains @@ -457,22 +412,10 @@ subroutine mesh_init(ip,el) use, intrinsic :: iso_fortran_env, only: & compiler_version, & compiler_options -#endif -#ifdef Spectral -#include - use PETScsys #endif use DAMASK_interface use IO, only: & -#ifdef Abaqus - IO_abaqus_hasNoPart, & -#endif -#ifdef Spectral - IO_open_file, & - IO_error, & -#else IO_open_InputFile, & -#endif IO_timeStamp, & IO_error, & IO_write_jobFile @@ -487,19 +430,12 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & -#ifndef Spectral modelName, & calcMode, & -#endif FEsolving_execElem, & FEsolving_execIP implicit none -#ifdef Spectral - include 'fftw3-mpi.f03' - integer(C_INTPTR_T) :: devNull, local_K, local_K_offset - integer :: ierr, worldsize -#endif integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), intent(in), optional :: el, ip integer(pInt) :: j @@ -514,36 +450,6 @@ subroutine mesh_init(ip,el) myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) -#ifdef Spectral - call fftw_mpi_init() - call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... - if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) - grid = mesh_spectral_getGrid(fileUnit) - call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') - if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') - - geomSize = mesh_spectral_getSize(fileUnit) - devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & - int(grid(2),C_INTPTR_T), & - int(grid(1),C_INTPTR_T)/2+1, & - PETSC_COMM_WORLD, & - local_K, & ! domain grid size along z - local_K_offset) ! domain grid offset along z - grid3 = int(local_K,pInt) - grid3Offset = int(local_K_offset,pInt) - size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) - size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) - if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) - call mesh_spectral_count() - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_spectral_count_cpSizes - if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) - call mesh_spectral_build_nodes() - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_spectral_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Marc4DAMASK call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) call mesh_marc_get_fileFormat(FILEUNIT) @@ -572,33 +478,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Abaqus - call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... - if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - noPart = IO_abaqus_hasNoPart(FILEUNIT) - call mesh_abaqus_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_abaqus_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_abaqus_count_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) - call mesh_abaqus_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_abaqus_map_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) - call mesh_abaqus_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_abaqus_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_abaqus_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_abaqus_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_abaqus_count_cpSizes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) - call mesh_abaqus_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#endif call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) @@ -614,25 +493,16 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) close (FILEUNIT) -#if defined(Marc4DAMASK) || defined(Abaqus) + call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) call mesh_build_ipNeighborhood -#else - call mesh_spectral_build_ipNeighborhood -#endif if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (worldrank == 0_pInt) then - call mesh_tell_statistics - endif - -#if defined(Marc4DAMASK) || defined(Abaqus) if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements -#endif if (debug_e < 1 .or. debug_e > mesh_NcpElems) & call IO_error(602_pInt,ext_msg='element') ! selected element does not exist if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & @@ -642,11 +512,9 @@ subroutine mesh_init(ip,el) allocate(FEsolving_execIP(2_pInt,mesh_NcpElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element -#if defined(Marc4DAMASK) || defined(Abaqus) allocate(calcMode(mesh_maxNips,mesh_NcpElems)) calcMode = .false. ! pretend to have collected what first call is asking (F = I) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" -#endif !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. @@ -662,7 +530,6 @@ subroutine mesh_init(ip,el) end subroutine mesh_init -#if defined(Marc4DAMASK) || defined(Abaqus) !-------------------------------------------------------------------------------------------------- !> @brief Gives the FE to CP ID mapping by binary search through lookup array !! valid questions (what) are 'elem', 'node' @@ -711,7 +578,6 @@ integer(pInt) function mesh_FEasCP(what,myID) enddo binarySearch end function mesh_FEasCP -#endif !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -953,548 +819,6 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates -#ifdef Spectral -!-------------------------------------------------------------------------------------------------- -!> @brief Reads grid information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -function mesh_spectral_getGrid(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), dimension(3) :: mesh_spectral_getGrid - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotGrid = .false. - - mesh_spectral_getGrid = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) - case ('grid') - gotGrid = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('a') - mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) - case('b') - mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) - case('c') - mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotGrid) & - call IO_error(error_ID = 845_pInt, ext_msg='grid') - if(any(mesh_spectral_getGrid < 1_pInt)) & - call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') - -end function mesh_spectral_getGrid - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads size information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -function mesh_spectral_getSize(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - real(pReal), dimension(3) :: mesh_spectral_getSize - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotSize = .false. - - mesh_spectral_getSize = -1.0_pReal - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('size') - gotSize = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('x') - mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) - case('y') - mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) - case('z') - mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotSize) & - call IO_error(error_ID = 845_pInt, ext_msg='size') - if (any(mesh_spectral_getSize<=0.0_pReal)) & - call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') - -end function mesh_spectral_getSize - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_spectral_getHomogenization(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, myFileUnit - logical :: gotHomogenization = .false. - - mesh_spectral_getHomogenization = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('homogenization') - gotHomogenization = .true. - mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotHomogenization ) & - call IO_error(error_ID = 845_pInt, ext_msg='homogenization') - if (mesh_spectral_getHomogenization<1_pInt) & - call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') - -end function mesh_spectral_getHomogenization - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count() - - implicit none - - mesh_NcpElems= product(grid(1:2))*grid3 - mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) - - mesh_NcpElemsGlobal = product(grid) - -end subroutine mesh_spectral_count - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count_cpSizes - - implicit none - integer(pInt) :: t,g,c - - t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element - g = FE_geomtype(t) - c = FE_celltype(g) - - mesh_maxNips = FE_Nips(g) - mesh_maxNipNeighbors = FE_NipNeighbors(c) - mesh_maxNcellnodes = FE_Ncellnodes(g) - -end subroutine mesh_spectral_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_nodes() - - implicit none - integer(pInt) :: n - - allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) - allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) - - forall (n = 0_pInt:mesh_Nnodes-1_pInt) - mesh_node0(1,n+1_pInt) = mesh_unitlength * & - geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & - / real(grid(1),pReal) - mesh_node0(2,n+1_pInt) = mesh_unitlength * & - geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) & - / real(grid(2),pReal) - mesh_node0(3,n+1_pInt) = mesh_unitlength * & - size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & - / real(grid3,pReal) + & - size3offset - end forall - - mesh_node = mesh_node0 - -end subroutine mesh_spectral_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, material, texture, and node list per element. -!! Allocates global array 'mesh_element' -!> @todo does the IO_error makes sense? -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_elements(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_continuousIntValues, & - IO_intValue, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: & - fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: & - e, i, & - headerLength = 0_pInt, & - maxDataPerLine, & - homog, & - elemType, & - elemOffset - integer(pInt), dimension(:), allocatable :: & - microstructures, & - microGlobal - integer(pInt), dimension(1,1) :: & - dummySet = 0_pInt - character(len=65536) :: & - line, & - keyword - character(len=64), dimension(1) :: & - dummyName = '' - - homog = mesh_spectral_getHomogenization(fileUnit) - -!-------------------------------------------------------------------------------------------------- -! get header length - call IO_checkAndRewind(fileUnit) - read(fileUnit,'(a65536)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') - endif - -!-------------------------------------------------------------------------------------------------- -! get maximum microstructure index - call IO_checkAndRewind(fileUnit) - do i = 1_pInt, headerLength - read(fileUnit,'(a65536)') line - enddo - - maxDataPerLine = 0_pInt - i = 1_pInt - - do while (i > 0_pInt) - i = IO_countContinuousIntValues(fileUnit) - maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? - enddo - allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) - allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size - allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) - -!-------------------------------------------------------------------------------------------------- -! read in microstructures - call IO_checkAndRewind(fileUnit) - do i=1_pInt,headerLength - read(fileUnit,'(a65536)') line - enddo - - e = 0_pInt - do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) - microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements - do i = 1_pInt,microstructures(1_pInt) - e = e+1_pInt ! valid element entry - microGlobal(e) = microstructures(1_pInt+i) - enddo - enddo - - elemType = FE_mapElemtype('C3D8R') - elemOffset = product(grid(1:2))*grid3Offset - e = 0_pInt - do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) - e = e+1_pInt ! valid element entry - mesh_element( 1,e) = -1_pInt ! DEPRECATED - mesh_element( 2,e) = elemType ! elem type - mesh_element( 3,e) = homog ! homogenization - mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure - mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & - ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node - mesh_element( 6,e) = mesh_element(5,e) + 1_pInt - mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt - mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt - mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node - mesh_element(10,e) = mesh_element(9,e) + 1_pInt - mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt - mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) - enddo - - if (e /= mesh_NcpElems) call IO_error(880_pInt,e) - -end subroutine mesh_spectral_build_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief build neighborhood relations for spectral -!> @details assign globals: mesh_ipNeighborhood -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_ipNeighborhood - - implicit none - integer(pInt) :: & - x,y,z, & - e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) - - e = 0_pInt - do z = 0_pInt,grid3-1_pInt - do y = 0_pInt,grid(2)-1_pInt - do x = 0_pInt,grid(1)-1_pInt - e = e + 1_pInt - mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & - + y * grid(1) & - + modulo(x+1_pInt,grid(1)) & - + 1_pInt - mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & - + y * grid(1) & - + modulo(x-1_pInt,grid(1)) & - + 1_pInt - mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & - + modulo(y+1_pInt,grid(2)) * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & - + modulo(y-1_pInt,grid(2)) * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) & - + y * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) & - + y * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt - mesh_ipNeighborhood(3,1,1,e) = 2_pInt - mesh_ipNeighborhood(3,2,1,e) = 1_pInt - mesh_ipNeighborhood(3,3,1,e) = 4_pInt - mesh_ipNeighborhood(3,4,1,e) = 3_pInt - mesh_ipNeighborhood(3,5,1,e) = 6_pInt - mesh_ipNeighborhood(3,6,1,e) = 5_pInt - enddo - enddo - enddo - -end subroutine mesh_spectral_build_ipNeighborhood - - -!-------------------------------------------------------------------------------------------------- -!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) -!-------------------------------------------------------------------------------------------------- -function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) - use debug, only: & - debug_mesh, & - debug_level, & - debug_levelBasic - use math, only: & - math_mul33x3 - - implicit none - real(pReal), intent(in), dimension(:,:,:,:) :: & - centres - real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: & - nodes - real(pReal), intent(in), dimension(3) :: & - gDim - real(pReal), intent(in), dimension(3,3) :: & - Favg - real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: & - wrappedCentres - - integer(pInt) :: & - i,j,k,n - integer(pInt), dimension(3), parameter :: & - diag = 1_pInt - integer(pInt), dimension(3) :: & - shift = 0_pInt, & - lookup = 0_pInt, & - me = 0_pInt, & - iRes = 0_pInt - integer(pInt), dimension(3,8) :: & - neighbor = reshape([ & - 0_pInt, 0_pInt, 0_pInt, & - 1_pInt, 0_pInt, 0_pInt, & - 1_pInt, 1_pInt, 0_pInt, & - 0_pInt, 1_pInt, 0_pInt, & - 0_pInt, 0_pInt, 1_pInt, & - 1_pInt, 0_pInt, 1_pInt, & - 1_pInt, 1_pInt, 1_pInt, & - 0_pInt, 1_pInt, 1_pInt ], [3,8]) - -!-------------------------------------------------------------------------------------------------- -! initializing variables - iRes = [size(centres,2),size(centres,3),size(centres,4)] - nodes = 0.0_pReal - wrappedCentres = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! report - if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then - write(6,'(a)') ' Meshing cubes around centroids' - write(6,'(a,3(e12.5))') ' Dimension: ', gDim - write(6,'(a,3(i5))') ' Resolution:', iRes - endif - -!-------------------------------------------------------------------------------------------------- -! building wrappedCentres = centroids + ghosts - wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres - do k = 0_pInt,iRes(3)+1_pInt - do j = 0_pInt,iRes(2)+1_pInt - do i = 0_pInt,iRes(1)+1_pInt - if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin - j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin - i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin - me = [i,j,k] ! me on skin - shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me) - lookup = me-diag+shift*iRes - wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = & - centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) & - - math_mul33x3(Favg, real(shift,pReal)*gDim) - endif - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! averaging - do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) - do n = 1_pInt,8_pInt - nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = & - nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), & - j+1_pInt+neighbor(2,n), & - k+1_pInt+neighbor(3,n) ) - enddo - enddo; enddo; enddo - nodes = nodes/8.0_pReal - -end function mesh_nodesAroundCentres -#endif - -#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief Figures out version of Marc input file format and stores ist as MarcVersion !-------------------------------------------------------------------------------------------------- @@ -2105,693 +1429,6 @@ subroutine mesh_marc_build_elements(fileUnit) enddo 630 end subroutine mesh_marc_build_elements -#endif - -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_nodesAndElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countDataLines, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical :: inPart - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if (inPart .or. noPart) then - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) - case('*node') - if( & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & - ) & - mesh_Nnodes = mesh_Nnodes + IO_countDataLines(fileUnit) - case('*element') - if( & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & - ) then - mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) - endif - endselect - endif - enddo - -620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) - if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) - -end subroutine mesh_abaqus_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief count overall number of element sets in mesh and write 'mesh_NelemSets' and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical :: inPart - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & - mesh_NelemSets = mesh_NelemSets + 1_pInt - enddo - -620 continue - if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) - -end subroutine mesh_abaqus_count_elementSets - - -!-------------------------------------------------------------------------------------------------- -! count overall number of solid sections sets in mesh (Abaqus only) -! -! mesh_Nmaterials -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_materials(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical inPart - - mesh_Nmaterials = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) & - mesh_Nmaterials = mesh_Nmaterials + 1_pInt - enddo - -620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) - -end subroutine mesh_abaqus_count_materials - - -!-------------------------------------------------------------------------------------------------- -! Build element set mapping -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt,i - logical :: inPart = .false. - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) - -610 FORMAT(A300) - - - rewind(fileUnit) - do - read (fileUnit,610,END=640) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) then - elemSet = elemSet + 1_pInt - mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'elset')) - mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& - mesh_mapElemSet,elemSet-1_pInt) - endif - enddo - -640 do i = 1_pInt,elemSet - if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) - enddo - -end subroutine mesh_abaqus_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -! map solid section (Abaqus only) -! -! allocate globals: mesh_nameMaterial, mesh_mapMaterial -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_materials(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c = 0_pInt - logical :: inPart = .false. - character(len=64) :: elemSetName,materialName - - allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' - allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then - - elemSetName = '' - materialName = '' - - do i = 3_pInt,chunkPos(1_pInt) - if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset') /= '') & - elemSetName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset')) - if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material') /= '') & - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) - enddo - - if (elemSetName /= '' .and. materialName /= '') then - c = c + 1_pInt - mesh_nameMaterial(c) = materialName ! name of material used for this section - mesh_mapMaterial(c) = elemSetName ! mapped to respective element set - endif - endif - enddo - -620 if (c==0_pInt) call IO_error(error_ID=905_pInt) - do i=1_pInt,c - if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905_pInt) - enddo - - end subroutine mesh_abaqus_map_materials - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_extractValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - integer(pInt) :: i,k - logical :: materialFound = .false. - character(len=64) ::materialName,elemSetName - - mesh_NcpElems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if (IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then - do i = 1_pInt,mesh_Nmaterials ! look thru material names - if (materialName == mesh_nameMaterial(i)) then ! found one - elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions - if (elemSetName == mesh_nameElemSet(k)) & ! matched? - mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) - -end subroutine mesh_abaqus_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) ::i,j,k,cpElem = 0_pInt - logical :: materialFound = .false. - character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then - do i = 1_pInt,mesh_Nmaterials ! look thru material names - if (materialName == mesh_nameMaterial(i)) then ! found one - elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions - if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,mesh_mapElemSet(1,k) - cpElem = cpElem + 1_pInt - mesh_mapFEtoCPelem(1,cpElem) = mesh_mapElemSet(1_pInt+j,k) ! store FE id - mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id - enddo - endif - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - - if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) - -end subroutine mesh_abaqus_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countDataLines, & - IO_intValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c,cpNode = 0_pInt - logical :: inPart = .false. - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - c = IO_countDataLines(fileUnit) - do i = 1_pInt,c - backspace(fileUnit) - enddo - do i = 1_pInt,c - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - cpNode = cpNode + 1_pInt - mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) - mesh_mapFEtoCPnode(2_pInt,cpNode) = cpNode - enddo - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - - if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) - -end subroutine mesh_abaqus_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_build_nodes(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_floatValue, & - IO_stringPos, & - IO_error, & - IO_countDataLines, & - IO_intValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m,c - logical :: inPart - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - c = IO_countDataLines(fileUnit) ! how many nodes are defined here? - do i = 1_pInt,c - backspace(fileUnit) ! rewind to first entry - enddo - do i = 1_pInt,c - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) - do j=1_pInt, 3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1_pInt) - enddo - enddo - endif - enddo - -670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) - mesh_node = mesh_node0 - -end subroutine mesh_abaqus_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue ,& - IO_error, & - IO_countDataLines, & - IO_intValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,c,t,g - logical :: inPart - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - endif - enddo - -620 end subroutine mesh_abaqus_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per elemen. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_extractValue, & - IO_floatValue, & - IO_countDataLines, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - - integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead - logical inPart,materialFound - character (len=64) :: materialName,elemSetName - character(len=300) :: line - - allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type - c = IO_countDataLines(fileUnit) - do i = 1_pInt,c - backspace(fileUnit) - enddo - do i = 1_pInt,c - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) ! limit to 64 nodes max - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & - call IO_error(191,el=t,ip=mesh_elemType) - mesh_elemType = t - mesh_element(2,e) = t ! elem type - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-1_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt+j)) ! put CP ids of nodes to position 5: - enddo - nNodesAlreadyRead = chunkPos(1) - 1_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - endif - enddo - - -620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" - - materialFound = .false. - do - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & - materialFound ) then - read (fileUnit,610,END=630) line ! read homogenization and microstructure - chunkPos = IO_stringPos(line) - homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) - micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) - do i = 1_pInt,mesh_Nmaterials ! look thru material names - if (materialName == mesh_nameMaterial(i)) then ! found one - elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions - if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,mesh_mapElemSet(1,k) - e = mesh_FEasCP('elem',mesh_mapElemSet(1+j,k)) - mesh_element(3,e) = homog ! store homogenization - mesh_element(4,e) = micro ! store microstructure - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),homog) - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),micro) - enddo - endif - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -630 end subroutine mesh_abaqus_build_elements -#endif !-------------------------------------------------------------------------------------------------- @@ -2807,12 +1444,6 @@ use IO, only: & implicit none integer(pInt), intent(in) :: fileUnit -#ifdef Spectral - mesh_periodicSurface = .true. - - end subroutine mesh_get_damaskOptions - -#else integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) chunk, Nchunks @@ -2820,12 +1451,7 @@ use IO, only: & character(len=300) :: keyword mesh_periodicSurface = .false. -#ifdef Marc4DAMASK keyword = '$damask' -#endif -#ifdef Abaqus - keyword = '**damask' -#endif rewind(fileUnit) do @@ -2849,7 +1475,6 @@ use IO, only: & 610 FORMAT(A300) 620 end subroutine mesh_get_damaskOptions -#endif !-------------------------------------------------------------------------------------------------- @@ -2925,7 +1550,7 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -#ifndef Spectral + !-------------------------------------------------------------------------------------------------- !> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' !-------------------------------------------------------------------------------------------------- @@ -3227,141 +1852,6 @@ subroutine mesh_build_ipNeighborhood enddo end subroutine mesh_build_ipNeighborhood -#endif - - -!-------------------------------------------------------------------------------------------------- -!> @brief write statistics regarding input file parsing to the output file -!-------------------------------------------------------------------------------------------------- -subroutine mesh_tell_statistics - use math, only: & - math_range - use IO, only: & - IO_error - use debug, only: & - debug_level, & - debug_MESH, & - debug_LEVELBASIC, & - debug_LEVELEXTENSIVE, & - debug_LEVELSELECTIVE, & - debug_e, & - debug_i - - implicit none - integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro - character(len=64) :: myFmt - integer(pInt) :: i,e,n,f,t,g,c, myDebug - - myDebug = debug_level(debug_mesh) - - if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified - if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified - - allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) - do e = 1_pInt,mesh_NcpElems - if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified - if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure - enddo -!$OMP CRITICAL (write2out) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - write(6,'(/,a,/)') ' Input Parser: STATISTICS' - write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' - write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' - write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' - write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' - write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' - write(6,*) - write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) - write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations - write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures - enddo - write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' - write(6,*) 'periodic surface : ', mesh_periodicSurface - write(6,*) - flush(6) - endif - - if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' - write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get elemType - g = FE_geomtype(t) ! get elemGeomType - c = FE_celltype(g) ! get cellType - write(6,'(i8,3(1x,i8))') e,t,g,c - enddo - write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' - write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) - write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) - do f = 1_pInt,FE_NipNeighbors(c) - write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) - enddo - enddo - enddo - write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' - write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i2)') e,i - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell - write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & - mesh_cellnode(1:3,mesh_cell(n,i,e)) - enddo - enddo - enddo - write(6,'(/,a)') 'Input Parser: IP COORDINATES' - write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) - enddo - enddo -#ifndef Spectral - write(6,'(/,a,/)') 'Input Parser: NODE TWINS' - write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' - do n = 1_pInt,mesh_Nnodes ! loop over cpNodes - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle - write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) - enddo -#endif - write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' - write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP - write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) - enddo - enddo - enddo - endif -!$OMP END CRITICAL (write2out) - -end subroutine mesh_tell_statistics !-------------------------------------------------------------------------------------------------- From f6cd37f11adadd55175a094c8c987eac517228c4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:12:27 +0100 Subject: [PATCH 017/309] removing non-grid(spectral) related functionality --- src/mesh_grid.f90 | 2001 +-------------------------------------------- 1 file changed, 7 insertions(+), 1994 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index e55165d51..7cf7a1e64 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -62,12 +62,6 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) -#if defined(Marc4DAMASK) || defined(Abaqus) - integer(pInt), private :: & - mesh_maxNelemInSet, & - mesh_Nmaterials -#endif - integer(pInt), dimension(2), private :: & mesh_maxValStateVar = 0_pInt @@ -344,7 +338,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) -#if defined(Spectral) + integer(pInt), dimension(3), public, protected :: & grid !< (global) grid integer(pInt), public, protected :: & @@ -356,31 +350,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & real(pReal), public, protected :: & size3, & !< (local) size in 3rd direction size3offset !< (local) size offset in 3rd direction -#elif defined(Marc4DAMASK) || defined(Abaqus) - integer(pInt), private :: & - mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) - mesh_maxNnodes, & !< max number of nodes in any CP element - mesh_NelemSets - character(len=64), dimension(:), allocatable, private :: & - mesh_nameElemSet, & !< names of elementSet - mesh_nameMaterial, & !< names of material in solid section - mesh_mapMaterial !< name of elementSet for material - integer(pInt), dimension(:,:), allocatable, private :: & - mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(:,:), allocatable, target, private :: & - mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] - mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] -#endif -#if defined(Marc4DAMASK) - integer(pInt), private :: & - MarcVersion, & !< Version of input file format (Marc only) - hypoelasticTableStyle, & !< Table style (Marc only) - initialcondTableStyle !< Table style (Marc only) - integer(pInt), dimension(:), allocatable, private :: & - Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) -#elif defined(Abaqus) - logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information -#endif public :: & mesh_init, & @@ -391,59 +360,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_Ncellnodes, & mesh_get_unitlength, & mesh_get_nodeAtIP, & -#if defined(Spectral) + mesh_spectral_getGrid, & mesh_spectral_getSize -#elif defined(Marc4DAMASK) || defined(Abaqus) - mesh_FEasCP -#endif private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_tell_statistics, & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & -#if defined(Spectral) mesh_spectral_getHomogenization, & mesh_spectral_count, & mesh_spectral_count_cpSizes, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood -#elif defined(Marc4DAMASK) || defined(Abaqus) - mesh_build_nodeTwins, & - mesh_build_sharedElems, & - mesh_build_ipNeighborhood, & -#endif -#if defined(Marc4DAMASK) - mesh_marc_get_fileFormat, & - mesh_marc_get_tableStyles, & - mesh_marc_get_matNumber, & - mesh_marc_count_nodesAndElements, & - mesh_marc_count_elementSets, & - mesh_marc_map_elementSets, & - mesh_marc_count_cpElements, & - mesh_marc_map_Elements, & - mesh_marc_map_nodes, & - mesh_marc_build_nodes, & - mesh_marc_count_cpSizes, & - mesh_marc_build_elements -#elif defined(Abaqus) - mesh_abaqus_count_nodesAndElements, & - mesh_abaqus_count_elementSets, & - mesh_abaqus_count_materials, & - mesh_abaqus_map_elementSets, & - mesh_abaqus_map_materials, & - mesh_abaqus_count_cpElements, & - mesh_abaqus_map_elements, & - mesh_abaqus_map_nodes, & - mesh_abaqus_build_nodes, & - mesh_abaqus_count_cpSizes, & - mesh_abaqus_build_elements -#endif + contains @@ -458,21 +392,14 @@ subroutine mesh_init(ip,el) compiler_version, & compiler_options #endif -#ifdef Spectral + #include use PETScsys -#endif + use DAMASK_interface use IO, only: & -#ifdef Abaqus - IO_abaqus_hasNoPart, & -#endif -#ifdef Spectral IO_open_file, & IO_error, & -#else - IO_open_InputFile, & -#endif IO_timeStamp, & IO_error, & IO_write_jobFile @@ -487,19 +414,13 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & -#ifndef Spectral - modelName, & - calcMode, & -#endif FEsolving_execElem, & FEsolving_execIP implicit none -#ifdef Spectral include 'fftw3-mpi.f03' integer(C_INTPTR_T) :: devNull, local_K, local_K_offset integer :: ierr, worldsize -#endif integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), intent(in), optional :: el, ip integer(pInt) :: j @@ -514,7 +435,6 @@ subroutine mesh_init(ip,el) myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) -#ifdef Spectral call fftw_mpi_init() call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) @@ -543,63 +463,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) call mesh_spectral_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Marc4DAMASK - call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... - if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - call mesh_marc_get_fileFormat(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) - call mesh_marc_get_tableStyles(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) - if (MarcVersion > 12) then - call mesh_marc_get_matNumber(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) - endif - call mesh_marc_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_marc_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_marc_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_marc_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_marc_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_marc_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_marc_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_marc_count_cpSizes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) - call mesh_marc_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Abaqus - call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... - if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - noPart = IO_abaqus_hasNoPart(FILEUNIT) - call mesh_abaqus_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_abaqus_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_abaqus_count_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) - call mesh_abaqus_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_abaqus_map_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) - call mesh_abaqus_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_abaqus_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_abaqus_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_abaqus_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_abaqus_count_cpSizes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) - call mesh_abaqus_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#endif - call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -614,25 +477,10 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) close (FILEUNIT) -#if defined(Marc4DAMASK) || defined(Abaqus) - call mesh_build_nodeTwins - if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) - call mesh_build_sharedElems - if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) - call mesh_build_ipNeighborhood -#else call mesh_spectral_build_ipNeighborhood -#endif + if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (worldrank == 0_pInt) then - call mesh_tell_statistics - endif - -#if defined(Marc4DAMASK) || defined(Abaqus) - if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & - call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements -#endif if (debug_e < 1 .or. debug_e > mesh_NcpElems) & call IO_error(602_pInt,ext_msg='element') ! selected element does not exist if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & @@ -642,11 +490,6 @@ subroutine mesh_init(ip,el) allocate(FEsolving_execIP(2_pInt,mesh_NcpElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element -#if defined(Marc4DAMASK) || defined(Abaqus) - allocate(calcMode(mesh_maxNips,mesh_NcpElems)) - calcMode = .false. ! pretend to have collected what first call is asking (F = I) - calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" -#endif !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. @@ -661,58 +504,6 @@ subroutine mesh_init(ip,el) end subroutine mesh_init - -#if defined(Marc4DAMASK) || defined(Abaqus) -!-------------------------------------------------------------------------------------------------- -!> @brief Gives the FE to CP ID mapping by binary search through lookup array -!! valid questions (what) are 'elem', 'node' -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) - use IO, only: & - IO_lc - - implicit none - character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID - - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center - - mesh_FEasCP = 0_pInt - select case(IO_lc(what(1:4))) - case('elem') - lookupMap => mesh_mapFEtoCPelem - case('node') - lookupMap => mesh_mapFEtoCPnode - case default - return - endselect - - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),pInt) - - if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2_pInt,lower) - return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) - return - endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then - lower = center - elseif (lookupMap(1_pInt,center) > myID) then - upper = center - else - mesh_FEasCP = lookupMap(2_pInt,center) - exit - endif - enddo binarySearch - -end function mesh_FEasCP -#endif - !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. !> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). @@ -953,7 +744,6 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates -#ifdef Spectral !-------------------------------------------------------------------------------------------------- !> @brief Reads grid information from geometry file. If fileUnit is given, !! assumes an opened file, otherwise tries to open the one specified in geometryFile @@ -1492,1306 +1282,6 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) nodes = nodes/8.0_pReal end function mesh_nodesAroundCentres -#endif - -#ifdef Marc4DAMASK -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out version of Marc input file format and stores ist as MarcVersion -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_fileFormat(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - MarcVersion = IO_intValue(line,chunkPos,2_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_fileFormat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and -!! 'hypoelasticTableStyle' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_tableStyles(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - initialcondTableStyle = 0_pInt - hypoelasticTableStyle = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then - initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) - hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_tableStyles - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_matNumber(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, j, data_blocks - character(len=300) line - -610 FORMAT(A300) - - rewind(fileUnit) - - data_blocks = 1_pInt - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - read (fileUnit,610,END=620) line - if (len(trim(line))/=0_pInt) then - chunkPos = IO_stringPos(line) - data_blocks = IO_intValue(line,chunkPos,1_pInt) - endif - allocate(Marc_matNumber(data_blocks)) - do i=1_pInt,data_blocks ! read all data blocks - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block - read (fileUnit,610,END=620) line - enddo - enddo - exit - endif - enddo - -620 end subroutine mesh_marc_get_matNumber - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores the numbers in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_nodesAndElements(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_IntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) - exit ! assumes that "coordinates" comes later in file - endif - enddo - -620 end subroutine mesh_marc_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- - subroutine mesh_marc_count_elementSets(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then - mesh_NelemSets = mesh_NelemSets + 1_pInt - mesh_maxNelemInSet = max(mesh_maxNelemInSet, & - IO_countContinuousIntValues(fileUnit)) - endif - enddo - -620 end subroutine mesh_marc_count_elementSets - - -!******************************************************************** -! map element sets -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!******************************************************************** -subroutine mesh_marc_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=640) line - chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then - elemSet = elemSet+1_pInt - mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mesh_mapElemSet(:,elemSet) = & - IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - endif - enddo - -640 end subroutine mesh_marc_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues, & - IO_error, & - IO_intValue, & - IO_countNumericalDataLines - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i - character(len=300):: line - - mesh_NcpElems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines - read (fileUnit,610,END=620) line - enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update - exit - endif - enddo - else ! Marc2017 and later - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) - endif - endif - enddo - end if - -620 end subroutine mesh_marc_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line, & - tmp - - integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,cpElem = 0_pInt - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - -610 FORMAT(A300) - - contInts = 0_pInt - rewind(fileUnit) - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - if (MarcVersion < 13) then ! Marc 2016 or earlier - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines - read (fileUnit,610,END=660) line - enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& - mesh_mapElemSet,mesh_NelemSets) - exit - endif - else ! Marc2017 and later - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),"0123456789")/=0) then ! found keyword - exit - else - contInts(1) = contInts(1) + 1_pInt - read (tmp,*) contInts(contInts(1)+1) - endif - enddo - endif - endif - endif - enddo -660 do i = 1_pInt,contInts(1) - cpElem = cpElem+1_pInt - mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) - mesh_mapFEtoCPelem(2,cpElem) = cpElem - enddo - -call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - -end subroutine mesh_marc_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt) :: i - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - -610 FORMAT(A300) - - node_count = 0_pInt - - rewind(fileUnit) - do - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=650) line ! skip crap line - do i = 1_pInt,mesh_Nnodes - read (fileUnit,610,END=650) line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) - mesh_mapFEtoCPnode(2_pInt,i) = i - enddo - exit - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - -end subroutine mesh_marc_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_nodes(fileUnit) - - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue, & - IO_fixedNoEFloatValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=670) line ! skip crap line - do i=1_pInt,mesh_Nnodes - read (fileUnit,610,END=670) line - m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) - do j = 1_pInt,3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) - enddo - enddo - exit - endif - enddo - -670 mesh_node = mesh_node0 - -end subroutine mesh_marc_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_intValue, & - IO_skipChunks - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,t,g,e,c - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - -610 FORMAT(A300) - rewind(fileUnit) - do - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=630) line ! Garbage line - do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) ! limit to id and type - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line - endif - enddo - exit - endif - enddo - -630 end subroutine mesh_marc_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per element. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_fixedNoEFloatValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead - - allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=620) line ! garbage line - do i = 1_pInt,mesh_Nelems - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & - call IO_error(191,el=t,ip=mesh_elemType) - mesh_elemType = t - mesh_element(2,e) = t - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-2_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes - enddo - nNodesAlreadyRead = chunkPos(1) - 2_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - exit - endif - enddo - -620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,610,END=620) line - do - chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then - if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style - read (fileUnit,610,END=630) line ! read line with index of state var - chunkPos = IO_stringPos(line) - sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index - if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest - read (fileUnit,610,END=620) line ! read line with value of state var - chunkPos = IO_stringPos(line) - do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? - myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value - mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index - if (initialcondTableStyle == 2_pInt) then - read (fileUnit,610,END=630) line ! read extra line - read (fileUnit,610,END=630) line ! read extra line - endif - contInts = IO_continuousIntValues& ! get affected elements - (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - do i = 1_pInt,contInts(1) - e = mesh_FEasCP('elem',contInts(1_pInt+i)) - mesh_element(1_pInt+sv,e) = myVal - enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - enddo - endif - else - read (fileUnit,610,END=630) line - endif - enddo - -630 end subroutine mesh_marc_build_elements -#endif - -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_nodesAndElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countDataLines, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical :: inPart - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if (inPart .or. noPart) then - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) - case('*node') - if( & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & - ) & - mesh_Nnodes = mesh_Nnodes + IO_countDataLines(fileUnit) - case('*element') - if( & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & - ) then - mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) - endif - endselect - endif - enddo - -620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) - if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) - -end subroutine mesh_abaqus_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief count overall number of element sets in mesh and write 'mesh_NelemSets' and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical :: inPart - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & - mesh_NelemSets = mesh_NelemSets + 1_pInt - enddo - -620 continue - if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) - -end subroutine mesh_abaqus_count_elementSets - - -!-------------------------------------------------------------------------------------------------- -! count overall number of solid sections sets in mesh (Abaqus only) -! -! mesh_Nmaterials -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_materials(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical inPart - - mesh_Nmaterials = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) & - mesh_Nmaterials = mesh_Nmaterials + 1_pInt - enddo - -620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) - -end subroutine mesh_abaqus_count_materials - - -!-------------------------------------------------------------------------------------------------- -! Build element set mapping -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt,i - logical :: inPart = .false. - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) - -610 FORMAT(A300) - - - rewind(fileUnit) - do - read (fileUnit,610,END=640) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) then - elemSet = elemSet + 1_pInt - mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'elset')) - mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& - mesh_mapElemSet,elemSet-1_pInt) - endif - enddo - -640 do i = 1_pInt,elemSet - if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) - enddo - -end subroutine mesh_abaqus_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -! map solid section (Abaqus only) -! -! allocate globals: mesh_nameMaterial, mesh_mapMaterial -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_materials(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c = 0_pInt - logical :: inPart = .false. - character(len=64) :: elemSetName,materialName - - allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' - allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then - - elemSetName = '' - materialName = '' - - do i = 3_pInt,chunkPos(1_pInt) - if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset') /= '') & - elemSetName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset')) - if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material') /= '') & - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) - enddo - - if (elemSetName /= '' .and. materialName /= '') then - c = c + 1_pInt - mesh_nameMaterial(c) = materialName ! name of material used for this section - mesh_mapMaterial(c) = elemSetName ! mapped to respective element set - endif - endif - enddo - -620 if (c==0_pInt) call IO_error(error_ID=905_pInt) - do i=1_pInt,c - if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905_pInt) - enddo - - end subroutine mesh_abaqus_map_materials - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_extractValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - integer(pInt) :: i,k - logical :: materialFound = .false. - character(len=64) ::materialName,elemSetName - - mesh_NcpElems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if (IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then - do i = 1_pInt,mesh_Nmaterials ! look thru material names - if (materialName == mesh_nameMaterial(i)) then ! found one - elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions - if (elemSetName == mesh_nameElemSet(k)) & ! matched? - mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) - -end subroutine mesh_abaqus_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) ::i,j,k,cpElem = 0_pInt - logical :: materialFound = .false. - character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then - do i = 1_pInt,mesh_Nmaterials ! look thru material names - if (materialName == mesh_nameMaterial(i)) then ! found one - elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions - if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,mesh_mapElemSet(1,k) - cpElem = cpElem + 1_pInt - mesh_mapFEtoCPelem(1,cpElem) = mesh_mapElemSet(1_pInt+j,k) ! store FE id - mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id - enddo - endif - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - - if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) - -end subroutine mesh_abaqus_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countDataLines, & - IO_intValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c,cpNode = 0_pInt - logical :: inPart = .false. - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - c = IO_countDataLines(fileUnit) - do i = 1_pInt,c - backspace(fileUnit) - enddo - do i = 1_pInt,c - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - cpNode = cpNode + 1_pInt - mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) - mesh_mapFEtoCPnode(2_pInt,cpNode) = cpNode - enddo - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - - if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) - -end subroutine mesh_abaqus_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_build_nodes(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_floatValue, & - IO_stringPos, & - IO_error, & - IO_countDataLines, & - IO_intValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m,c - logical :: inPart - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - c = IO_countDataLines(fileUnit) ! how many nodes are defined here? - do i = 1_pInt,c - backspace(fileUnit) ! rewind to first entry - enddo - do i = 1_pInt,c - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) - do j=1_pInt, 3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1_pInt) - enddo - enddo - endif - enddo - -670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) - mesh_node = mesh_node0 - -end subroutine mesh_abaqus_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue ,& - IO_error, & - IO_countDataLines, & - IO_intValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,c,t,g - logical :: inPart - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - endif - enddo - -620 end subroutine mesh_abaqus_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per elemen. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_extractValue, & - IO_floatValue, & - IO_countDataLines, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - - integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead - logical inPart,materialFound - character (len=64) :: materialName,elemSetName - character(len=300) :: line - - allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type - c = IO_countDataLines(fileUnit) - do i = 1_pInt,c - backspace(fileUnit) - enddo - do i = 1_pInt,c - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) ! limit to 64 nodes max - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & - call IO_error(191,el=t,ip=mesh_elemType) - mesh_elemType = t - mesh_element(2,e) = t ! elem type - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-1_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt+j)) ! put CP ids of nodes to position 5: - enddo - nNodesAlreadyRead = chunkPos(1) - 1_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - endif - enddo - - -620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" - - materialFound = .false. - do - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & - materialFound ) then - read (fileUnit,610,END=630) line ! read homogenization and microstructure - chunkPos = IO_stringPos(line) - homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) - micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) - do i = 1_pInt,mesh_Nmaterials ! look thru material names - if (materialName == mesh_nameMaterial(i)) then ! found one - elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions - if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,mesh_mapElemSet(1,k) - e = mesh_FEasCP('elem',mesh_mapElemSet(1+j,k)) - mesh_element(3,e) = homog ! store homogenization - mesh_element(4,e) = micro ! store microstructure - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),homog) - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),micro) - enddo - endif - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -630 end subroutine mesh_abaqus_build_elements -#endif !-------------------------------------------------------------------------------------------------- @@ -2807,50 +1297,11 @@ use IO, only: & implicit none integer(pInt), intent(in) :: fileUnit -#ifdef Spectral + mesh_periodicSurface = .true. end subroutine mesh_get_damaskOptions -#else - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword - - mesh_periodicSurface = .false. -#ifdef Marc4DAMASK - keyword = '$damask' -#endif -#ifdef Abaqus - keyword = '**damask' -#endif - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(damaskOption) - case('periodic') ! damask Option that allows to specify periodic fluxes - do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) - v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? - mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' - mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' - mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' - enddo - endselect - endif - enddo - -610 FORMAT(A300) - -620 end subroutine mesh_get_damaskOptions -#endif - !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' @@ -2925,444 +1376,6 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -#ifndef Spectral -!-------------------------------------------------------------------------------------------------- -!> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_nodeTwins - - implicit none - integer(pInt) dir, & ! direction of periodicity - node, & - minimumNode, & - maximumNode, & - n1, & - n2 - integer(pInt), dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes - real(pReal) minCoord, maxCoord, & ! extreme positions in one dimension - tolerance ! tolerance below which positions are assumed identical - real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates - logical, dimension(mesh_Nnodes) :: unpaired - - allocate(mesh_nodeTwins(3,mesh_Nnodes)) - mesh_nodeTwins = 0_pInt - - tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal - - do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z - if (mesh_periodicSurface(dir)) then ! only if periodicity is requested - - - !*** find out which nodes sit on the surface - !*** and have a minimum or maximum position in this dimension - - minimumNodes = 0_pInt - maximumNodes = 0_pInt - minCoord = minval(mesh_node0(dir,:)) - maxCoord = maxval(mesh_node0(dir,:)) - do node = 1_pInt,mesh_Nnodes ! loop through all nodes and find surface nodes - if (abs(mesh_node0(dir,node) - minCoord) <= tolerance) then - minimumNodes(1) = minimumNodes(1) + 1_pInt - minimumNodes(minimumNodes(1)+1_pInt) = node - elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then - maximumNodes(1) = maximumNodes(1) + 1_pInt - maximumNodes(maximumNodes(1)+1_pInt) = node - endif - enddo - - - !*** find the corresponding node on the other side with the same position in this dimension - - unpaired = .true. - do n1 = 1_pInt,minimumNodes(1) - minimumNode = minimumNodes(n1+1_pInt) - if (unpaired(minimumNode)) then - do n2 = 1_pInt,maximumNodes(1) - maximumNode = maximumNodes(n2+1_pInt) - distance = abs(mesh_node0(:,minimumNode) - mesh_node0(:,maximumNode)) - if (sum(distance) - distance(dir) <= tolerance) then ! minimum possible distance (within tolerance) - mesh_nodeTwins(dir,minimumNode) = maximumNode - mesh_nodeTwins(dir,maximumNode) = minimumNode - unpaired(maximumNode) = .false. ! remember this node, we don't have to look for his partner again - exit - endif - enddo - endif - enddo - - endif - enddo - -end subroutine mesh_build_nodeTwins - - -!-------------------------------------------------------------------------------------------------- -!> @brief get maximum count of shared elements among cpElements and build list of elements shared -!! by each node in mesh. Allocate globals '_maxNsharedElems' and '_sharedElem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_sharedElems - - implicit none - integer(pint) e, & ! element index - g, & ! element type - node, & ! CP node index - n, & ! node index per element - myDim, & ! dimension index - nodeTwin ! node twin in the specified dimension - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt), dimension(:), allocatable :: node_seen - - allocate(node_seen(maxval(FE_NmatchingNodes))) - - node_count = 0_pInt - - do e = 1_pInt,mesh_NcpElems - g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType - node_seen = 0_pInt ! reset node duplicates - do n = 1_pInt,FE_NmatchingNodes(g) ! check each node of element - node = mesh_element(4+n,e) - if (all(node_seen /= node)) then - node_count(node) = node_count(node) + 1_pInt ! if FE node not yet encountered -> count it - do myDim = 1_pInt,3_pInt ! check in each dimension... - nodeTwin = mesh_nodeTwins(myDim,node) - if (nodeTwin > 0_pInt) & ! if I am a twin of some node... - node_count(nodeTwin) = node_count(nodeTwin) + 1_pInt ! -> count me again for the twin node - enddo - endif - node_seen(n) = node ! remember this node to be counted already - enddo - enddo - - mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node - - allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) - - do e = 1_pInt,mesh_NcpElems - g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType - node_seen = 0_pInt - do n = 1_pInt,FE_NmatchingNodes(g) - node = mesh_element(4_pInt+n,e) - if (all(node_seen /= node)) then - mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1_pInt ! count for each node the connected elements - mesh_sharedElem(mesh_sharedElem(1,node)+1_pInt,node) = e ! store the respective element id - do myDim = 1_pInt,3_pInt ! check in each dimension... - nodeTwin = mesh_nodeTwins(myDim,node) - if (nodeTwin > 0_pInt) then ! if i am a twin of some node... - mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1_pInt ! ...count me again for the twin - mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id - endif - enddo - endif - node_seen(n) = node - enddo - enddo - -end subroutine mesh_build_sharedElems - - -!-------------------------------------------------------------------------------------------------- -!> @brief build up of IP neighborhood, allocate globals '_ipNeighborhood' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_ipNeighborhood - use math, only: & - math_mul3x3 - - implicit none - integer(pInt) :: myElem, & ! my CP element index - myIP, & - myType, & ! my element type - myFace, & - neighbor, & ! neighor index - neighboringIPkey, & ! positive integer indicating the neighboring IP (for intra-element) and negative integer indicating the face towards neighbor (for neighboring element) - candidateIP, & - neighboringType, & ! element type of neighbor - NlinkedNodes, & ! number of linked nodes - twin_of_linkedNode, & ! node twin of a specific linkedNode - NmatchingNodes, & ! number of matching nodes - dir, & ! direction of periodicity - matchingElem, & ! CP elem number of matching element - matchingFace, & ! face ID of matching element - a, anchor, & - neighboringIP, & - neighboringElem, & - pointingToMe - integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & - linkedNodes = 0_pInt, & - matchingNodes - logical checkTwins - - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) - mesh_ipNeighborhood = 0_pInt - - - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems - myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem - - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP - neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) - - !*** if the key is positive, the neighbor is inside the element - !*** that means, we have already found our neighboring IP - - if (neighboringIPkey > 0_pInt) then - mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem - mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey - - - !*** if the key is negative, the neighbor resides in a neighboring element - !*** that means, we have to look through the face indicated by the key and see which element is behind that face - - elseif (neighboringIPkey < 0_pInt) then ! neighboring element's IP - myFace = -neighboringIPkey - call mesh_faceMatch(myElem, myFace, matchingElem, matchingFace) ! get face and CP elem id of face match - if (matchingElem > 0_pInt) then ! found match? - neighboringType = FE_geomtype(mesh_element(2,matchingElem)) - - !*** trivial solution if neighbor has only one IP - - if (FE_Nips(neighboringType) == 1_pInt) then - mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem - mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt - cycle - endif - - !*** find those nodes which build the link to the neighbor - - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face - anchor = FE_nodesAtIP(a,myIP,myType) - if (anchor /= 0_pInt) then ! valid anchor node - if (any(FE_face(:,myFace,myType) == anchor)) then ! ip anchor sits on face? - NlinkedNodes = NlinkedNodes + 1_pInt - linkedNodes(NlinkedNodes) = mesh_element(4_pInt+anchor,myElem) ! CP id of anchor node - else ! something went wrong with the linkage, since not all anchors sit on my face - NlinkedNodes = 0_pInt - linkedNodes = 0_pInt - exit - endif - endif - enddo - - !*** loop through the ips of my neighbor - !*** and try to find an ip with matching nodes - !*** also try to match with node twins - - checkCandidateIP: do candidateIP = 1_pInt,FE_Nips(neighboringType) - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip - anchor = FE_nodesAtIP(a,candidateIP,neighboringType) - if (anchor /= 0_pInt) then ! valid anchor node - if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? - NmatchingNodes = NmatchingNodes + 1_pInt - matchingNodes(NmatchingNodes) = mesh_element(4+anchor,matchingElem) ! CP id of neighbor's anchor node - else ! no matching, because not all nodes sit on the matching face - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt - exit - endif - endif - enddo - - if (NmatchingNodes /= NlinkedNodes) & ! this ip has wrong count of anchors on face - cycle checkCandidateIP - - !*** check "normal" nodes whether they match or not - - checkTwins = .false. - do a = 1_pInt,NlinkedNodes - if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode - checkTwins = .true. - exit ! no need to search further - endif - enddo - - !*** if no match found, then also check node twins - - if(checkTwins) then - dir = int(maxloc(abs(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem)),1),pInt) ! check for twins only in direction of the surface normal - do a = 1_pInt,NlinkedNodes - twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) - if (twin_of_linkedNode == 0_pInt .or. & ! twin of linkedNode does not exist... - all(matchingNodes /= twin_of_linkedNode)) then ! ... or it does not match any matchingNode - cycle checkCandidateIP ! ... then check next candidateIP - endif - enddo - endif - - !*** we found a match !!! - - mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem - mesh_ipNeighborhood(2,neighbor,myIP,myElem) = candidateIP - exit checkCandidateIP - enddo checkCandidateIP - endif ! end of valid external matching - endif ! end of internal/external matching - enddo - enddo - enddo - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems - myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP - neighboringElem = mesh_ipNeighborhood(1,neighbor,myIP,myElem) - neighboringIP = mesh_ipNeighborhood(2,neighbor,myIP,myElem) - if (neighboringElem > 0_pInt .and. neighboringIP > 0_pInt) then ! if neighbor exists ... - neighboringType = FE_geomtype(mesh_element(2,neighboringElem)) - do pointingToMe = 1_pInt,FE_NipNeighbors(FE_celltype(neighboringType)) ! find neighboring index that points from my neighbor to myself - if ( myElem == mesh_ipNeighborhood(1,pointingToMe,neighboringIP,neighboringElem) & - .and. myIP == mesh_ipNeighborhood(2,pointingToMe,neighboringIP,neighboringElem)) then ! possible candidate - if (math_mul3x3(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem),& - mesh_ipAreaNormal(1:3,pointingToMe,neighboringIP,neighboringElem)) < 0.0_pReal) then ! area normals have opposite orientation (we have to check that because of special case for single element with two ips and periodicity. In this case the neighbor is identical in two different directions.) - mesh_ipNeighborhood(3,neighbor,myIP,myElem) = pointingToMe ! found match - exit ! so no need to search further - endif - endif - enddo - endif - enddo - enddo - enddo - -end subroutine mesh_build_ipNeighborhood -#endif - - -!-------------------------------------------------------------------------------------------------- -!> @brief write statistics regarding input file parsing to the output file -!-------------------------------------------------------------------------------------------------- -subroutine mesh_tell_statistics - use math, only: & - math_range - use IO, only: & - IO_error - use debug, only: & - debug_level, & - debug_MESH, & - debug_LEVELBASIC, & - debug_LEVELEXTENSIVE, & - debug_LEVELSELECTIVE, & - debug_e, & - debug_i - - implicit none - integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro - character(len=64) :: myFmt - integer(pInt) :: i,e,n,f,t,g,c, myDebug - - myDebug = debug_level(debug_mesh) - - if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified - if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified - - allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) - do e = 1_pInt,mesh_NcpElems - if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified - if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure - enddo -!$OMP CRITICAL (write2out) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - write(6,'(/,a,/)') ' Input Parser: STATISTICS' - write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' - write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' - write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' - write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' - write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' - write(6,*) - write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) - write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations - write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures - enddo - write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' - write(6,*) 'periodic surface : ', mesh_periodicSurface - write(6,*) - flush(6) - endif - - if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' - write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get elemType - g = FE_geomtype(t) ! get elemGeomType - c = FE_celltype(g) ! get cellType - write(6,'(i8,3(1x,i8))') e,t,g,c - enddo - write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' - write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) - write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) - do f = 1_pInt,FE_NipNeighbors(c) - write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) - enddo - enddo - enddo - write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' - write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i2)') e,i - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell - write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & - mesh_cellnode(1:3,mesh_cell(n,i,e)) - enddo - enddo - enddo - write(6,'(/,a)') 'Input Parser: IP COORDINATES' - write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) - enddo - enddo -#ifndef Spectral - write(6,'(/,a,/)') 'Input Parser: NODE TWINS' - write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' - do n = 1_pInt,mesh_Nnodes ! loop over cpNodes - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle - write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) - enddo -#endif - write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' - write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP - write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) - enddo - enddo - enddo - endif -!$OMP END CRITICAL (write2out) - -end subroutine mesh_tell_statistics - !-------------------------------------------------------------------------------------------------- !> @brief mapping of FE element types to internal representation From 55845d222df2796ba6e6b1482dd9f5ae343257db Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:13:40 +0100 Subject: [PATCH 018/309] function was removed --- src/mesh_marc.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index b993b43d6..aa7d77b77 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -380,7 +380,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_tell_statistics, & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & From badf9e9cca1994221ce2e7e1551384c8c1e9c090 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:24:10 +0100 Subject: [PATCH 019/309] object oriented element definitions --- src/CMakeLists.txt | 16 +- src/commercialFEM_fileList.f90 | 1 + src/element.f90 | 908 +++++++++++++++++++++++++++++++++ 3 files changed, 919 insertions(+), 6 deletions(-) create mode 100644 src/element.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3818130da..a09ae4766 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -17,6 +17,10 @@ list(APPEND OBJECTFILES $) add_library(PREC OBJECT "prec.f90") list(APPEND OBJECTFILES $) +add_library(ELEMENT OBJECT "element.f90") +add_dependencies(ELEMENT PREC) +list(APPEND OBJECTFILES $) + add_library(QUIT OBJECT "quit.f90") add_dependencies(QUIT PREC) list(APPEND OBJECTFILES $) @@ -53,21 +57,21 @@ add_library(FEsolving OBJECT "FEsolving.f90") add_dependencies(FEsolving RESULTS) list(APPEND OBJECTFILES $) -add_library(DAMASK_MATH OBJECT "math.f90") -add_dependencies(DAMASK_MATH FEsolving) -list(APPEND OBJECTFILES $) +add_library(MATH OBJECT "math.f90") +add_dependencies(MATH FEsolving) +list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh_grid.f90") - add_dependencies(MESH DAMASK_MATH) + add_dependencies(MESH MATH ELEMENT) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") - add_dependencies(FEZoo DAMASK_MATH) + add_dependencies(FEZoo MATH) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "mesh_FEM.f90") - add_dependencies(MESH FEZoo) + add_dependencies(MESH FEZoo ELEMENT) list(APPEND OBJECTFILES $) endif() diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index a7a61c2f7..7a32e7ade 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -12,6 +12,7 @@ #endif #include "math.f90" #include "FEsolving.f90" +#include "element.f90" #ifdef Abaqus #include "mesh_abaqus.f90" #endif diff --git a/src/element.f90 b/src/element.f90 new file mode 100644 index 000000000..146f24d51 --- /dev/null +++ b/src/element.f90 @@ -0,0 +1,908 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!-------------------------------------------------------------------------------------------------- +module element + use prec, only: & + pInt, & + pReal + + implicit none + private + +!--------------------------------------------------------------------------------------------------- +!> Properties of a single element (the element used in the mesh) +!--------------------------------------------------------------------------------------------------- + type, public :: tElement + integer(pInt) :: & + elemType, & + geomType, & ! geometry type (same for same dimension and same number of integration points) + cellType, & + Nnodes, & + Ncellnodes, & + NcellnodesPerCell, & + nIPs, & + nIPneighbors, & ! ToDo: MD: Do all IPs in one element type have the same number of neighbors? + maxNnodeAtIP + integer(pInt), dimension(:,:), allocatable :: & + Cell, & ! intra-element (cell) nodes that constitute a cell + NnodeAtIP, & + IPneighbor, & + cellFace + real(pReal), dimension(:,:), allocatable :: & + ! center of gravity of the weighted nodes gives the position of the cell node. + ! example: face-centered cell node with face nodes 1,2,5,6 to be used in, + ! e.g., an 8 node element, would be encoded: + ! 1, 1, 0, 0, 1, 1, 0, 0 + cellNodeParentNodeWeights + contains + procedure :: init => tElement_init + end type + + integer(pInt), parameter, private :: & + NELEMTYPE = 13_pInt + + integer(pInt), dimension(NelemType), parameter, private :: NNODE = & + int([ & + 3, & ! 2D 3node 1ip + 6, & ! 2D 6node 3ip + 4, & ! 2D 4node 4ip + 8, & ! 2D 8node 9ip + 8, & ! 2D 8node 4ip + !-------------------- + 4, & ! 3D 4node 1ip + 5, & ! 3D 5node 4ip + 10, & ! 3D 10node 4ip + 6, & ! 3D 6node 6ip + 8, & ! 3D 8node 1ip + 8, & ! 3D 8node 8ip + 20, & ! 3D 20node 8ip + 20 & ! 3D 20node 27ip + ],pInt) !< number of nodes that constitute a specific type of element + + integer(pInt), dimension(NelemType), parameter, public :: GEOMTYPE = & + int([ & + 1, & ! 2D 3node 1ip + 2, & ! 2D 6node 3ip + 3, & ! 2D 4node 4ip + 4, & ! 2D 8node 9ip + 3, & ! 2D 8node 4ip + !-------------------- + 5, & ! 3D 4node 1ip + 6, & ! 3D 5node 4ip + 6, & ! 3D 10node 4ip + 7, & ! 3D 6node 6ip + 8, & ! 3D 8node 1ip + 9, & ! 3D 8node 8ip + 9, & ! 3D 20node 8ip + 10 & ! 3D 20node 27ip + ],pInt) !< geometry type of particular element type + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: NCELLNODE = & ! Intel 16.0 complains + integer(pInt), dimension(10), parameter, private :: NCELLNODE = & + int([ & + 3, & + 7, & + 9, & + 16, & + 4, & + 15, & + 21, & + 8, & + 27, & + 64 & + ],pInt) !< number of cell nodes in a specific geometry type + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: NIP = & ! Intel 16.0 complains + integer(pInt), dimension(10), parameter, private :: NIP = & + int([ & + 1, & + 3, & + 4, & + 9, & + 1, & + 4, & + 6, & + 1, & + 8, & + 27 & + ],pInt) !< number of IPs in a specific geometry type + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: CELLTYPE = & ! Intel 16.0 complains + integer(pInt), dimension(10), parameter, private :: CELLTYPE = & !< cell type that is used by each geometry type + int([ & + 1, & ! 2D 3node + 2, & ! 2D 4node + 2, & ! 2D 4node + 2, & ! 2D 4node + 3, & ! 3D 4node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4 & ! 3D 8node + ],pInt) + + !integer(pInt), dimension(maxval(cellType)), parameter, private :: nIPNeighbor = & ! causes problem with Intel 16.0 + integer(pInt), dimension(4), parameter, private :: NIPNEIGHBOR = & !< number of ip neighbors / cell faces in a specific cell type + int([& + 3, & ! 2D 3node + 4, & ! 2D 4node + 4, & ! 3D 4node + 6 & ! 3D 8node + ],pInt) + + !integer(pInt), dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = & + integer(pInt), dimension(4), parameter, private :: NCELLNODEPERCELLFACE = & !< number of cell nodes in a specific cell type + int([ & + 2, & ! 2D 3node + 2, & ! 2D 4node + 3, & ! 3D 4node + 4 & ! 3D 8node + ],pInt) + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: maxNodeAtIP = & ! causes problem with Intel 16.0 + integer(pInt), dimension(10), parameter, private :: maxNnodeAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element + int([ & + 3, & + 1, & + 1, & + 2, & + 4, & + 1, & + 1, & + 8, & + 1, & + 4 & + ],pInt) + + + !integer(pInt), dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = & ! Intel 16.0 complains + integer(pInt), dimension(4), parameter, private :: NCELLNODEPERCELL = & !< number of cell nodes in a specific cell type + int([ & + 3, & ! 2D 3node + 4, & ! 2D 4node + 4, & ! 3D 4node + 8 & ! 3D 8node + ],pInt) + + integer(pInt), dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = & + reshape(int([& + 1,2,3 & + ],pInt),[maxNnodeAtIP(1),nIP(1)]) + + integer(pInt), dimension(maxNnodeAtIP(2),nIP(2)), parameter, private :: NnodeAtIP2 = & + reshape(int([& + 1, & + 2, & + 3 & + ],pInt),[maxNnodeAtIP(2),nIP(2)]) + + integer(pInt), dimension(maxNnodeAtIP(3),nIP(3)), parameter, private :: NnodeAtIP3 = & + reshape(int([& + 1, & + 2, & + 4, & + 3 & + ],pInt),[maxNnodeAtIP(3),nIP(3)]) + + integer(pInt), dimension(maxNnodeAtIP(4),nIP(4)), parameter, private :: NnodeAtIP4 = & + reshape(int([& + 1,0, & + 1,2, & + 2,0, & + 1,4, & + 0,0, & + 2,3, & + 4,0, & + 3,4, & + 3,0 & + ],pInt),[maxNnodeAtIP(4),nIP(4)]) + + integer(pInt), dimension(maxNnodeAtIP(5),nIP(5)), parameter, private :: NnodeAtIP5 = & + reshape(int([& + 1,2,3,4 & + ],pInt),[maxNnodeAtIP(5),nIP(5)]) + + integer(pInt), dimension(maxNnodeAtIP(6),nIP(6)), parameter, private :: NnodeAtIP6 = & + reshape(int([& + 1, & + 2, & + 3, & + 4 & + ],pInt),[maxNnodeAtIP(6),nIP(6)]) + + integer(pInt), dimension(maxNnodeAtIP(7),nIP(7)), parameter, private :: NnodeAtIP7 = & + reshape(int([& + 1, & + 2, & + 3, & + 4, & + 5, & + 6 & + ],pInt),[maxNnodeAtIP(7),nIP(7)]) + + integer(pInt), dimension(maxNnodeAtIP(8),nIP(8)), parameter, private :: NnodeAtIP8 = & + reshape(int([& + 1,2,3,4,5,6,7,8 & + ],pInt),[maxNnodeAtIP(8),nIP(8)]) + + integer(pInt), dimension(maxNnodeAtIP(9),nIP(9)), parameter, private :: NnodeAtIP9 = & + reshape(int([& + 1, & + 2, & + 4, & + 3, & + 5, & + 6, & + 8, & + 7 & + ],pInt),[maxNnodeAtIP(9),nIP(9)]) + + integer(pInt), dimension(maxNnodeAtIP(10),nIP(10)), parameter, private :: NnodeAtIP10 = & + reshape(int([& + 1,0, 0,0, & + 1,2, 0,0, & + 2,0, 0,0, & + 1,4, 0,0, & + 1,3, 2,4, & + 2,3, 0,0, & + 4,0, 0,0, & + 3,4, 0,0, & + 3,0, 0,0, & + 1,5, 0,0, & + 1,6, 2,5, & + 2,6, 0,0, & + 1,8, 4,5, & + 0,0, 0,0, & + 2,7, 3,6, & + 4,8, 0,0, & + 3,8, 4,7, & + 3,7, 0,0, & + 5,0, 0,0, & + 5,6, 0,0, & + 6,0, 0,0, & + 5,8, 0,0, & + 5,7, 6,8, & + 6,7, 0,0, & + 8,0, 0,0, & + 7,8, 0,0, & + 7,0, 0,0 & + ],pInt),[maxNnodeAtIP(10),nIP(10)]) + + ! *** FE_ipNeighbor *** + ! is a list of the neighborhood of each IP. + ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. + ! Positive integers denote an intra-FE IP identifier. + ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. + + + integer(pInt), dimension(nIPneighbor(cellType(1)),nIP(1)), parameter, private :: IPneighbor1 = & + reshape(int([& + -2,-3,-1 & + ],pInt),[nIPneighbor(cellType(1)),nIP(1)]) + + integer(pInt), dimension(nIPneighbor(cellType(2)),nIP(2)), parameter, private :: IPneighbor2 = & + reshape(int([& + 2,-3, 3,-1, & + -2, 1, 3,-1, & + 2,-3,-2, 1 & + ],pInt),[nIPneighbor(cellType(2)),nIP(2)]) + + integer(pInt), dimension(nIPneighbor(cellType(3)),nIP(3)), parameter, private :: IPneighbor3 = & + reshape(int([& + 2,-4, 3,-1, & + -2, 1, 4,-1, & + 4,-4,-3, 1, & + -2, 3,-3, 2 & + ],pInt),[nIPneighbor(cellType(3)),nIP(3)]) + + integer(pInt), dimension(nIPneighbor(cellType(4)),nIP(4)), parameter, private :: IPneighbor4 = & + reshape(int([& + 2,-4, 4,-1, & + 3, 1, 5,-1, & + -2, 2, 6,-1, & + 5,-4, 7, 1, & + 6, 4, 8, 2, & + -2, 5, 9, 3, & + 8,-4,-3, 4, & + 9, 7,-3, 5, & + -2, 8,-3, 6 & + ],pInt),[nIPneighbor(cellType(4)),nIP(4)]) + + integer(pInt), dimension(nIPneighbor(cellType(5)),nIP(5)), parameter, private :: IPneighbor5 = & + reshape(int([& + -1,-2,-3,-4 & + ],pInt),[nIPneighbor(cellType(5)),nIP(5)]) + + integer(pInt), dimension(nIPneighbor(cellType(6)),nIP(6)), parameter, private :: IPneighbor6 = & + reshape(int([& + 2,-4, 3,-2, 4,-1, & + -2, 1, 3,-2, 4,-1, & + 2,-4,-3, 1, 4,-1, & + 2,-4, 3,-2,-3, 1 & + ],pInt),[nIPneighbor(cellType(6)),nIP(6)]) + + integer(pInt), dimension(nIPneighbor(cellType(7)),nIP(7)), parameter, private :: IPneighbor7 = & + reshape(int([& + 2,-4, 3,-2, 4,-1, & + -3, 1, 3,-2, 5,-1, & + 2,-4,-3, 1, 6,-1, & + 5,-4, 6,-2,-5, 1, & + -3, 4, 6,-2,-5, 2, & + 5,-4,-3, 4,-5, 3 & + ],pInt),[nIPneighbor(cellType(7)),nIP(7)]) + + integer(pInt), dimension(nIPneighbor(cellType(8)),nIP(8)), parameter, private :: IPneighbor8 = & + reshape(int([& + -3,-5,-4,-2,-6,-1 & + ],pInt),[nIPneighbor(cellType(8)),nIP(8)]) + + integer(pInt), dimension(nIPneighbor(cellType(9)),nIP(9)), parameter, private :: IPneighbor9 = & + reshape(int([& + 2,-5, 3,-2, 5,-1, & + -3, 1, 4,-2, 6,-1, & + 4,-5,-4, 1, 7,-1, & + -3, 3,-4, 2, 8,-1, & + 6,-5, 7,-2,-6, 1, & + -3, 5, 8,-2,-6, 2, & + 8,-5,-4, 5,-6, 3, & + -3, 7,-4, 6,-6, 4 & + ],pInt),[nIPneighbor(cellType(9)),nIP(9)]) + + integer(pInt), dimension(nIPneighbor(cellType(10)),nIP(10)), parameter, private :: IPneighbor10 = & + reshape(int([& + 2,-5, 4,-2,10,-1, & + 3, 1, 5,-2,11,-1, & + -3, 2, 6,-2,12,-1, & + 5,-5, 7, 1,13,-1, & + 6, 4, 8, 2,14,-1, & + -3, 5, 9, 3,15,-1, & + 8,-5,-4, 4,16,-1, & + 9, 7,-4, 5,17,-1, & + -3, 8,-4, 6,18,-1, & + 11,-5,13,-2,19, 1, & + 12,10,14,-2,20, 2, & + -3,11,15,-2,21, 3, & + 14,-5,16,10,22, 4, & + 15,13,17,11,23, 5, & + -3,14,18,12,24, 6, & + 17,-5,-4,13,25, 7, & + 18,16,-4,14,26, 8, & + -3,17,-4,15,27, 9, & + 20,-5,22,-2,-6,10, & + 21,19,23,-2,-6,11, & + -3,20,24,-2,-6,12, & + 23,-5,25,19,-6,13, & + 24,22,26,20,-6,14, & + -3,23,27,21,-6,15, & + 26,-5,-4,22,-6,16, & + 27,25,-4,23,-6,17, & + -3,26,-4,24,-6,18 & + ],pInt),[nIPneighbor(cellType(10)),nIP(10)]) + + + real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = & + reshape(real([& + 1, 0, 0, & + 0, 1, 0, & + 0, 0, 1 & + ],pReal),[nNode(1),NcellNode(geomType(1))]) ! 2D 3node 1ip + + real(pReal), dimension(nNode(2),NcellNode(geomType(2))), parameter :: cellNodeParentNodeWeights2 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 2, 2, 2 & + ],pReal),[nNode(2),NcellNode(geomType(2))]) ! 2D 6node 3ip + + real(pReal), dimension(nNode(3),NcellNode(geomType(3))), parameter :: cellNodeParentNodeWeights3 = & + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1, & + 1, 1, 0, 0, & + 0, 1, 1, 0, & + 0, 0, 1, 1, & + 1, 0, 0, 1, & + 1, 1, 1, 1 & + ],pReal),[nNode(3),NcellNode(geomType(3))]) ! 2D 6node 3ip + + real(pReal), dimension(nNode(4),NcellNode(geomType(4))), parameter :: cellNodeParentNodeWeights4 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 1, 0, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 0, 2, & + 1, 0, 0, 0, 0, 0, 0, 2, & + 4, 1, 1, 1, 8, 2, 2, 8, & + 1, 4, 1, 1, 8, 8, 2, 2, & + 1, 1, 4, 1, 2, 8, 8, 2, & + 1, 1, 1, 4, 2, 2, 8, 8 & + ],pReal),[nNode(4),NcellNode(geomType(4))]) ! 2D 8node 9ip + + real(pReal), dimension(nNode(5),NcellNode(geomType(5))), parameter :: cellNodeParentNodeWeights5 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 1, 2, 2, 2, 2 & + ],pReal),[nNode(5),NcellNode(geomType(5))]) ! 2D 8node 4ip + + real(pReal), dimension(nNode(6),NcellNode(geomType(6))), parameter :: cellNodeParentNodeWeights6 = & + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1 & + ],pReal),[nNode(6),NcellNode(geomType(6))]) ! 3D 4node 1ip + + real(pReal), dimension(nNode(7),NcellNode(geomType(7))), parameter :: cellNodeParentNodeWeights7 = & + reshape(real([& + 1, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, & + 0, 0, 1, 0, 0, & + 0, 0, 0, 1, 0, & + 1, 1, 0, 0, 0, & + 0, 1, 1, 0, 0, & + 1, 0, 1, 0, 0, & + 1, 0, 0, 1, 0, & + 0, 1, 0, 1, 0, & + 0, 0, 1, 1, 0, & + 1, 1, 1, 0, 0, & + 1, 1, 0, 1, 0, & + 0, 1, 1, 1, 0, & + 1, 0, 1, 1, 0, & + 0, 0, 0, 0, 1 & + ],pReal),[nNode(7),NcellNode(geomType(7))]) ! 3D 5node 4ip + + real(pReal), dimension(nNode(8),NcellNode(geomType(8))), parameter :: cellNodeParentNodeWeights8 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & + 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & + 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & + 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & + 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & + ],pReal),[nNode(8),NcellNode(geomType(8))]) ! 3D 10node 4ip + + real(pReal), dimension(nNode(9),NcellNode(geomType(9))), parameter :: cellNodeParentNodeWeights9 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 0, 0, 0, 0, & + 0, 1, 1, 0, 0, 0, & + 1, 0, 1, 0, 0, 0, & + 1, 0, 0, 1, 0, 0, & + 0, 1, 0, 0, 1, 0, & + 0, 0, 1, 0, 0, 1, & + 0, 0, 0, 1, 1, 0, & + 0, 0, 0, 0, 1, 1, & + 0, 0, 0, 1, 0, 1, & + 1, 1, 1, 0, 0, 0, & + 1, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 1, & + 1, 0, 1, 1, 0, 1, & + 0, 0, 0, 1, 1, 1, & + 1, 1, 1, 1, 1, 1 & + ],pReal),[nNode(9),NcellNode(geomType(9))]) ! 3D 6node 6ip + + real(pReal), dimension(nNode(10),NcellNode(geomType(10))), parameter :: cellNodeParentNodeWeights10 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1 & + ],pReal),[nNode(10),NcellNode(geomType(10))]) ! 3D 8node 1ip + + real(pReal), dimension(nNode(11),NcellNode(geomType(11))), parameter :: cellNodeParentNodeWeights11 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, & ! + 1, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 1, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 1, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 1, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 1, & ! + 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, & ! + 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, & ! + 1, 1, 1, 1, 1, 1, 1, 1 & ! + ],pReal),[nNode(11),NcellNode(geomType(11))]) ! 3D 8node 8ip + + real(pReal), dimension(nNode(12),NcellNode(geomType(12))), parameter :: cellNodeParentNodeWeights12 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! + 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! + 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! + ],pReal),[nNode(12),NcellNode(geomType(12))]) ! 3D 20node 8ip + + real(pReal), dimension(nNode(13),NcellNode(geomType(13))), parameter :: cellNodeParentNodeWeights13 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 + 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! + 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 + 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! + 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! + 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! + 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 + 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! + 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 + 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! + 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! + 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 + 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! + 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! + 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! + 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! + 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 + 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! + 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! + 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! + 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! + ],pReal),[nNode(13),NcellNode(geomType(13))]) ! 3D 20node 27ip + + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)), parameter :: CELL1 = & + reshape(int([& + 1,2,3 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)), parameter :: CELL2 = & + reshape(int([& + 1, 4, 7, 6, & + 2, 5, 7, 4, & + 3, 6, 7, 5 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)), parameter :: CELL3 = & + reshape(int([& + 1, 5, 9, 8, & + 5, 2, 6, 9, & + 8, 9, 7, 4, & + 9, 6, 3, 7 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)), parameter :: CELL4 = & + reshape(int([& + 1, 5,13,12, & + 5, 6,14,13, & + 6, 2, 7,14, & + 12,13,16,11, & + 13,14,15,16, & + 14, 7, 8,15, & + 11,16,10, 4, & + 16,15, 9,10, & + 15, 8, 3, 9 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)), parameter :: CELL5 = & + reshape(int([& + 1, 2, 3, 4 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)), parameter :: CELL6 = & + reshape(int([& + 1, 5,11, 7, 8,12,15,14, & + 5, 2, 6,11,12, 9,13,15, & + 7,11, 6, 3,14,15,13,10, & + 8,12,15, 4, 4, 9,13,10 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)), parameter :: CELL7 = & + reshape(int([& + 1, 7,16, 9,10,17,21,19, & + 7, 2, 8,16,17,11,18,21, & + 9,16, 8, 3,19,21,18,12, & + 10,17,21,19, 4,13,20,15, & + 17,11,18,21,13, 5,14,20, & + 19,21,18,12,15,20,14, 6 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)), parameter :: CELL8 = & + reshape(int([& + 1, 2, 3, 4, 5, 6, 7, 8 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)), parameter :: CELL9 = & + reshape(int([& + 1, 9,21,12,13,22,27,25, & + 9, 2,10,21,22,14,23,27, & + 12,21,11, 4,25,27,24,16, & + 21,10, 3,11,27,23,15,24, & + 13,22,27,25, 5,17,26,20, & + 22,14,23,27,17, 6,18,26, & + 25,27,24,16,20,26,19, 8, & + 27,23,15,24,26,18, 7,19 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)), parameter :: CELL10 = & + reshape(int([& + 1, 9,33,16,17,37,57,44, & + 9,10,34,33,37,38,58,57, & + 10, 2,11,34,38,18,39,58, & + 16,33,36,15,44,57,60,43, & + 33,34,35,36,57,58,59,60, & + 34,11,12,35,58,39,40,59, & + 15,36,14, 4,43,60,42,20, & + 36,35,13,14,60,59,41,42, & + 35,12, 3,13,59,40,19,41, & + 17,37,57,44,21,45,61,52, & + 37,38,58,57,45,46,62,61, & + 38,18,39,58,46,22,47,62, & + 44,57,60,43,52,61,64,51, & + 57,58,59,60,61,62,63,64, & + 58,39,40,59,62,47,48,63, & + 43,60,42,20,51,64,50,24, & + 60,59,41,42,64,63,49,50, & + 59,40,19,41,63,48,23,49, & + 21,45,61,52, 5,25,53,32, & + 45,46,62,61,25,26,54,53, & + 46,22,47,62,26, 6,27,54, & + 52,61,64,51,32,53,56,31, & + 61,62,63,64,53,54,55,56, & + 62,47,48,63,54,27,28,55, & + 51,64,50,24,31,56,30, 8, & + 64,63,49,50,56,55,29,30, & + 63,48,23,49,55,28, 7,29 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)]) + + + integer(pInt), dimension(NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)), parameter :: CELLFACE1 = & + reshape(int([& + 2,3, & + 3,1, & + 1,2 & + ],pInt),[NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)]) ! 2D 3node, VTK_TRIANGLE (5) + + integer(pInt), dimension(NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)), parameter :: CELLFACE2 = & + reshape(int([& + 2,3, & + 4,1, & + 3,4, & + 1,2 & + ],pInt),[NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)]) ! 2D 4node, VTK_QUAD (9) + + integer(pInt), dimension(NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)), parameter :: CELLFACE3 = & + reshape(int([& + 1,3,2, & + 1,2,4, & + 2,3,4, & + 1,4,3 & + ],pInt),[NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)]) ! 3D 4node, VTK_TETRA (10) + + integer(pInt), dimension(NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)), parameter :: CELLFACE4 = & + reshape(int([& + 2,3,7,6, & + 4,1,5,8, & + 3,4,8,7, & + 1,2,6,5, & + 5,6,7,8, & + 1,4,3,2 & + ],pInt),[NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)]) ! 3D 8node, VTK_HEXAHEDRON (12) + + +contains + + subroutine tElement_init(self,elemType) + implicit none + class(tElement) :: self + integer(pInt), intent(in) :: elemType + self%elemType = elemType + + self%Nnodes = Nnode (self%elemType) + self%geomType = geomType (self%elemType) + select case (self%elemType) + case(1_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights1 + case(2_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights2 + case(3_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights3 + case(4_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights4 + case(5_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights5 + case(6_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights6 + case(7_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights7 + case(8_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights8 + case(9_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights9 + case(10_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights10 + case(11_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights11 + case(12_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights12 + case(13_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights13 + case default + print*, 'Mist' + end select + + + self%NcellNodes = NcellNode (self%geomType) + self%maxNnodeAtIP = maxNnodeAtIP (self%geomType) + self%nIPs = nIP (self%geomType) + self%cellType = cellType (self%geomType) + + + select case (self%geomType) + case(1_pInt) + self%NnodeAtIP = NnodeAtIP1 + self%IPneighbor = IPneighbor1 + self%cell = CELL1 + case(2_pInt) + self%NnodeAtIP = NnodeAtIP2 + self%IPneighbor = IPneighbor2 + self%cell = CELL2 + case(3_pInt) + self%NnodeAtIP = NnodeAtIP3 + self%IPneighbor = IPneighbor3 + self%cell = CELL3 + case(4_pInt) + self%NnodeAtIP = NnodeAtIP4 + self%IPneighbor = IPneighbor4 + self%cell = CELL4 + case(5_pInt) + self%NnodeAtIP = NnodeAtIP5 + self%IPneighbor = IPneighbor5 + self%cell = CELL5 + case(6_pInt) + self%NnodeAtIP = NnodeAtIP6 + self%IPneighbor = IPneighbor6 + self%cell = CELL6 + case(7_pInt) + self%NnodeAtIP = NnodeAtIP7 + self%IPneighbor = IPneighbor7 + self%cell = CELL7 + case(8_pInt) + self%NnodeAtIP = NnodeAtIP8 + self%IPneighbor = IPneighbor8 + self%cell = CELL8 + case(9_pInt) + self%NnodeAtIP = NnodeAtIP9 + self%IPneighbor = IPneighbor9 + self%cell = CELL9 + case(10_pInt) + self%NnodeAtIP = NnodeAtIP10 + self%IPneighbor = IPneighbor10 + self%cell = CELL10 + end select + self%NcellNodesPerCell = NCELLNODEPERCELL(self%cellType) + + select case(self%cellType) + case(1_pInt) + self%cellFace = CELLFACE1 + case(2_pInt) + self%cellFace = CELLFACE2 + case(3_pInt) + self%cellFace = CELLFACE3 + case(4_pInt) + self%cellFace = CELLFACE4 + end select + end subroutine tElement_init + + + +end module element From 8f106ca8c4fa9308db76b9320b591c129a96d57d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 14:53:23 +0100 Subject: [PATCH 020/309] base class for mesh no functions defined yet, only common variables --- src/CMakeLists.txt | 8 ++++++-- src/mesh_base.f90 | 48 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 2 deletions(-) create mode 100644 src/mesh_base.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index a09ae4766..3292e9cf6 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -61,17 +61,21 @@ add_library(MATH OBJECT "math.f90") add_dependencies(MATH FEsolving) list(APPEND OBJECTFILES $) +add_library(MESH_BASE OBJECT "mesh_base.f90") +add_dependencies(MESH_BASE MATH) +list(APPEND OBJECTFILES $) + # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh_grid.f90") - add_dependencies(MESH MATH ELEMENT) + add_dependencies(MESH MATH) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") add_dependencies(FEZoo MATH) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "mesh_FEM.f90") - add_dependencies(MESH FEZoo ELEMENT) + add_dependencies(MESH FEZoo) list(APPEND OBJECTFILES $) endif() diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 new file mode 100644 index 000000000..477fc3aed --- /dev/null +++ b/src/mesh_base.f90 @@ -0,0 +1,48 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Sets up the mesh for the solvers MSC.Marc,FEM, Abaqus and the spectral solver +!-------------------------------------------------------------------------------------------------- +module mesh_base + + use, intrinsic :: iso_c_binding + use prec, only: & + pStringLen, & + pReal, & + pInt + use element, only: & + tElement + + implicit none + +!--------------------------------------------------------------------------------------------------- +!> Properties of a the whole mesh (consisting of one type of elements) +!--------------------------------------------------------------------------------------------------- + type, public :: tMesh + type(tElement) :: & + elem + real(pReal), dimension(:,:), allocatable, public :: & + ipVolume, & !< volume associated with each IP (initially!) + node0, & !< node x,y,z coordinates (initially) + node !< node x,y,z coordinates (deformed) + integer(pInt), dimension(:,:), allocatable, public :: & + cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID + character(pStringLen) :: solver = "undefined" + integer(pInt) :: & + Nnodes, & !< total number of nodes in mesh + Nelems = -1_pInt, & + elemType, & + Ncells, & + nIPneighbors, & + NcellNodes, & + maxElemsPerNode + integer(pInt), dimension(:), allocatable, public :: & + homogenizationAt, & + microstructureAt + integer(pInt), dimension(:,:), allocatable, public :: & + connectivity + end type tMesh + +end module mesh_base From 7e039dff678381262076a9d1331c8dee4568cc10 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 15:18:53 +0100 Subject: [PATCH 021/309] verbose initialization --- src/element.f90 | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/src/element.f90 b/src/element.f90 index 146f24d51..bd602b3b2 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -900,7 +900,27 @@ contains self%cellFace = CELLFACE3 case(4_pInt) self%cellFace = CELLFACE4 - end select + end select + + + write(6,*) 'tElement_init' + + write(6,*)'elemType ',self%elemType + write(6,*)'geomType ',self%geomType + write(6,*)'cellType ',self%cellType + write(6,*)'Nnodes ',self%Nnodes + write(6,*)'Ncellnodes ',self%Ncellnodes + write(6,*)'NcellnodesPerCell ',self%NcellnodesPerCell + write(6,*)'nIPs ',self%nIPs + write(6,*)'nIPneighbors ',self%nIPneighbors + write(6,*)'maxNnodeAtIP ',self%maxNnodeAtIP + write(6,*)'Cell ',self%Cell + write(6,*)'NnodeAtIP ',self%NnodeAtIP + write(6,*)'IPneighbor ',self%IPneighbor + write(6,*)'cellFace ',self%cellFace + write(6,*)'cellNodeParentNodeWeights',self%cellNodeParentNodeWeights + + end subroutine tElement_init From 738114bc279d0f340c16244adc37835da7f211b8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 15:19:17 +0100 Subject: [PATCH 022/309] clean and initialize element --- src/mesh_grid.f90 | 89 ++++++++++++----------------------------------- 1 file changed, 22 insertions(+), 67 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 7cf7a1e64..fee06bee9 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -8,6 +8,7 @@ module mesh use, intrinsic :: iso_c_binding use prec, only: pReal, pInt + use mesh_base implicit none private @@ -368,7 +369,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & mesh_spectral_getHomogenization, & @@ -378,9 +378,23 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood - + type, public, extends(tMesh) :: tMesh_grid + contains + procedure :: init => tMesh_grid_init + end type tMesh_grid + + type(tMesh_grid), public :: theMesh + contains +subroutine tMesh_grid_init(self) + + implicit none + class(tMesh_grid) :: self + + call self%elem%init(10_pInt) + +end subroutine tMesh_grid_init !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -502,6 +516,9 @@ subroutine mesh_init(ip,el) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! + + call theMesh%init + end subroutine mesh_init !-------------------------------------------------------------------------------------------------- @@ -985,7 +1002,7 @@ subroutine mesh_spectral_count_cpSizes implicit none integer(pInt) :: t,g,c - t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element + t = 10_pInt g = FE_geomtype(t) c = FE_celltype(g) @@ -1112,7 +1129,7 @@ subroutine mesh_spectral_build_elements(fileUnit) enddo enddo - elemType = FE_mapElemtype('C3D8R') + elemType = 10_pInt elemOffset = product(grid(1:2))*grid3Offset e = 0_pInt do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) @@ -1377,68 +1394,6 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -!-------------------------------------------------------------------------------------------------- -!> @brief mapping of FE element types to internal representation -!-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) - use IO, only: IO_lc, IO_error - - implicit none - character(len=*), intent(in) :: what - - select case (IO_lc(what)) - case ( '6') - FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle - case ( '155', & - '125', & - '128') - FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) - case ( '11', & - 'cpe4', & - 'cpe4t') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27', & - 'cpe8', & - 'cpe8t') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral - case ( '54') - FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration - case ( '134', & - 'c3d4', & - 'c3d4t') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron - case ( '157') - FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations - case ( '127') - FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron - case ( '136', & - 'c3d6', & - 'c3d6t') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral - case ( '117', & - '123', & - 'c3d8r', & - 'c3d8rt') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7', & - 'c3d8', & - 'c3d8t') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57', & - 'c3d20r', & - 'c3d20rt') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21', & - 'c3d20', & - 'c3d20t') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral - case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) - end select - -end function FE_mapElemtype - - !-------------------------------------------------------------------------------------------------- !> @brief find face-matching element of same type !-------------------------------------------------------------------------------------------------- @@ -2282,7 +2237,7 @@ integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) mesh_get_nodeAtIP = 0_pInt - elemtype = FE_mapElemtype(elemtypeFE) + elemtype = 10_pInt geomtype = FE_geomtype(elemtype) if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) From cda85b0d2de897c08a8fe2e886409c7ea1aa3840 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 15:51:03 +0100 Subject: [PATCH 023/309] might be needed somewhere --- src/element.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/element.f90 b/src/element.f90 index bd602b3b2..4c0f1e810 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -902,6 +902,7 @@ contains self%cellFace = CELLFACE4 end select + self%nIPneighbors = size(self%IPneighbor,1) write(6,*) 'tElement_init' From 7d3ae1673f039fbd6c3843b32df1d3952c8d6685 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 16:16:41 +0100 Subject: [PATCH 024/309] not needed --- src/FEM_utilities.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 1db950e63..bf5e62851 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -503,7 +503,6 @@ subroutine utilities_indexActiveSet(field,section,x_local,f_local,localIS,global CHKERRQ(ierr) call ISDestroy(dummyIS,ierr); CHKERRQ(ierr) endif - deallocate(localIndices) end subroutine utilities_indexActiveSet From 5c2020c3b483704545f4fe0380faef1b32668841 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 16:17:20 +0100 Subject: [PATCH 025/309] initialize element --- src/mesh_grid.f90 | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index fee06bee9..8b1659ed8 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -379,11 +379,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_spectral_build_ipNeighborhood type, public, extends(tMesh) :: tMesh_grid + + integer(pInt), dimension(3), public :: & + grid !< (global) grid + integer(pInt), public :: & + mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh + grid3, & !< (local) grid in 3rd direction + grid3Offset !< (local) grid offset in 3rd direction + real(pReal), dimension(3), public :: & + geomSize + real(pReal), public :: & + size3, & !< (local) size in 3rd direction + size3offset + contains procedure :: init => tMesh_grid_init end type tMesh_grid - type(tMesh_grid), public :: theMesh + type(tMesh_grid), public, protected :: theMesh contains @@ -444,6 +457,7 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + call theMesh%init call mesh_build_FEdata ! get properties of the different types of elements mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh @@ -517,7 +531,6 @@ subroutine mesh_init(ip,el) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init end subroutine mesh_init @@ -2194,7 +2207,7 @@ subroutine mesh_build_FEdata 5,6,7,8, & 1,4,3,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - + end subroutine mesh_build_FEdata From 42cc9b8d2b59f5718ed5790885de2f14d8df52cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 25 Jan 2019 00:15:46 +0100 Subject: [PATCH 026/309] dependency was missing --- src/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3292e9cf6..62f44dacb 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -62,7 +62,7 @@ add_dependencies(MATH FEsolving) list(APPEND OBJECTFILES $) add_library(MESH_BASE OBJECT "mesh_base.f90") -add_dependencies(MESH_BASE MATH) +add_dependencies(MESH_BASE MATH ELEMENT) list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files From ab93a86b3e0e47c17a98bdca5a355a0382fce5fd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 16:50:23 +0100 Subject: [PATCH 027/309] initialize element where defined --- src/FEM_zoo.f90 | 4 ++-- src/mesh_FEM.f90 | 34 ++++++++++++++++++++++++++++++++-- 2 files changed, 34 insertions(+), 4 deletions(-) diff --git a/src/FEM_zoo.f90 b/src/FEM_zoo.f90 index 67c518c47..6abdfe883 100644 --- a/src/FEM_zoo.f90 +++ b/src/FEM_zoo.f90 @@ -9,11 +9,11 @@ module FEM_Zoo private integer(pInt), parameter, public:: & maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary) - real(pReal), dimension(2,3), private, protected :: & + real(pReal), dimension(2,3), private, parameter :: & triangle = reshape([-1.0_pReal, -1.0_pReal, & 1.0_pReal, -1.0_pReal, & -1.0_pReal, 1.0_pReal], shape=[2,3]) - real(pReal), dimension(3,4), private, protected :: & + real(pReal), dimension(3,4), private, parameter :: & tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, & 1.0_pReal, -1.0_pReal, -1.0_pReal, & -1.0_pReal, 1.0_pReal, -1.0_pReal, & diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index 1362063f8..7a784a27f 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -12,7 +12,7 @@ module mesh #include #include use prec, only: pReal, pInt - + use mesh_base use PETScdmplex use PETScdmda use PETScis @@ -79,6 +79,17 @@ use PETScis integer(pInt), dimension(1_pInt), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type int([6],pInt) + + type, public, extends(tMesh) :: tMesh_FEM + + + contains + procedure :: init => tMesh_FEM_init + end type tMesh_FEM + + type(tMesh_FEM), public, protected :: theMesh + + public :: & @@ -89,6 +100,23 @@ use PETScis contains +subroutine tMesh_FEM_init(self,dimen,order) + + implicit none + integer(pInt), intent(in) :: dimen,order + class(tMesh_FEM) :: self + + if (dimen == 2_pInt) then + if (order == 1_pInt) call self%elem%init(1_pInt) + if (order == 2_pInt) call self%elem%init(2_pInt) + elseif(dimen == 3_pInt) then + if (order == 1_pInt) call self%elem%init(6_pInt) + if (order == 2_pInt) call self%elem%init(8_pInt) + endif + + +end subroutine tMesh_FEM_init + !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -213,6 +241,8 @@ subroutine mesh_init() FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) mesh_maxNips = FE_Nips(1_pInt) + + write(6,*) 'mesh_maxNips',mesh_maxNips call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p) call mesh_FEM_build_ipVolumes(dimPlex) @@ -243,7 +273,7 @@ subroutine mesh_init() mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%init(dimplex,integrationOrder) end subroutine mesh_init From 3ebc0c2e37b4959cee1b11e3be26905ad3542714 Mon Sep 17 00:00:00 2001 From: navyanthkusam Date: Mon, 28 Jan 2019 13:53:44 +0100 Subject: [PATCH 028/309] tMesh_marc object extends tMesh Functionality seperated for mesh_marc --- src/mesh_marc.f90 | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index aa7d77b77..85b4f3e7d 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -8,6 +8,7 @@ module mesh use, intrinsic :: iso_c_binding use prec, only: pReal, pInt + use mesh_base implicit none private @@ -401,6 +402,46 @@ integer(pInt), dimension(:,:), allocatable, private :: & contains +type, public, extends(tMesh) :: tMesh_marc + + integer(pInt), public :: & + nElemsAll, & + maxNelemInSet, & + NelemSets,& + MarcVersion, & !< Version of input file format ToDo: Better Name? + hypoelasticTableStyle, & !< Table style + initialcondTableStyle + character(len=64), dimension(:), allocatable :: & + nameElemSet,& !< names of elementSet + mesh_nameElemSet, & !< names of elementSet + mapMaterial !< name of elementSet for material + integer(pInt), dimension(:), allocatable :: & + Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) + integer(pInt), dimension(:,:), allocatable, target:: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode + integer(pInt), private :: & + mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) + mesh_maxNnodes, & !< max number of nodes in any CP element + mesh_NelemSets, & + mesh_maxNelemInSet + integer(pInt), dimension(:,:), allocatable :: & + mesh_mapElemSet !< list of elements in elementSet + integer(pInt), dimension(2):: & + mesh_maxValStateVar = 0_pInt + + contains + procedure :: init => tMesh_marc_init +end type tMesh_marc + + type(tMesh_marc), public, protected :: theMesh +contains + +subroutine tMesh_marc_init(self) + implicit none + class(tMesh_marc) :: self + +end subroutine tMesh_marc_init !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -478,6 +519,8 @@ subroutine mesh_init(ip,el) call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) + + call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -2767,3 +2810,7 @@ end function mesh_get_nodeAtIP end module mesh + + + + From 5101a3796fe5d0aa3a4a4bfd124ca16591f084b1 Mon Sep 17 00:00:00 2001 From: navyanthkusam Date: Mon, 28 Jan 2019 13:59:54 +0100 Subject: [PATCH 029/309] tMesh_abaqus object extends tMesh Functionality seperated for mesh_abaqus --- src/mesh_abaqus.f90 | 1275 ++----------------------------------------- 1 file changed, 38 insertions(+), 1237 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index e55165d51..bc14cd418 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -8,6 +8,7 @@ module mesh use, intrinsic :: iso_c_binding use prec, only: pReal, pInt + use mesh_base implicit none private @@ -62,11 +63,9 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) -#if defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), private :: & mesh_maxNelemInSet, & mesh_Nmaterials -#endif integer(pInt), dimension(2), private :: & mesh_maxValStateVar = 0_pInt @@ -329,7 +328,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 6 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_maxNnodesAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element int([ & 3, & ! element 6 (2D 3node 1ip) @@ -344,19 +342,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) -#if defined(Spectral) - integer(pInt), dimension(3), public, protected :: & - grid !< (global) grid - integer(pInt), public, protected :: & - mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh - grid3, & !< (local) grid in 3rd direction - grid3Offset !< (local) grid offset in 3rd direction - real(pReal), dimension(3), public, protected :: & - geomSize - real(pReal), public, protected :: & - size3, & !< (local) size in 3rd direction - size3offset !< (local) size offset in 3rd direction -#elif defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), private :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element @@ -370,17 +355,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & integer(pInt), dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] -#endif -#if defined(Marc4DAMASK) - integer(pInt), private :: & - MarcVersion, & !< Version of input file format (Marc only) - hypoelasticTableStyle, & !< Table style (Marc only) - initialcondTableStyle !< Table style (Marc only) - integer(pInt), dimension(:), allocatable, private :: & - Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) -#elif defined(Abaqus) logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information -#endif public :: & mesh_init, & @@ -391,12 +366,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_Ncellnodes, & mesh_get_unitlength, & mesh_get_nodeAtIP, & -#if defined(Spectral) - mesh_spectral_getGrid, & - mesh_spectral_getSize -#elif defined(Marc4DAMASK) || defined(Abaqus) mesh_FEasCP -#endif private :: & mesh_get_damaskOptions, & @@ -406,32 +376,9 @@ integer(pInt), dimension(:,:), allocatable, private :: & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & -#if defined(Spectral) - mesh_spectral_getHomogenization, & - mesh_spectral_count, & - mesh_spectral_count_cpSizes, & - mesh_spectral_build_nodes, & - mesh_spectral_build_elements, & - mesh_spectral_build_ipNeighborhood -#elif defined(Marc4DAMASK) || defined(Abaqus) mesh_build_nodeTwins, & mesh_build_sharedElems, & mesh_build_ipNeighborhood, & -#endif -#if defined(Marc4DAMASK) - mesh_marc_get_fileFormat, & - mesh_marc_get_tableStyles, & - mesh_marc_get_matNumber, & - mesh_marc_count_nodesAndElements, & - mesh_marc_count_elementSets, & - mesh_marc_map_elementSets, & - mesh_marc_count_cpElements, & - mesh_marc_map_Elements, & - mesh_marc_map_nodes, & - mesh_marc_build_nodes, & - mesh_marc_count_cpSizes, & - mesh_marc_build_elements -#elif defined(Abaqus) mesh_abaqus_count_nodesAndElements, & mesh_abaqus_count_elementSets, & mesh_abaqus_count_materials, & @@ -443,10 +390,40 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_abaqus_build_nodes, & mesh_abaqus_count_cpSizes, & mesh_abaqus_build_elements -#endif + + type, public, extends(tMesh) :: tMesh_Abaqus + + integer(pInt):: & + mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) + mesh_maxNnodes, & !< max number of nodes in any CP element + mesh_NelemSets, & + mesh_maxNelemInSet, & + mesh_Nmaterials + character(len=64), dimension(:), allocatable :: & + mesh_nameElemSet, & !< names of elementSet + mesh_nameMaterial, & !< names of material in solid section + mesh_mapMaterial !< name of elementSet for material + integer(pInt), dimension(:,:), allocatable :: & + mesh_mapElemSet !< list of elements in elementSet + integer(pInt), dimension(:,:), allocatable, target :: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] + logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information + + contains + procedure :: init=>tMesh_abaqus_init + end type tMesh_Abaqus + + type(tMesh_Abaqus), public, protected :: theMesh + contains +subroutine tMesh_abaqus_init + implicit none + class(tMesh_abaqus) :: self + +end subroutine tMesh_abaqus_init !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -457,22 +434,11 @@ subroutine mesh_init(ip,el) use, intrinsic :: iso_fortran_env, only: & compiler_version, & compiler_options -#endif -#ifdef Spectral -#include - use PETScsys #endif use DAMASK_interface use IO, only: & -#ifdef Abaqus IO_abaqus_hasNoPart, & -#endif -#ifdef Spectral - IO_open_file, & - IO_error, & -#else IO_open_InputFile, & -#endif IO_timeStamp, & IO_error, & IO_write_jobFile @@ -487,19 +453,10 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & -#ifndef Spectral - modelName, & - calcMode, & -#endif FEsolving_execElem, & FEsolving_execIP implicit none -#ifdef Spectral - include 'fftw3-mpi.f03' - integer(C_INTPTR_T) :: devNull, local_K, local_K_offset - integer :: ierr, worldsize -#endif integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), intent(in), optional :: el, ip integer(pInt) :: j @@ -514,65 +471,6 @@ subroutine mesh_init(ip,el) myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) -#ifdef Spectral - call fftw_mpi_init() - call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... - if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) - grid = mesh_spectral_getGrid(fileUnit) - call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') - if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') - - geomSize = mesh_spectral_getSize(fileUnit) - devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & - int(grid(2),C_INTPTR_T), & - int(grid(1),C_INTPTR_T)/2+1, & - PETSC_COMM_WORLD, & - local_K, & ! domain grid size along z - local_K_offset) ! domain grid offset along z - grid3 = int(local_K,pInt) - grid3Offset = int(local_K_offset,pInt) - size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) - size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) - if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) - call mesh_spectral_count() - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_spectral_count_cpSizes - if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) - call mesh_spectral_build_nodes() - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_spectral_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Marc4DAMASK - call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... - if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - call mesh_marc_get_fileFormat(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) - call mesh_marc_get_tableStyles(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) - if (MarcVersion > 12) then - call mesh_marc_get_matNumber(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) - endif - call mesh_marc_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_marc_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_marc_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_marc_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_marc_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_marc_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_marc_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_marc_count_cpSizes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) - call mesh_marc_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Abaqus call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) noPart = IO_abaqus_hasNoPart(FILEUNIT) @@ -598,8 +496,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_abaqus_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#endif - call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -613,40 +509,29 @@ subroutine mesh_init(ip,el) call mesh_build_ipAreas if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) close (FILEUNIT) - -#if defined(Marc4DAMASK) || defined(Abaqus) call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) call mesh_build_ipNeighborhood -#else - call mesh_spectral_build_ipNeighborhood -#endif if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) if (worldrank == 0_pInt) then call mesh_tell_statistics endif -#if defined(Marc4DAMASK) || defined(Abaqus) if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements -#endif if (debug_e < 1 .or. debug_e > mesh_NcpElems) & call IO_error(602_pInt,ext_msg='element') ! selected element does not exist if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP - FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements allocate(FEsolving_execIP(2_pInt,mesh_NcpElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element - -#if defined(Marc4DAMASK) || defined(Abaqus) allocate(calcMode(mesh_maxNips,mesh_NcpElems)) calcMode = .false. ! pretend to have collected what first call is asking (F = I) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" -#endif !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. @@ -662,7 +547,6 @@ subroutine mesh_init(ip,el) end subroutine mesh_init -#if defined(Marc4DAMASK) || defined(Abaqus) !-------------------------------------------------------------------------------------------------- !> @brief Gives the FE to CP ID mapping by binary search through lookup array !! valid questions (what) are 'elem', 'node' @@ -711,7 +595,7 @@ integer(pInt) function mesh_FEasCP(what,myID) enddo binarySearch end function mesh_FEasCP -#endif + !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -953,456 +837,6 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates -#ifdef Spectral -!-------------------------------------------------------------------------------------------------- -!> @brief Reads grid information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -function mesh_spectral_getGrid(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), dimension(3) :: mesh_spectral_getGrid - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotGrid = .false. - - mesh_spectral_getGrid = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) - case ('grid') - gotGrid = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('a') - mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) - case('b') - mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) - case('c') - mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotGrid) & - call IO_error(error_ID = 845_pInt, ext_msg='grid') - if(any(mesh_spectral_getGrid < 1_pInt)) & - call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') - -end function mesh_spectral_getGrid - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads size information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -function mesh_spectral_getSize(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - real(pReal), dimension(3) :: mesh_spectral_getSize - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotSize = .false. - - mesh_spectral_getSize = -1.0_pReal - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('size') - gotSize = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('x') - mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) - case('y') - mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) - case('z') - mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotSize) & - call IO_error(error_ID = 845_pInt, ext_msg='size') - if (any(mesh_spectral_getSize<=0.0_pReal)) & - call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') - -end function mesh_spectral_getSize - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_spectral_getHomogenization(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, myFileUnit - logical :: gotHomogenization = .false. - - mesh_spectral_getHomogenization = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('homogenization') - gotHomogenization = .true. - mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotHomogenization ) & - call IO_error(error_ID = 845_pInt, ext_msg='homogenization') - if (mesh_spectral_getHomogenization<1_pInt) & - call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') - -end function mesh_spectral_getHomogenization - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count() - - implicit none - - mesh_NcpElems= product(grid(1:2))*grid3 - mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) - - mesh_NcpElemsGlobal = product(grid) - -end subroutine mesh_spectral_count - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count_cpSizes - - implicit none - integer(pInt) :: t,g,c - - t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element - g = FE_geomtype(t) - c = FE_celltype(g) - - mesh_maxNips = FE_Nips(g) - mesh_maxNipNeighbors = FE_NipNeighbors(c) - mesh_maxNcellnodes = FE_Ncellnodes(g) - -end subroutine mesh_spectral_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_nodes() - - implicit none - integer(pInt) :: n - - allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) - allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) - - forall (n = 0_pInt:mesh_Nnodes-1_pInt) - mesh_node0(1,n+1_pInt) = mesh_unitlength * & - geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & - / real(grid(1),pReal) - mesh_node0(2,n+1_pInt) = mesh_unitlength * & - geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) & - / real(grid(2),pReal) - mesh_node0(3,n+1_pInt) = mesh_unitlength * & - size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & - / real(grid3,pReal) + & - size3offset - end forall - - mesh_node = mesh_node0 - -end subroutine mesh_spectral_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, material, texture, and node list per element. -!! Allocates global array 'mesh_element' -!> @todo does the IO_error makes sense? -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_elements(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_continuousIntValues, & - IO_intValue, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: & - fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: & - e, i, & - headerLength = 0_pInt, & - maxDataPerLine, & - homog, & - elemType, & - elemOffset - integer(pInt), dimension(:), allocatable :: & - microstructures, & - microGlobal - integer(pInt), dimension(1,1) :: & - dummySet = 0_pInt - character(len=65536) :: & - line, & - keyword - character(len=64), dimension(1) :: & - dummyName = '' - - homog = mesh_spectral_getHomogenization(fileUnit) - -!-------------------------------------------------------------------------------------------------- -! get header length - call IO_checkAndRewind(fileUnit) - read(fileUnit,'(a65536)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') - endif - -!-------------------------------------------------------------------------------------------------- -! get maximum microstructure index - call IO_checkAndRewind(fileUnit) - do i = 1_pInt, headerLength - read(fileUnit,'(a65536)') line - enddo - - maxDataPerLine = 0_pInt - i = 1_pInt - - do while (i > 0_pInt) - i = IO_countContinuousIntValues(fileUnit) - maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? - enddo - allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) - allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size - allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) - -!-------------------------------------------------------------------------------------------------- -! read in microstructures - call IO_checkAndRewind(fileUnit) - do i=1_pInt,headerLength - read(fileUnit,'(a65536)') line - enddo - - e = 0_pInt - do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) - microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements - do i = 1_pInt,microstructures(1_pInt) - e = e+1_pInt ! valid element entry - microGlobal(e) = microstructures(1_pInt+i) - enddo - enddo - - elemType = FE_mapElemtype('C3D8R') - elemOffset = product(grid(1:2))*grid3Offset - e = 0_pInt - do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) - e = e+1_pInt ! valid element entry - mesh_element( 1,e) = -1_pInt ! DEPRECATED - mesh_element( 2,e) = elemType ! elem type - mesh_element( 3,e) = homog ! homogenization - mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure - mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & - ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node - mesh_element( 6,e) = mesh_element(5,e) + 1_pInt - mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt - mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt - mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node - mesh_element(10,e) = mesh_element(9,e) + 1_pInt - mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt - mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) - enddo - - if (e /= mesh_NcpElems) call IO_error(880_pInt,e) - -end subroutine mesh_spectral_build_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief build neighborhood relations for spectral -!> @details assign globals: mesh_ipNeighborhood -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_ipNeighborhood - - implicit none - integer(pInt) :: & - x,y,z, & - e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) - - e = 0_pInt - do z = 0_pInt,grid3-1_pInt - do y = 0_pInt,grid(2)-1_pInt - do x = 0_pInt,grid(1)-1_pInt - e = e + 1_pInt - mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & - + y * grid(1) & - + modulo(x+1_pInt,grid(1)) & - + 1_pInt - mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & - + y * grid(1) & - + modulo(x-1_pInt,grid(1)) & - + 1_pInt - mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & - + modulo(y+1_pInt,grid(2)) * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & - + modulo(y-1_pInt,grid(2)) * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) & - + y * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) & - + y * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt - mesh_ipNeighborhood(3,1,1,e) = 2_pInt - mesh_ipNeighborhood(3,2,1,e) = 1_pInt - mesh_ipNeighborhood(3,3,1,e) = 4_pInt - mesh_ipNeighborhood(3,4,1,e) = 3_pInt - mesh_ipNeighborhood(3,5,1,e) = 6_pInt - mesh_ipNeighborhood(3,6,1,e) = 5_pInt - enddo - enddo - enddo - -end subroutine mesh_spectral_build_ipNeighborhood - !-------------------------------------------------------------------------------------------------- !> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) @@ -1492,622 +926,8 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) nodes = nodes/8.0_pReal end function mesh_nodesAroundCentres -#endif -#ifdef Marc4DAMASK -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out version of Marc input file format and stores ist as MarcVersion -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_fileFormat(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - MarcVersion = IO_intValue(line,chunkPos,2_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_fileFormat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and -!! 'hypoelasticTableStyle' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_tableStyles(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - initialcondTableStyle = 0_pInt - hypoelasticTableStyle = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then - initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) - hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_tableStyles - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_matNumber(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, j, data_blocks - character(len=300) line - -610 FORMAT(A300) - - rewind(fileUnit) - - data_blocks = 1_pInt - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - read (fileUnit,610,END=620) line - if (len(trim(line))/=0_pInt) then - chunkPos = IO_stringPos(line) - data_blocks = IO_intValue(line,chunkPos,1_pInt) - endif - allocate(Marc_matNumber(data_blocks)) - do i=1_pInt,data_blocks ! read all data blocks - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block - read (fileUnit,610,END=620) line - enddo - enddo - exit - endif - enddo - -620 end subroutine mesh_marc_get_matNumber - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores the numbers in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_nodesAndElements(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_IntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) - exit ! assumes that "coordinates" comes later in file - endif - enddo - -620 end subroutine mesh_marc_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- - subroutine mesh_marc_count_elementSets(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then - mesh_NelemSets = mesh_NelemSets + 1_pInt - mesh_maxNelemInSet = max(mesh_maxNelemInSet, & - IO_countContinuousIntValues(fileUnit)) - endif - enddo - -620 end subroutine mesh_marc_count_elementSets - - -!******************************************************************** -! map element sets -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!******************************************************************** -subroutine mesh_marc_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=640) line - chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then - elemSet = elemSet+1_pInt - mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mesh_mapElemSet(:,elemSet) = & - IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - endif - enddo - -640 end subroutine mesh_marc_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues, & - IO_error, & - IO_intValue, & - IO_countNumericalDataLines - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i - character(len=300):: line - - mesh_NcpElems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines - read (fileUnit,610,END=620) line - enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update - exit - endif - enddo - else ! Marc2017 and later - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) - endif - endif - enddo - end if - -620 end subroutine mesh_marc_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line, & - tmp - - integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,cpElem = 0_pInt - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - -610 FORMAT(A300) - - contInts = 0_pInt - rewind(fileUnit) - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - if (MarcVersion < 13) then ! Marc 2016 or earlier - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines - read (fileUnit,610,END=660) line - enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& - mesh_mapElemSet,mesh_NelemSets) - exit - endif - else ! Marc2017 and later - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),"0123456789")/=0) then ! found keyword - exit - else - contInts(1) = contInts(1) + 1_pInt - read (tmp,*) contInts(contInts(1)+1) - endif - enddo - endif - endif - endif - enddo -660 do i = 1_pInt,contInts(1) - cpElem = cpElem+1_pInt - mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) - mesh_mapFEtoCPelem(2,cpElem) = cpElem - enddo - -call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - -end subroutine mesh_marc_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt) :: i - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - -610 FORMAT(A300) - - node_count = 0_pInt - - rewind(fileUnit) - do - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=650) line ! skip crap line - do i = 1_pInt,mesh_Nnodes - read (fileUnit,610,END=650) line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) - mesh_mapFEtoCPnode(2_pInt,i) = i - enddo - exit - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - -end subroutine mesh_marc_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_nodes(fileUnit) - - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue, & - IO_fixedNoEFloatValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=670) line ! skip crap line - do i=1_pInt,mesh_Nnodes - read (fileUnit,610,END=670) line - m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) - do j = 1_pInt,3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) - enddo - enddo - exit - endif - enddo - -670 mesh_node = mesh_node0 - -end subroutine mesh_marc_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_intValue, & - IO_skipChunks - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,t,g,e,c - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - -610 FORMAT(A300) - rewind(fileUnit) - do - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=630) line ! Garbage line - do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) ! limit to id and type - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line - endif - enddo - exit - endif - enddo - -630 end subroutine mesh_marc_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per element. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_fixedNoEFloatValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead - - allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=620) line ! garbage line - do i = 1_pInt,mesh_Nelems - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & - call IO_error(191,el=t,ip=mesh_elemType) - mesh_elemType = t - mesh_element(2,e) = t - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-2_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes - enddo - nNodesAlreadyRead = chunkPos(1) - 2_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - exit - endif - enddo - -620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,610,END=620) line - do - chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then - if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style - read (fileUnit,610,END=630) line ! read line with index of state var - chunkPos = IO_stringPos(line) - sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index - if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest - read (fileUnit,610,END=620) line ! read line with value of state var - chunkPos = IO_stringPos(line) - do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? - myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value - mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index - if (initialcondTableStyle == 2_pInt) then - read (fileUnit,610,END=630) line ! read extra line - read (fileUnit,610,END=630) line ! read extra line - endif - contInts = IO_continuousIntValues& ! get affected elements - (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - do i = 1_pInt,contInts(1) - e = mesh_FEasCP('elem',contInts(1_pInt+i)) - mesh_element(1_pInt+sv,e) = myVal - enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - enddo - endif - else - read (fileUnit,610,END=630) line - endif - enddo - -630 end subroutine mesh_marc_build_elements -#endif - -#ifdef Abaqus !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of nodes and elements in mesh and stores them in !! 'mesh_Nelems' and 'mesh_Nnodes' @@ -2791,7 +1611,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) enddo 630 end subroutine mesh_abaqus_build_elements -#endif + !-------------------------------------------------------------------------------------------------- @@ -2807,25 +1627,14 @@ use IO, only: & implicit none integer(pInt), intent(in) :: fileUnit -#ifdef Spectral - mesh_periodicSurface = .true. - - end subroutine mesh_get_damaskOptions - -#else - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) chunk, Nchunks character(len=300) :: line, damaskOption, v character(len=300) :: keyword mesh_periodicSurface = .false. -#ifdef Marc4DAMASK - keyword = '$damask' -#endif -#ifdef Abaqus keyword = '**damask' -#endif + rewind(fileUnit) do @@ -2849,7 +1658,7 @@ use IO, only: & 610 FORMAT(A300) 620 end subroutine mesh_get_damaskOptions -#endif + !-------------------------------------------------------------------------------------------------- @@ -2925,7 +1734,7 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -#ifndef Spectral + !-------------------------------------------------------------------------------------------------- !> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' !-------------------------------------------------------------------------------------------------- @@ -3227,7 +2036,7 @@ subroutine mesh_build_ipNeighborhood enddo end subroutine mesh_build_ipNeighborhood -#endif + !-------------------------------------------------------------------------------------------------- @@ -3336,14 +2145,6 @@ subroutine mesh_tell_statistics write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) enddo enddo -#ifndef Spectral - write(6,'(/,a,/)') 'Input Parser: NODE TWINS' - write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' - do n = 1_pInt,mesh_Nnodes ! loop over cpNodes - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle - write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) - enddo -#endif write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' do e = 1_pInt,mesh_NcpElems ! loop over cpElems From 09dc1041a55124a0acc8607432d91a73be6f323c Mon Sep 17 00:00:00 2001 From: navyanthkusam Date: Mon, 28 Jan 2019 14:36:44 +0100 Subject: [PATCH 030/309] variable attributes adjusted compiles now --- src/commercialFEM_fileList.f90 | 1 + src/mesh_abaqus.f90 | 8 +++----- src/mesh_marc.f90 | 11 ++++------- 3 files changed, 8 insertions(+), 12 deletions(-) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 7a32e7ade..d2765929f 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -13,6 +13,7 @@ #include "math.f90" #include "FEsolving.f90" #include "element.f90" +#include "mesh_base.f90" #ifdef Abaqus #include "mesh_abaqus.f90" #endif diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index bc14cd418..5d225bfb9 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -406,9 +406,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_mapMaterial !< name of elementSet for material integer(pInt), dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(:,:), allocatable, target :: & - mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] - mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information contains @@ -419,7 +416,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & contains -subroutine tMesh_abaqus_init +subroutine tMesh_abaqus_init(self) implicit none class(tMesh_abaqus) :: self @@ -453,7 +450,8 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & - FEsolving_execElem, & + modelName, & + calcMode, & FEsolving_execElem, & FEsolving_execIP implicit none diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 85b4f3e7d..3e0447285 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -3,7 +3,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver +!> @brief Sets up the mesh for the solver MSC.Marc !-------------------------------------------------------------------------------------------------- module mesh use, intrinsic :: iso_c_binding @@ -400,8 +400,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_marc_count_cpSizes, & mesh_marc_build_elements -contains - type, public, extends(tMesh) :: tMesh_marc integer(pInt), public :: & @@ -417,10 +415,7 @@ type, public, extends(tMesh) :: tMesh_marc mapMaterial !< name of elementSet for material integer(pInt), dimension(:), allocatable :: & Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) - integer(pInt), dimension(:,:), allocatable, target:: & - mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] - mesh_mapFEtoCPnode - integer(pInt), private :: & + integer(pInt) :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element mesh_NelemSets, & @@ -435,6 +430,8 @@ type, public, extends(tMesh) :: tMesh_marc end type tMesh_marc type(tMesh_marc), public, protected :: theMesh + + contains subroutine tMesh_marc_init(self) From 346561beed2e7f8332158f1a277fce17612c0289 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Jan 2019 18:46:47 +0100 Subject: [PATCH 031/309] fixed dependencies --- src/CMakeLists.txt | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 62f44dacb..8d0697a65 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -7,6 +7,7 @@ endif() # The dependency detection in CMake is not functioning for Fortran, # hence we declare the dependencies from top to bottom in the following + add_library(C_ROUTINES OBJECT "C_routines.c") set(OBJECTFILES $) @@ -38,7 +39,7 @@ add_dependencies(NUMERICS IO) list(APPEND OBJECTFILES $) add_library(DEBUG OBJECT "debug.f90") -add_dependencies(DEBUG NUMERICS) +add_dependencies(DEBUG IO) list(APPEND OBJECTFILES $) add_library(DAMASK_CONFIG OBJECT "config.f90") @@ -46,7 +47,7 @@ add_dependencies(DAMASK_CONFIG DEBUG) list(APPEND OBJECTFILES $) add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90") -add_dependencies(HDF5_UTILITIES DAMASK_CONFIG) +add_dependencies(HDF5_UTILITIES DAMASK_CONFIG NUMERICS) list(APPEND OBJECTFILES $) add_library(RESULTS OBJECT "results.f90") @@ -54,28 +55,28 @@ add_dependencies(RESULTS HDF5_UTILITIES) list(APPEND OBJECTFILES $) add_library(FEsolving OBJECT "FEsolving.f90") -add_dependencies(FEsolving RESULTS) +add_dependencies(FEsolving DEBUG) list(APPEND OBJECTFILES $) add_library(MATH OBJECT "math.f90") -add_dependencies(MATH FEsolving) +add_dependencies(MATH NUMERICS) list(APPEND OBJECTFILES $) add_library(MESH_BASE OBJECT "mesh_base.f90") -add_dependencies(MESH_BASE MATH ELEMENT) +add_dependencies(MESH_BASE ELEMENT) list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh_grid.f90") - add_dependencies(MESH MATH) + add_dependencies(MESH MESH_BASE MATH FEsolving) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") - add_dependencies(FEZoo MATH) + add_dependencies(FEZoo IO) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "mesh_FEM.f90") - add_dependencies(MESH FEZoo) + add_dependencies(MESH FEZoo MESH_BASE MATH FEsolving) list(APPEND OBJECTFILES $) endif() @@ -83,9 +84,9 @@ add_library(MATERIAL OBJECT "material.f90") add_dependencies(MATERIAL MESH DAMASK_CONFIG) list(APPEND OBJECTFILES $) -add_library(DAMASK_HELPERS OBJECT "lattice.f90") -add_dependencies(DAMASK_HELPERS MATERIAL) -list(APPEND OBJECTFILES $) +add_library(LATTICE OBJECT "lattice.f90") +add_dependencies(LATTICE MATERIAL) +list(APPEND OBJECTFILES $) # For each modular section add_library (PLASTIC OBJECT @@ -96,14 +97,14 @@ add_library (PLASTIC OBJECT "plastic_kinematichardening.f90" "plastic_nonlocal.f90" "plastic_none.f90") -add_dependencies(PLASTIC DAMASK_HELPERS) +add_dependencies(PLASTIC LATTICE RESULTS) list(APPEND OBJECTFILES $) add_library (KINEMATICS OBJECT "kinematics_cleavage_opening.f90" "kinematics_slipplane_opening.f90" "kinematics_thermal_expansion.f90") -add_dependencies(KINEMATICS DAMASK_HELPERS) +add_dependencies(KINEMATICS LATTICE RESULTS) list(APPEND OBJECTFILES $) add_library (SOURCE OBJECT @@ -113,7 +114,7 @@ add_library (SOURCE OBJECT "source_damage_isoDuctile.f90" "source_damage_anisoBrittle.f90" "source_damage_anisoDuctile.f90") -add_dependencies(SOURCE DAMASK_HELPERS) +add_dependencies(SOURCE LATTICE RESULTS) list(APPEND OBJECTFILES $) add_library(CONSTITUTIVE OBJECT "constitutive.f90") From b62232022b4cad4187e65d0427c1680d05b6a100 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 00:27:58 +0100 Subject: [PATCH 032/309] polishing --- src/crystallite.f90 | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 1b97f74c2..19727af7d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -69,7 +69,7 @@ module crystallite crystallite_subS0, & !< 2nd Piola-Kirchhoff stress vector at start of crystallite inc crystallite_invFp, & !< inverse of current plastic def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc - crystallite_invFi, & !< inverse of current intermediate def grad + crystallite_invFi, & !< inverse of current intermediate def grad (end of converged time step) crystallite_subFi0,& !< intermediate def grad at start of crystallite inc crystallite_subF, & !< def grad to be reached at end of crystallite inc crystallite_subF0, & !< def grad at start of crystallite inc @@ -666,14 +666,14 @@ function crystallite_stress() ! return whether converged or not crystallite_stress = .false. elementLooping5: do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) crystallite_stress(i,e) = all(crystallite_converged(:,i,e)) enddo enddo elementLooping5 #ifdef DEBUG elementLooping6: do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do c = 1,homogenization_Ngrains(mesh_element(3,e)) if (.not. crystallite_converged(c,i,e)) then if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & @@ -844,17 +844,16 @@ subroutine crystallite_stressTangent() !-------------------------------------------------------------------------------------------------- ! assemble dPdF temp_33_1 = math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), & - math_mul33x33(math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & - transpose(crystallite_invFp(1:3,1:3,c,i,e)))) + math_mul33x33(math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & + transpose(crystallite_invFp(1:3,1:3,c,i,e)))) temp_33_2 = math_mul33x33(math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & - transpose(crystallite_invFp(1:3,1:3,c,i,e))) + transpose(crystallite_invFp(1:3,1:3,c,i,e))) temp_33_3 = math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), & - crystallite_invFp(1:3,1:3,c,i,e)) + crystallite_invFp(1:3,1:3,c,i,e)) temp_33_4 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), & - crystallite_invFp(1:3,1:3,c,i,e)), & - math_6toSym33(crystallite_Tstar_v(1:6,c,i,e))) + crystallite_invFp(1:3,1:3,c,i,e)), & + math_6toSym33(crystallite_Tstar_v(1:6,c,i,e))) - crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal do p=1_pInt, 3_pInt crystallite_dPdF(p,1:3,p,1:3,c,i,e) = transpose(temp_33_1) enddo @@ -1628,10 +1627,10 @@ subroutine integrateStateFPI() !$OMP& plasticStateResiduum,sourceStateResiduum, & !$OMP& plasticStatedamper,sourceStateDamper, & !$OMP& tempPlasticState,tempSourceState,converged,p,c) - do e = FEsolving_execElem(1),FEsolving_execElem(2) + do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) -if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e) c = phasememberAt(g,i,e) @@ -1787,9 +1786,9 @@ if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then contains -!-------------------------------------------------------------------------------------------------- -!> @brief calculate the damping for correction of state and dot state -!-------------------------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- real(pReal) pure function damper(current,previous,previous2) implicit none From 2f9a571b9626682a7708fb3c960f763dacedf4ee Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 00:38:18 +0100 Subject: [PATCH 033/309] no need for 2 variables --- src/crystallite.f90 | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 19727af7d..358dacea8 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1571,8 +1571,7 @@ subroutine integrateStateFPI() real(pReal) :: & dot_prod12, & dot_prod22, & - plasticStateDamper, & ! damper for integration of state - sourceStateDamper + stateDamper real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & plasticStateResiduum, & tempPlasticState @@ -1625,7 +1624,7 @@ subroutine integrateStateFPI() !$OMP DO PRIVATE(dot_prod12,dot_prod22, & !$OMP& mySizePlasticDotState,mySizeSourceDotState, & !$OMP& plasticStateResiduum,sourceStateResiduum, & - !$OMP& plasticStatedamper,sourceStateDamper, & + !$OMP& stateDamper, & !$OMP& tempPlasticState,tempSourceState,converged,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) @@ -1646,9 +1645,9 @@ subroutine integrateStateFPI() .and. ( dot_prod12 < 0.0_pReal & .or. dot_product(plasticState(p)%dotState(:,c), & plasticState(p)%previousDotState(:,c)) < 0.0_pReal) ) then - plasticStateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + stateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else - plasticStateDamper = 1.0_pReal + stateDamper = 1.0_pReal endif ! --- get residui --- @@ -1656,9 +1655,9 @@ subroutine integrateStateFPI() plasticStateResiduum(1:mySizePlasticDotState) = & plasticState(p)%state(1:mySizePlasticDotState,c) & - plasticState(p)%subState0(1:mySizePlasticDotState,c) & - - ( plasticState(p)%dotState(1:mySizePlasticDotState,c) * plasticStateDamper & + - ( plasticState(p)%dotState(1:mySizePlasticDotState,c) * stateDamper & + plasticState(p)%previousDotState(1:mySizePlasticDotState,c) & - * (1.0_pReal - plasticStateDamper)) * crystallite_subdt(g,i,e) + * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- tempPlasticState(1:mySizePlasticDotState) = & @@ -1667,9 +1666,9 @@ subroutine integrateStateFPI() ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * plasticStateDamper & + plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) & - * (1.0_pReal - plasticStateDamper) + * (1.0_pReal - stateDamper) do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState @@ -1686,18 +1685,18 @@ subroutine integrateStateFPI() .and. ( dot_prod12 < 0.0_pReal & .or. dot_product(sourceState(p)%p(mySource)%dotState(:,c), & sourceState(p)%p(mySource)%previousDotState(:,c)) < 0.0_pReal) ) then - sourceStateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + stateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else - sourceStateDamper = 1.0_pReal + stateDamper = 1.0_pReal endif ! --- get residui --- mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState sourceStateResiduum(1:mySizeSourceDotState,mySource) = & sourceState(p)%p(mySource)%state(1:mySizeSourceDotState,c) & - sourceState(p)%p(mySource)%subState0(1:mySizeSourceDotState,c) & - - ( sourceState(p)%p(mySource)%dotState(1:mySizeSourceDotState,c) * sourceStateDamper & + - ( sourceState(p)%p(mySource)%dotState(1:mySizeSourceDotState,c) * stateDamper & + sourceState(p)%p(mySource)%previousDotState(1:mySizeSourceDotState,c) & - * (1.0_pReal - sourceStateDamper)) * crystallite_subdt(g,i,e) + * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- tempSourceState(1:mySizeSourceDotState,mySource) = & @@ -1706,9 +1705,9 @@ subroutine integrateStateFPI() ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) sourceState(p)%p(mySource)%dotState(:,c) = & - sourceState(p)%p(mySource)%dotState(:,c) * sourceStateDamper & + sourceState(p)%p(mySource)%dotState(:,c) * stateDamper & + sourceState(p)%p(mySource)%previousDotState(:,c) & - * (1.0_pReal - sourceStateDamper) + * (1.0_pReal - stateDamper) enddo From 2cf44f4060f64d20001fc545e7a419c50509a7ef Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 00:39:44 +0100 Subject: [PATCH 034/309] shorter --- src/crystallite.f90 | 69 ++++++++++++++++++++++----------------------- 1 file changed, 34 insertions(+), 35 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 358dacea8..0ae050173 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1565,7 +1565,6 @@ subroutine integrateStateFPI() p, & c, & s, & - mySource, & mySizePlasticDotState, & ! size of dot states mySizeSourceDotState real(pReal) :: & @@ -1670,43 +1669,43 @@ subroutine integrateStateFPI() + plasticState(p)%previousDotState(:,c) & * (1.0_pReal - stateDamper) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - dot_prod12 = dot_product( sourceState(p)%p(mySource)%dotState (:,c) & - - sourceState(p)%p(mySource)%previousDotState (:,c), & - sourceState(p)%p(mySource)%previousDotState (:,c) & - - sourceState(p)%p(mySource)%previousDotState2(:,c)) - dot_prod22 = dot_product( sourceState(p)%p(mySource)%previousDotState (:,c) & - - sourceState(p)%p(mySource)%previousDotState2(:,c), & - sourceState(p)%p(mySource)%previousDotState (:,c) & - - sourceState(p)%p(mySource)%previousDotState2(:,c)) + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + dot_prod12 = dot_product( sourceState(p)%p(s)%dotState (:,c) & + - sourceState(p)%p(s)%previousDotState (:,c), & + sourceState(p)%p(s)%previousDotState (:,c) & + - sourceState(p)%p(s)%previousDotState2(:,c)) + dot_prod22 = dot_product( sourceState(p)%p(s)%previousDotState (:,c) & + - sourceState(p)%p(s)%previousDotState2(:,c), & + sourceState(p)%p(s)%previousDotState (:,c) & + - sourceState(p)%p(s)%previousDotState2(:,c)) if ( dot_prod22 > 0.0_pReal & .and. ( dot_prod12 < 0.0_pReal & - .or. dot_product(sourceState(p)%p(mySource)%dotState(:,c), & - sourceState(p)%p(mySource)%previousDotState(:,c)) < 0.0_pReal) ) then + .or. dot_product(sourceState(p)%p(s)%dotState(:,c), & + sourceState(p)%p(s)%previousDotState(:,c)) < 0.0_pReal) ) then stateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else stateDamper = 1.0_pReal endif ! --- get residui --- - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - sourceStateResiduum(1:mySizeSourceDotState,mySource) = & - sourceState(p)%p(mySource)%state(1:mySizeSourceDotState,c) & - - sourceState(p)%p(mySource)%subState0(1:mySizeSourceDotState,c) & - - ( sourceState(p)%p(mySource)%dotState(1:mySizeSourceDotState,c) * stateDamper & - + sourceState(p)%p(mySource)%previousDotState(1:mySizeSourceDotState,c) & + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sourceStateResiduum(1:mySizeSourceDotState,s) = & + sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) & + - sourceState(p)%p(s)%subState0(1:mySizeSourceDotState,c) & + - ( sourceState(p)%p(s)%dotState(1:mySizeSourceDotState,c) * stateDamper & + + sourceState(p)%p(s)%previousDotState(1:mySizeSourceDotState,c) & * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- - tempSourceState(1:mySizeSourceDotState,mySource) = & - sourceState(p)%p(mySource)%state(1:mySizeSourceDotState,c) & - - sourceStateResiduum(1:mySizeSourceDotState,mySource) ! need to copy to local variable, since we cant flush a pointer in openmp + tempSourceState(1:mySizeSourceDotState,s) = & + sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) & + - sourceStateResiduum(1:mySizeSourceDotState,s) ! need to copy to local variable, since we cant flush a pointer in openmp ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) - sourceState(p)%p(mySource)%dotState(:,c) = & - sourceState(p)%p(mySource)%dotState(:,c) * stateDamper & - + sourceState(p)%p(mySource)%previousDotState(:,c) & + sourceState(p)%p(s)%dotState(:,c) = & + sourceState(p)%p(s)%dotState(:,c) * stateDamper & + + sourceState(p)%p(s)%previousDotState(:,c) & * (1.0_pReal - stateDamper) enddo @@ -1716,22 +1715,22 @@ subroutine integrateStateFPI() plasticState(p)%aTolState(1:mySizePlasticDotState) & .or. abs(plasticStateResiduum(1:mySizePlasticDotState)) < & rTol_crystalliteState * abs(tempPlasticState(1:mySizePlasticDotState))) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState converged = converged .and. & - all( abs(sourceStateResiduum(1:mySizeSourceDotState,mySource)) < & - sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState) & - .or. abs(sourceStateResiduum(1:mySizeSourceDotState,mySource)) < & - rTol_crystalliteState * abs(tempSourceState(1:mySizeSourceDotState,mySource))) + all( abs(sourceStateResiduum(1:mySizeSourceDotState,s)) < & + sourceState(p)%p(s)%aTolState(1:mySizeSourceDotState) & + .or. abs(sourceStateResiduum(1:mySizeSourceDotState,s)) < & + rTol_crystalliteState * abs(tempSourceState(1:mySizeSourceDotState,s))) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition plasticState(p)%state(1:mySizePlasticDotState,c) = & tempPlasticState(1:mySizePlasticDotState) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - sourceState(p)%p(mySource)%state(1:mySizeSourceDotState,c) = & - tempSourceState(1:mySizeSourceDotState,mySource) + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) = & + tempSourceState(1:mySizeSourceDotState,s) enddo endif enddo; enddo; enddo From ee586dfa0c0a99e7e93556a6ff356b9552cb702e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 00:46:57 +0100 Subject: [PATCH 035/309] avoid code duplication --- src/crystallite.f90 | 47 +++++++-------------------------------------- 1 file changed, 7 insertions(+), 40 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0ae050173..ad12b455e 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1568,8 +1568,6 @@ subroutine integrateStateFPI() mySizePlasticDotState, & ! size of dot states mySizeSourceDotState real(pReal) :: & - dot_prod12, & - dot_prod22, & stateDamper real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & plasticStateResiduum, & @@ -1620,8 +1618,7 @@ subroutine integrateStateFPI() !$OMP PARALLEL ! --- UPDATE STATE --- - !$OMP DO PRIVATE(dot_prod12,dot_prod22, & - !$OMP& mySizePlasticDotState,mySizeSourceDotState, & + !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState, & !$OMP& plasticStateResiduum,sourceStateResiduum, & !$OMP& stateDamper, & !$OMP& tempPlasticState,tempSourceState,converged,p,c) @@ -1632,23 +1629,9 @@ subroutine integrateStateFPI() p = phaseAt(g,i,e) c = phasememberAt(g,i,e) - dot_prod12 = dot_product( plasticState(p)%dotState (:,c) & - - plasticState(p)%previousDotState (:,c), & - plasticState(p)%previousDotState (:,c) & - - plasticState(p)%previousDotState2(:,c)) - dot_prod22 = dot_product( plasticState(p)%previousDotState (:,c) & - - plasticState(p)%previousDotState2(:,c), & - plasticState(p)%previousDotState (:,c) & - - plasticState(p)%previousDotState2(:,c)) - if ( dot_prod22 > 0.0_pReal & - .and. ( dot_prod12 < 0.0_pReal & - .or. dot_product(plasticState(p)%dotState(:,c), & - plasticState(p)%previousDotState(:,c)) < 0.0_pReal) ) then - stateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - stateDamper = 1.0_pReal - endif - ! --- get residui --- + StateDamper = damper(plasticState(p)%dotState (:,c), & + plasticState(p)%previousDotState (:,c), & + plasticState(p)%previousDotState2(:,c)) mySizePlasticDotState = plasticState(p)%sizeDotState plasticStateResiduum(1:mySizePlasticDotState) = & @@ -1670,25 +1653,9 @@ subroutine integrateStateFPI() * (1.0_pReal - stateDamper) do s = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState - dot_prod12 = dot_product( sourceState(p)%p(s)%dotState (:,c) & - - sourceState(p)%p(s)%previousDotState (:,c), & - sourceState(p)%p(s)%previousDotState (:,c) & - - sourceState(p)%p(s)%previousDotState2(:,c)) - dot_prod22 = dot_product( sourceState(p)%p(s)%previousDotState (:,c) & - - sourceState(p)%p(s)%previousDotState2(:,c), & - sourceState(p)%p(s)%previousDotState (:,c) & - - sourceState(p)%p(s)%previousDotState2(:,c)) - - if ( dot_prod22 > 0.0_pReal & - .and. ( dot_prod12 < 0.0_pReal & - .or. dot_product(sourceState(p)%p(s)%dotState(:,c), & - sourceState(p)%p(s)%previousDotState(:,c)) < 0.0_pReal) ) then - stateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - stateDamper = 1.0_pReal - endif - ! --- get residui --- + StateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & + sourceState(p)%p(s)%previousDotState (:,c), & + sourceState(p)%p(s)%previousDotState2(:,c)) mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState sourceStateResiduum(1:mySizeSourceDotState,s) = & sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) & From 9892da717a12f8fb44ea63165f1ea784ed44f17b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 07:06:16 +0100 Subject: [PATCH 036/309] bugfix: missing initialization --- src/crystallite.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index ad12b455e..da603a2bd 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -854,6 +854,7 @@ subroutine crystallite_stressTangent() crystallite_invFp(1:3,1:3,c,i,e)), & math_6toSym33(crystallite_Tstar_v(1:6,c,i,e))) + crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal do p=1_pInt, 3_pInt crystallite_dPdF(p,1:3,p,1:3,c,i,e) = transpose(temp_33_1) enddo From 3fdf8e19bb1b0483c234c686a63eb4dbe7f1796c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 00:54:02 +0100 Subject: [PATCH 037/309] further simplifications --- src/crystallite.f90 | 34 ++++++++++++---------------------- 1 file changed, 12 insertions(+), 22 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index da603a2bd..ab99156d0 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1861,18 +1861,13 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & ! contribution to state and relative residui and from Euler integration call update_dotState(1.0_pReal) - !$OMP PARALLEL - - - ! --- STATE UPDATE (EULER INTEGRATION) --- - - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c) + !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - c = phasememberAt(g,i,e) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + mySizePlasticDotState = plasticState(p)%sizeDotState plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & - 0.5_pReal & @@ -1895,28 +1890,24 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & enddo endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO + call update_deltaState call update_dependentState call update_stress(1.0_pReal) call update_dotState(1.0_pReal) - !$OMP PARALLEL - ! --- ERROR ESTIMATE FOR STATE (HEUN METHOD) --- - - !$OMP SINGLE relPlasticStateResiduum = 0.0_pReal relSourceStateResiduum = 0.0_pReal - !$OMP END SINGLE - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,converged,p,c,s) + + !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,converged,p,c,s) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - c = phasememberAt(g,i,e) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + ! --- contribution of heun step to absolute residui --- mySizePlasticDotState = plasticState(p)%sizeDotState plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & @@ -1958,8 +1949,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definitionem endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO ! --- NONLOCAL CONVERGENCE CHECK --- From 1e4da6fbdb17f8a1ed70c0474755f4da8a8f70fc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 05:11:29 +0100 Subject: [PATCH 038/309] nonlocal convergence check in function --- src/crystallite.f90 | 108 ++++++++++++++++++-------------------------- 1 file changed, 44 insertions(+), 64 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index ab99156d0..14a54492a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1542,8 +1542,7 @@ subroutine integrateStateFPI() nState, & rTol_crystalliteState use mesh, only: & - mesh_element, & - mesh_NcpElems + mesh_element use material, only: & plasticState, & sourceState, & @@ -1727,12 +1726,7 @@ subroutine integrateStateFPI() !$OMP END PARALLEL - ! --- NON-LOCAL CONVERGENCE CHECK --- - - if (any(plasticState(:)%nonlocal)) then ! if not requesting Integration of just a single IP - if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged - endif + if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck ! --- CHECK IF DONE WITH INTEGRATION --- @@ -1777,26 +1771,21 @@ end subroutine integrateStateFPI !-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, and state with 1st order explicit Euler method +!> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- subroutine integrateStateEuler() use material, only: & plasticState + implicit none call update_dotState(1.0_pReal) - call update_State(1.0_pReal) + call update_state(1.0_pReal) call update_deltaState call update_dependentState call update_stress(1.0_pReal) call setConvergenceFlag - - ! --- CHECK NON-LOCAL CONVERGENCE --- - - if (any(plasticState(:)%nonlocal)) then - if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity) ) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged - endif + if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck end subroutine integrateStateEuler @@ -1848,8 +1837,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & relSourceStateResiduum ! relative residuum from evolution in microstructure logical :: & - converged, & - NaN + converged plasticStateResiduum = 0.0_pReal @@ -1951,13 +1939,8 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & enddo; enddo; enddo !$OMP END PARALLEL DO + if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck - ! --- NONLOCAL CONVERGENCE CHECK --- - - if (any(plasticState(:)%nonlocal)) then - if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity) ) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged - endif end subroutine integrateStateAdaptiveEuler @@ -2038,7 +2021,9 @@ subroutine integrateStateRK4() !$OMP PARALLEL !$OMP DO PRIVATE(p,c) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) c = phasememberAt(g,i,e) @@ -2066,14 +2051,9 @@ subroutine integrateStateRK4() enddo + call setConvergenceFlag - - ! --- CHECK NONLOCAL CONVERGENCE --- - - if (any(plasticState(:)%nonlocal)) then - if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity) ) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged - endif + if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck end subroutine integrateStateRK4 @@ -2148,11 +2128,7 @@ subroutine integrateStateRKCK45() mySource, & mySizePlasticDotState, & ! size of dot States mySizeSourceDotState - integer(pInt), dimension(2) :: & - eIter ! bounds for element iteration - integer(pInt), dimension(2,mesh_NcpElems) :: & - iIter, & ! bounds for ip iteration - gIter ! bounds for grain iteration + real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & @@ -2163,18 +2139,7 @@ subroutine integrateStateRKCK45() homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & sourceStateResiduum, & ! residuum from evolution in microstructure relSourceStateResiduum ! relative residuum from evolution in microstructure - logical :: & - singleRun ! flag indicating computation for single (g,i,e) triple - eIter = FEsolving_execElem(1:2) - - ! --- LOOP ITERATOR FOR ELEMENT, GRAIN, IP --- - do e = eIter(1),eIter(2) - iIter(1:2,e) = FEsolving_execIP(1:2,e) - gIter(1:2,e) = [ 1_pInt,homogenization_Ngrains(mesh_element(3,e))] - enddo - - singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) call update_dotState(1.0_pReal) @@ -2188,7 +2153,9 @@ subroutine integrateStateRKCK45() !$OMP PARALLEL !$OMP DO PRIVATE(p,cc) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) @@ -2201,7 +2168,9 @@ subroutine integrateStateRKCK45() !$OMP ENDDO !$OMP DO PRIVATE(p,cc,n) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) @@ -2239,7 +2208,9 @@ subroutine integrateStateRKCK45() relSourceStateResiduum = 0.0_pReal !$OMP PARALLEL !$OMP DO PRIVATE(p,cc) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) @@ -2252,7 +2223,9 @@ subroutine integrateStateRKCK45() !$OMP ENDDO !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) @@ -2288,7 +2261,9 @@ subroutine integrateStateRKCK45() ! --- relative residui and state convergence --- !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc,s) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) @@ -2324,15 +2299,25 @@ subroutine integrateStateRKCK45() call update_dependentState call update_stress(1.0_pReal) call setConvergenceFlag - - - ! --- nonlocal convergence check --- - if ((.not. singleRun) .and. any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged + if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck end subroutine integrateStateRKCK45 +!-------------------------------------------------------------------------------------------------- +!> @brief sets convergence flag for nonlocal calculations +!> @detail one non-converged nonlocal sets all other nonlocals to non-converged to trigger cut back +!-------------------------------------------------------------------------------------------------- +subroutine nonlocalConvergenceCheck() + + implicit none + + if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... + where( .not. crystallite_localPlasticity) crystallite_converged = .false. + +end subroutine nonlocalConvergenceCheck + + !-------------------------------------------------------------------------------------------------- !> @brief Sets convergence flag based on "todo": every point that survived the integration (todo is ! still .true. is considered as converged @@ -2361,11 +2346,6 @@ end subroutine setConvergenceFlag !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- subroutine update_stress(timeFraction) - use material, only: & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt implicit none real(pReal), intent(in) :: & From 4a69032637141f7856e2bf65a72bfc0579ef66ed Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 05:16:56 +0100 Subject: [PATCH 039/309] better readable --- src/crystallite.f90 | 19 ++++--------------- 1 file changed, 4 insertions(+), 15 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 14a54492a..8ae1df5af 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2065,17 +2065,6 @@ end subroutine integrateStateRK4 subroutine integrateStateRKCK45() use, intrinsic :: & IEEE_arithmetic -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif use numerics, only: & rTol_crystalliteState use mesh, only: & @@ -2098,11 +2087,11 @@ subroutine integrateStateRKCK45() implicit none real(pReal), dimension(5,5), parameter :: & A = reshape([& - .2_pReal, .075_pReal, .3_pReal, -11.0_pReal/54.0_pReal, 1631.0_pReal/55296.0_pReal, & - .0_pReal, .225_pReal, -.9_pReal, 2.5_pReal, 175.0_pReal/512.0_pReal, & - .0_pReal, .0_pReal, 1.2_pReal, -70.0_pReal/27.0_pReal, 575.0_pReal/13824.0_pReal, & + .2_pReal, .075_pReal, .3_pReal, -11.0_pReal/54.0_pReal, 1631.0_pReal/55296.0_pReal, & + .0_pReal, .225_pReal, -.9_pReal, 2.5_pReal, 175.0_pReal/512.0_pReal, & + .0_pReal, .0_pReal, 1.2_pReal, -70.0_pReal/27.0_pReal, 575.0_pReal/13824.0_pReal, & .0_pReal, .0_pReal, .0_pReal, 35.0_pReal/27.0_pReal, 44275.0_pReal/110592.0_pReal, & - .0_pReal, .0_pReal, .0_pReal, .0_pReal, 253.0_pReal/4096.0_pReal], & + .0_pReal, .0_pReal, .0_pReal, .0_pReal, 253.0_pReal/4096.0_pReal], & [5,5], order=[2,1]) !< coefficients in Butcher tableau (used for preliminary integration in stages 2 to 6) real(pReal), dimension(6), parameter :: & From a24d8b86bf44255e5fc9d29879d92eac6bafab59 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 05:20:16 +0100 Subject: [PATCH 040/309] convergence of plastic state can be done earlier --- src/crystallite.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 8ae1df5af..475d7dc2a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1651,6 +1651,13 @@ subroutine integrateStateFPI() plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) & * (1.0_pReal - stateDamper) + + converged = all( abs(plasticStateResiduum(1:mySizePlasticDotState)) < & + plasticState(p)%aTolState(1:mySizePlasticDotState) & + .or. abs(plasticStateResiduum(1:mySizePlasticDotState)) < & + rTol_crystalliteState * abs(tempPlasticState(1:mySizePlasticDotState))) + + plasticState(p)%state(1:mySizePlasticDotState,c) = tempPlasticState(1:mySizePlasticDotState) do s = 1_pInt, phase_Nsources(p) StateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & @@ -1676,12 +1683,6 @@ subroutine integrateStateFPI() * (1.0_pReal - stateDamper) enddo - - ! --- converged ? --- - converged = all( abs(plasticStateResiduum(1:mySizePlasticDotState)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState) & - .or. abs(plasticStateResiduum(1:mySizePlasticDotState)) < & - rTol_crystalliteState * abs(tempPlasticState(1:mySizePlasticDotState))) do s = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState converged = converged .and. & @@ -1692,8 +1693,7 @@ subroutine integrateStateFPI() enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition - plasticState(p)%state(1:mySizePlasticDotState,c) = & - tempPlasticState(1:mySizePlasticDotState) + do s = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) = & From 41832fb554335c1ae0624fc310c749d40cfa542f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 05:39:01 +0100 Subject: [PATCH 041/309] no need for two variables only resulted in confusing code --- src/crystallite.f90 | 67 ++++++++++++++++++++++----------------------- 1 file changed, 33 insertions(+), 34 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 475d7dc2a..74dfd3731 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1565,8 +1565,7 @@ subroutine integrateStateFPI() p, & c, & s, & - mySizePlasticDotState, & ! size of dot states - mySizeSourceDotState + sizeDotState real(pReal) :: & stateDamper real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & @@ -1618,7 +1617,7 @@ subroutine integrateStateFPI() !$OMP PARALLEL ! --- UPDATE STATE --- - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState, & + !$OMP DO PRIVATE(sizeDotState, & !$OMP& plasticStateResiduum,sourceStateResiduum, & !$OMP& stateDamper, & !$OMP& tempPlasticState,tempSourceState,converged,p,c) @@ -1633,18 +1632,18 @@ subroutine integrateStateFPI() plasticState(p)%previousDotState (:,c), & plasticState(p)%previousDotState2(:,c)) - mySizePlasticDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:mySizePlasticDotState) = & - plasticState(p)%state(1:mySizePlasticDotState,c) & - - plasticState(p)%subState0(1:mySizePlasticDotState,c) & - - ( plasticState(p)%dotState(1:mySizePlasticDotState,c) * stateDamper & - + plasticState(p)%previousDotState(1:mySizePlasticDotState,c) & + sizeDotState = plasticState(p)%sizeDotState + plasticStateResiduum(1:sizeDotState) = & + plasticState(p)%state(1:sizeDotState,c) & + - plasticState(p)%subState0(1:sizeDotState,c) & + - ( plasticState(p)%dotState(1:sizeDotState,c) * stateDamper & + + plasticState(p)%previousDotState(1:sizeDotState,c) & * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- - tempPlasticState(1:mySizePlasticDotState) = & - plasticState(p)%state(1:mySizePlasticDotState,c) & - - plasticStateResiduum(1:mySizePlasticDotState) ! need to copy to local variable, since we cant flush a pointer in openmp + tempPlasticState(1:sizeDotState) = & + plasticState(p)%state(1:sizeDotState,c) & + - plasticStateResiduum(1:sizeDotState) ! need to copy to local variable, since we cant flush a pointer in openmp ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) @@ -1652,29 +1651,29 @@ subroutine integrateStateFPI() + plasticState(p)%previousDotState(:,c) & * (1.0_pReal - stateDamper) - converged = all( abs(plasticStateResiduum(1:mySizePlasticDotState)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState) & - .or. abs(plasticStateResiduum(1:mySizePlasticDotState)) < & - rTol_crystalliteState * abs(tempPlasticState(1:mySizePlasticDotState))) + converged = all( abs(plasticStateResiduum(1:sizeDotState)) < & + plasticState(p)%aTolState(1:sizeDotState) & + .or. abs(plasticStateResiduum(1:sizeDotState)) < & + rTol_crystalliteState * abs(tempPlasticState(1:sizeDotState))) - plasticState(p)%state(1:mySizePlasticDotState,c) = tempPlasticState(1:mySizePlasticDotState) + plasticState(p)%state(1:sizeDotState,c) = tempPlasticState(1:sizeDotState) do s = 1_pInt, phase_Nsources(p) StateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & sourceState(p)%p(s)%previousDotState (:,c), & sourceState(p)%p(s)%previousDotState2(:,c)) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:mySizeSourceDotState,s) = & - sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) & - - sourceState(p)%p(s)%subState0(1:mySizeSourceDotState,c) & - - ( sourceState(p)%p(s)%dotState(1:mySizeSourceDotState,c) * stateDamper & - + sourceState(p)%p(s)%previousDotState(1:mySizeSourceDotState,c) & + sizeDotState = sourceState(p)%p(s)%sizeDotState + sourceStateResiduum(1:sizeDotState,s) = & + sourceState(p)%p(s)%state(1:sizeDotState,c) & + - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & + - ( sourceState(p)%p(s)%dotState(1:sizeDotState,c) * stateDamper & + + sourceState(p)%p(s)%previousDotState(1:sizeDotState,c) & * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- - tempSourceState(1:mySizeSourceDotState,s) = & - sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) & - - sourceStateResiduum(1:mySizeSourceDotState,s) ! need to copy to local variable, since we cant flush a pointer in openmp + tempSourceState(1:sizeDotState,s) = & + sourceState(p)%p(s)%state(1:sizeDotState,c) & + - sourceStateResiduum(1:sizeDotState,s) ! need to copy to local variable, since we cant flush a pointer in openmp ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) sourceState(p)%p(s)%dotState(:,c) = & @@ -1684,20 +1683,20 @@ subroutine integrateStateFPI() enddo do s = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sizeDotState = sourceState(p)%p(s)%sizeDotState converged = converged .and. & - all( abs(sourceStateResiduum(1:mySizeSourceDotState,s)) < & - sourceState(p)%p(s)%aTolState(1:mySizeSourceDotState) & - .or. abs(sourceStateResiduum(1:mySizeSourceDotState,s)) < & - rTol_crystalliteState * abs(tempSourceState(1:mySizeSourceDotState,s))) + all( abs(sourceStateResiduum(1:sizeDotState,s)) < & + sourceState(p)%p(s)%aTolState(1:sizeDotState) & + .or. abs(sourceStateResiduum(1:sizeDotState,s)) < & + rTol_crystalliteState * abs(tempSourceState(1:sizeDotState,s))) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition do s = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) = & - tempSourceState(1:mySizeSourceDotState,s) + sizeDotState = sourceState(p)%p(s)%sizeDotState + sourceState(p)%p(s)%state(1:sizeDotState,c) = & + tempSourceState(1:sizeDotState,s) enddo endif enddo; enddo; enddo From 34f3c15552a3639cbe7acbd89f8b001cc123bfef Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 05:47:13 +0100 Subject: [PATCH 042/309] no need for temp variables --- src/crystallite.f90 | 28 ++++++++-------------------- 1 file changed, 8 insertions(+), 20 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 74dfd3731..8efe15040 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1569,11 +1569,9 @@ subroutine integrateStateFPI() real(pReal) :: & stateDamper real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & - plasticStateResiduum, & - tempPlasticState + plasticStateResiduum real(pReal), dimension(constitutive_source_maxSizeDotState, maxval(phase_Nsources)) :: & - sourceStateResiduum, & ! residuum from evolution in micrstructure - tempSourceState + sourceStateResiduum logical :: & converged, & doneWithIntegration @@ -1619,8 +1617,7 @@ subroutine integrateStateFPI() !$OMP DO PRIVATE(sizeDotState, & !$OMP& plasticStateResiduum,sourceStateResiduum, & - !$OMP& stateDamper, & - !$OMP& tempPlasticState,tempSourceState,converged,p,c) + !$OMP& stateDamper, converged,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -1641,11 +1638,10 @@ subroutine integrateStateFPI() * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- - tempPlasticState(1:sizeDotState) = & + plasticState(p)%state(1:sizeDotState,c) = & plasticState(p)%state(1:sizeDotState,c) & - - plasticStateResiduum(1:sizeDotState) ! need to copy to local variable, since we cant flush a pointer in openmp + - plasticStateResiduum(1:sizeDotState) - ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) & @@ -1654,9 +1650,8 @@ subroutine integrateStateFPI() converged = all( abs(plasticStateResiduum(1:sizeDotState)) < & plasticState(p)%aTolState(1:sizeDotState) & .or. abs(plasticStateResiduum(1:sizeDotState)) < & - rTol_crystalliteState * abs(tempPlasticState(1:sizeDotState))) + rTol_crystalliteState * abs( plasticState(p)%state(1:sizeDotState,c))) - plasticState(p)%state(1:sizeDotState,c) = tempPlasticState(1:sizeDotState) do s = 1_pInt, phase_Nsources(p) StateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & @@ -1671,11 +1666,10 @@ subroutine integrateStateFPI() * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- - tempSourceState(1:sizeDotState,s) = & + sourceState(p)%p(s)%state(1:sizeDotState,c) = & sourceState(p)%p(s)%state(1:sizeDotState,c) & - sourceStateResiduum(1:sizeDotState,s) ! need to copy to local variable, since we cant flush a pointer in openmp - ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) sourceState(p)%p(s)%dotState(:,c) = & sourceState(p)%p(s)%dotState(:,c) * stateDamper & + sourceState(p)%p(s)%previousDotState(:,c) & @@ -1688,16 +1682,10 @@ subroutine integrateStateFPI() all( abs(sourceStateResiduum(1:sizeDotState,s)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState) & .or. abs(sourceStateResiduum(1:sizeDotState,s)) < & - rTol_crystalliteState * abs(tempSourceState(1:sizeDotState,s))) + rTol_crystalliteState * abs(sourceState(p)%p(s)%state(1:sizeDotState,c))) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition - - do s = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%state(1:sizeDotState,c) = & - tempSourceState(1:sizeDotState,s) - enddo endif enddo; enddo; enddo !$OMP ENDDO From 066c598203a3bdb3f5e84185dd7051712fa17c0c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 10:52:00 +0100 Subject: [PATCH 043/309] wrong dot product in state damper --- src/crystallite.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 8efe15040..ef898bd77 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1744,8 +1744,8 @@ subroutine integrateStateFPI() real(pReal) :: dot_prod12, dot_prod22 - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(current - previous2, previous - previous2) + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) if (dot_prod22 > 0.0_pReal .and. (dot_prod12 < 0.0_pReal .or. dot_product(current,previous) < 0.0_pReal)) then damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else From 38d8e429fff2c4bdab56291ee209d853fa8a1c6b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 08:29:19 +0100 Subject: [PATCH 044/309] layout adjustments --- src/crystallite.f90 | 90 ++++++++++++++++++++------------------------- 1 file changed, 40 insertions(+), 50 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index ef898bd77..74eef259e 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1586,24 +1586,25 @@ subroutine integrateStateFPI() NiterationState = NiterationState + 1_pInt ! store previousDotState and previousDotState2 + !$OMP PARALLEL DO PRIVATE(p,c) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - plasticState(p)%previousDotState2(:,c) = merge(plasticState(p)%previousDotState(:,c),& - 0.0_pReal,& - NiterationState > 1_pInt) - plasticState(p)%previousDotState (:,c) = plasticState(p)%dotState(:,c) - do s = 1_pInt, phase_Nsources(p) - sourceState(p)%p(s)%previousDotState2(:,c) = merge(sourceState(p)%p(s)%previousDotState(:,c),& - 0.0_pReal, & - NiterationState > 1_pInt) - sourceState(p)%p(s)%previousDotState (:,c) = sourceState(p)%p(s)%dotState(:,c) - enddo - endif + plasticState(p)%previousDotState2(:,c) = merge(plasticState(p)%previousDotState(:,c),& + 0.0_pReal,& + NiterationState > 1_pInt) + plasticState(p)%previousDotState (:,c) = plasticState(p)%dotState(:,c) + do s = 1_pInt, phase_Nsources(p) + sourceState(p)%p(s)%previousDotState2(:,c) = merge(sourceState(p)%p(s)%previousDotState(:,c),& + 0.0_pReal, & + NiterationState > 1_pInt) + sourceState(p)%p(s)%previousDotState (:,c) = sourceState(p)%p(s)%dotState(:,c) + enddo + endif enddo enddo enddo @@ -1612,40 +1613,33 @@ subroutine integrateStateFPI() call update_dependentState call update_stress(1.0_pReal) call update_dotState(1.0_pReal) -!$OMP PARALLEL - ! --- UPDATE STATE --- - + + !$OMP PARALLEL !$OMP DO PRIVATE(sizeDotState, & !$OMP& plasticStateResiduum,sourceStateResiduum, & !$OMP& stateDamper, converged,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - p = phaseAt(g,i,e) - c = phasememberAt(g,i,e) StateDamper = damper(plasticState(p)%dotState (:,c), & plasticState(p)%previousDotState (:,c), & plasticState(p)%previousDotState2(:,c)) + sizeDotState = plasticState(p)%sizeDotState - sizeDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:sizeDotState) = & - plasticState(p)%state(1:sizeDotState,c) & - - plasticState(p)%subState0(1:sizeDotState,c) & - - ( plasticState(p)%dotState(1:sizeDotState,c) * stateDamper & - + plasticState(p)%previousDotState(1:sizeDotState,c) & - * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) + plasticStateResiduum(1:sizeDotState) = plasticState(p)%state (1:sizeDotState,c) & + - plasticState(p)%subState0(1:sizeDotState,c) & + - ( plasticState(p)%dotState (:,c) * stateDamper & + + plasticState(p)%previousDotState(:,c) * (1.0_pReal-stateDamper) & + ) * crystallite_subdt(g,i,e) - ! --- correct state with residuum --- - plasticState(p)%state(1:sizeDotState,c) = & - plasticState(p)%state(1:sizeDotState,c) & - - plasticStateResiduum(1:sizeDotState) + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%state(1:sizeDotState,c) & + - plasticStateResiduum(1:sizeDotState) - - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & - + plasticState(p)%previousDotState(:,c) & - * (1.0_pReal - stateDamper) + plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + + plasticState(p)%previousDotState(:,c) * (1.0_pReal - stateDamper) converged = all( abs(plasticStateResiduum(1:sizeDotState)) < & plasticState(p)%aTolState(1:sizeDotState) & @@ -1653,17 +1647,16 @@ subroutine integrateStateFPI() rTol_crystalliteState * abs( plasticState(p)%state(1:sizeDotState,c))) - do s = 1_pInt, phase_Nsources(p) - StateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & + do s = 1_pInt, phase_Nsources(p) + stateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & sourceState(p)%p(s)%previousDotState (:,c), & sourceState(p)%p(s)%previousDotState2(:,c)) - sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s) = & - sourceState(p)%p(s)%state(1:sizeDotState,c) & - - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - - ( sourceState(p)%p(s)%dotState(1:sizeDotState,c) * stateDamper & - + sourceState(p)%p(s)%previousDotState(1:sizeDotState,c) & - * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) + sizeDotState = sourceState(p)%p(s)%sizeDotState + sourceStateResiduum(1:sizeDotState,s) = sourceState(p)%p(s)%state (1:sizeDotState,c) & + - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & + - ( sourceState(p)%p(s)%dotState (:,c) * stateDamper & + + sourceState(p)%p(s)%previousDotState(:,c) * (1.0_pReal - stateDamper) & + ) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- sourceState(p)%p(s)%state(1:sizeDotState,c) = & @@ -1674,10 +1667,7 @@ subroutine integrateStateFPI() sourceState(p)%p(s)%dotState(:,c) * stateDamper & + sourceState(p)%p(s)%previousDotState(:,c) & * (1.0_pReal - stateDamper) - enddo - do s = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState converged = converged .and. & all( abs(sourceStateResiduum(1:sizeDotState,s)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState) & @@ -1921,7 +1911,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & abs(sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) enddo - if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definitionem + if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition endif enddo; enddo; enddo !$OMP END PARALLEL DO From 73f39136c48b5b33f7f515b545dd36ac54c26d32 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 22:19:38 +0100 Subject: [PATCH 045/309] taking over from old branch --- src/crystallite.f90 | 37 ++++++++++++++----------------------- 1 file changed, 14 insertions(+), 23 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 74eef259e..b720c4101 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1551,7 +1551,6 @@ subroutine integrateStateFPI() homogenization_Ngrains use constitutive, only: & constitutive_collectDotState, & - constitutive_microstructure, & constitutive_plasticity_maxSizeDotState, & constitutive_source_maxSizeDotState @@ -1569,9 +1568,9 @@ subroutine integrateStateFPI() real(pReal) :: & stateDamper real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & - plasticStateResiduum + residuum_plastic ! residuum for plastic state real(pReal), dimension(constitutive_source_maxSizeDotState, maxval(phase_Nsources)) :: & - sourceStateResiduum + residuum_source ! residuum for source state logical :: & converged, & doneWithIntegration @@ -1616,7 +1615,7 @@ subroutine integrateStateFPI() !$OMP PARALLEL !$OMP DO PRIVATE(sizeDotState, & - !$OMP& plasticStateResiduum,sourceStateResiduum, & + !$OMP& residuum_plastic,residuum_source, & !$OMP& stateDamper, converged,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) @@ -1629,21 +1628,20 @@ subroutine integrateStateFPI() plasticState(p)%previousDotState2(:,c)) sizeDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:sizeDotState) = plasticState(p)%state (1:sizeDotState,c) & + residuum_plastic(1:SizeDotState) = plasticState(p)%state (1:sizeDotState,c) & - plasticState(p)%subState0(1:sizeDotState,c) & - ( plasticState(p)%dotState (:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) * (1.0_pReal-stateDamper) & ) * crystallite_subdt(g,i,e) plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%state(1:sizeDotState,c) & - - plasticStateResiduum(1:sizeDotState) - + - residuum_plastic(1:sizeDotState) plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) * (1.0_pReal - stateDamper) - converged = all( abs(plasticStateResiduum(1:sizeDotState)) < & + converged = all( abs(residuum_plastic(1:sizeDotState)) < & plasticState(p)%aTolState(1:sizeDotState) & - .or. abs(plasticStateResiduum(1:sizeDotState)) < & + .or. abs(residuum_plastic(1:sizeDotState)) < & rTol_crystalliteState * abs( plasticState(p)%state(1:sizeDotState,c))) @@ -1652,26 +1650,21 @@ subroutine integrateStateFPI() sourceState(p)%p(s)%previousDotState (:,c), & sourceState(p)%p(s)%previousDotState2(:,c)) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s) = sourceState(p)%p(s)%state (1:sizeDotState,c) & + residuum_source(1:sizeDotState,s) = sourceState(p)%p(s)%state (1:sizeDotState,c) & - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - ( sourceState(p)%p(s)%dotState (:,c) * stateDamper & + sourceState(p)%p(s)%previousDotState(:,c) * (1.0_pReal - stateDamper) & ) * crystallite_subdt(g,i,e) - ! --- correct state with residuum --- - sourceState(p)%p(s)%state(1:sizeDotState,c) = & - sourceState(p)%p(s)%state(1:sizeDotState,c) & - - sourceStateResiduum(1:sizeDotState,s) ! need to copy to local variable, since we cant flush a pointer in openmp - - sourceState(p)%p(s)%dotState(:,c) = & - sourceState(p)%p(s)%dotState(:,c) * stateDamper & - + sourceState(p)%p(s)%previousDotState(:,c) & - * (1.0_pReal - stateDamper) + sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%state(1:sizeDotState,c) & + - residuum_source(1:sizeDotState,s) + sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * stateDamper & + + sourceState(p)%p(s)%previousDotState(:,c)* (1.0_pReal - stateDamper) converged = converged .and. & - all( abs(sourceStateResiduum(1:sizeDotState,s)) < & + all( abs(residuum_source(1:sizeDotState,s)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState) & - .or. abs(sourceStateResiduum(1:sizeDotState,s)) < & + .or. abs(residuum_source(1:sizeDotState,s)) < & rTol_crystalliteState * abs(sourceState(p)%p(s)%state(1:sizeDotState,c))) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition @@ -1771,8 +1764,6 @@ end subroutine integrateStateEuler !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler() - use, intrinsic :: & - IEEE_arithmetic use numerics, only: & rTol_crystalliteState use mesh, only: & From b4afc303be3b2cdbd98bbc629d413cd96f3c17c3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 22:29:36 +0100 Subject: [PATCH 046/309] clearer logic --- src/crystallite.f90 | 96 ++++++++++++++++++++++----------------------- 1 file changed, 46 insertions(+), 50 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b720c4101..be14f801a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1566,13 +1566,12 @@ subroutine integrateStateFPI() s, & sizeDotState real(pReal) :: & - stateDamper + zeta real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & residuum_plastic ! residuum for plastic state - real(pReal), dimension(constitutive_source_maxSizeDotState, maxval(phase_Nsources)) :: & + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & residuum_source ! residuum for source state logical :: & - converged, & doneWithIntegration ! --+>> PREGUESS FOR STATE <<+-- @@ -1614,65 +1613,59 @@ subroutine integrateStateFPI() call update_dotState(1.0_pReal) !$OMP PARALLEL - !$OMP DO PRIVATE(sizeDotState, & - !$OMP& residuum_plastic,residuum_source, & - !$OMP& stateDamper, converged,p,c) + !$OMP DO PRIVATE(sizeDotState,residuum_plastic,residuum_source,zeta,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - StateDamper = damper(plasticState(p)%dotState (:,c), & - plasticState(p)%previousDotState (:,c), & - plasticState(p)%previousDotState2(:,c)) + zeta = damper(plasticState(p)%dotState (:,c), & + plasticState(p)%previousDotState (:,c), & + plasticState(p)%previousDotState2(:,c)) sizeDotState = plasticState(p)%sizeDotState residuum_plastic(1:SizeDotState) = plasticState(p)%state (1:sizeDotState,c) & - plasticState(p)%subState0(1:sizeDotState,c) & - - ( plasticState(p)%dotState (:,c) * stateDamper & - + plasticState(p)%previousDotState(:,c) * (1.0_pReal-stateDamper) & + - ( plasticState(p)%dotState (:,c) * zeta & + + plasticState(p)%previousDotState(:,c) * (1.0_pReal-zeta) & ) * crystallite_subdt(g,i,e) plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%state(1:sizeDotState,c) & - residuum_plastic(1:sizeDotState) - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & - + plasticState(p)%previousDotState(:,c) * (1.0_pReal - stateDamper) - - converged = all( abs(residuum_plastic(1:sizeDotState)) < & - plasticState(p)%aTolState(1:sizeDotState) & - .or. abs(residuum_plastic(1:sizeDotState)) < & - rTol_crystalliteState * abs( plasticState(p)%state(1:sizeDotState,c))) + plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * zeta & + + plasticState(p)%previousDotState(:,c) * (1.0_pReal - zeta) + + crystallite_converged(g,i,e) = all(abs(residuum_plastic(1:sizeDotState)) & + < min(plasticState(p)%aTolState(1:sizeDotState), & + abs(plasticState(p)%state(1:sizeDotState,c)*rTol_crystalliteState))) do s = 1_pInt, phase_Nsources(p) - stateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & - sourceState(p)%p(s)%previousDotState (:,c), & - sourceState(p)%p(s)%previousDotState2(:,c)) + zeta = damper(sourceState(p)%p(s)%dotState (:,c), & + sourceState(p)%p(s)%previousDotState (:,c), & + sourceState(p)%p(s)%previousDotState2(:,c)) sizeDotState = sourceState(p)%p(s)%sizeDotState - residuum_source(1:sizeDotState,s) = sourceState(p)%p(s)%state (1:sizeDotState,c) & - - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - - ( sourceState(p)%p(s)%dotState (:,c) * stateDamper & - + sourceState(p)%p(s)%previousDotState(:,c) * (1.0_pReal - stateDamper) & - ) * crystallite_subdt(g,i,e) + + residuum_source(1:sizeDotState) = sourceState(p)%p(s)%state (1:sizeDotState,c) & + - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & + - ( sourceState(p)%p(s)%dotState (:,c) * zeta & + + sourceState(p)%p(s)%previousDotState(:,c) * (1.0_pReal - zeta) & + ) * crystallite_subdt(g,i,e) - sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%state(1:sizeDotState,c) & - - residuum_source(1:sizeDotState,s) - sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * stateDamper & - + sourceState(p)%p(s)%previousDotState(:,c)* (1.0_pReal - stateDamper) + sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%state(1:sizeDotState,c) & + - residuum_source(1:sizeDotState) + sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * zeta & + + sourceState(p)%p(s)%previousDotState(:,c)* (1.0_pReal - zeta) - converged = converged .and. & - all( abs(residuum_source(1:sizeDotState,s)) < & - sourceState(p)%p(s)%aTolState(1:sizeDotState) & - .or. abs(residuum_source(1:sizeDotState,s)) < & - rTol_crystalliteState * abs(sourceState(p)%p(s)%state(1:sizeDotState,c))) - enddo - if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition - - endif - enddo; enddo; enddo + crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & + all(abs(residuum_source(1:sizeDotState)) & + < min(sourceState(p)%p(s)%aTolState(1:sizeDotState), & + abs(sourceState(p)%p(s)%state(1:sizeDotState,c)*rTol_crystalliteState))) + enddo + endif + enddo; enddo; enddo !$OMP ENDDO - ! --- STATE JUMP --- !$OMP DO do e = FEsolving_execElem(1),FEsolving_execElem(2) @@ -1870,6 +1863,17 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & plasticStateResiduum(1:mySizePlasticDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state + + converged = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + rTol_crystalliteState .or. & + abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + plasticState(p)%aTolState(1:mySizePlasticDotState)) + + forall (s = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & + relPlasticStateResiduum(s,g,i,e) = & + plasticStateResiduum(s,g,i,e) / plasticState(p)%dotState(s,c) + + do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) = & @@ -1878,10 +1882,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state enddo - ! --- relative residui --- - forall (s = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & - relPlasticStateResiduum(s,g,i,e) = & - plasticStateResiduum(s,g,i,e) / plasticState(p)%dotState(s,c) + do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState forall (s = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(mySource)%dotState(s,c)) > 0.0_pReal) & @@ -1889,11 +1890,6 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(s,c) enddo - ! --- converged ? --- - converged = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState)) do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState converged = converged .and. & From 0be05b3ee1c4a894b2e442ff3156945bb3a5efe5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 22:46:21 +0100 Subject: [PATCH 047/309] one variable is enough --- src/crystallite.f90 | 63 ++++++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 32 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index be14f801a..100bd1aa4 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1785,8 +1785,7 @@ subroutine integrateStateAdaptiveEuler() p, & c, & mySource, & - mySizePlasticDotState, & ! size of dot states - mySizeSourceDotState + sizeDotState real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & plasticStateResiduum, & ! residuum from evolution in micrstructure @@ -1810,31 +1809,31 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & ! contribution to state and relative residui and from Euler integration call update_dotState(1.0_pReal) - !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c) + !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - mySizePlasticDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & + sizeDotState = plasticState(p)%sizeDotState + plasticStateResiduum(1:sizeDotState,g,i,e) = & - 0.5_pReal & - * plasticState(p)%dotstate(1:mySizePlasticDotState,c) & + * plasticState(p)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - plasticState(p)%state (1:mySizePlasticDotState,c) = & - plasticState(p)%state (1:mySizePlasticDotState,c) & - + plasticState(p)%dotstate(1:mySizePlasticDotState,c) & + plasticState(p)%state (1:sizeDotState,c) = & + plasticState(p)%state (1:sizeDotState,c) & + + plasticState(p)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) = & + sizeDotState = sourceState(p)%p(mySource)%sizeDotState + sourceStateResiduum(1:sizeDotState,mySource,g,i,e) = & - 0.5_pReal & - * sourceState(p)%p(mySource)%dotstate(1:mySizeSourceDotState,c) & + * sourceState(p)%p(mySource)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - sourceState(p)%p(mySource)%state (1:mySizeSourceDotState,c) = & - sourceState(p)%p(mySource)%state (1:mySizeSourceDotState,c) & - + sourceState(p)%p(mySource)%dotstate(1:mySizeSourceDotState,c) & + sourceState(p)%p(mySource)%state (1:sizeDotState,c) = & + sourceState(p)%p(mySource)%state (1:sizeDotState,c) & + + sourceState(p)%p(mySource)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) enddo endif @@ -1850,7 +1849,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & relSourceStateResiduum = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,converged,p,c,s) + !$OMP PARALLEL DO PRIVATE(sizeDotState,converged,p,c,s) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -1858,45 +1857,45 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & p = phaseAt(g,i,e); c = phasememberAt(g,i,e) ! --- contribution of heun step to absolute residui --- - mySizePlasticDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) & + sizeDotState = plasticState(p)%sizeDotState + plasticStateResiduum(1:sizeDotState,g,i,e) = & + plasticStateResiduum(1:sizeDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - converged = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + converged = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState)) + abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & + plasticState(p)%aTolState(1:sizeDotState)) - forall (s = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & + forall (s = 1_pInt:sizeDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & relPlasticStateResiduum(s,g,i,e) = & plasticStateResiduum(s,g,i,e) / plasticState(p)%dotState(s,c) do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) = & - sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) & + sizeDotState = sourceState(p)%p(mySource)%sizeDotState + sourceStateResiduum(1:sizeDotState,mySource,g,i,e) = & + sourceStateResiduum(1:sizeDotState,mySource,g,i,e) & + 0.5_pReal * sourceState(p)%p(mySource)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state enddo do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - forall (s = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(mySource)%dotState(s,c)) > 0.0_pReal) & + sizeDotState = sourceState(p)%p(mySource)%sizeDotState + forall (s = 1_pInt:sizeDotState,abs(sourceState(p)%p(mySource)%dotState(s,c)) > 0.0_pReal) & relSourceStateResiduum(s,mySource,g,i,e) = & sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(s,c) enddo do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState + sizeDotState = sourceState(p)%p(mySource)%sizeDotState converged = converged .and. & - all(abs(relSourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & + all(abs(relSourceStateResiduum(1:sizeDotState,mySource,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & - sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) + abs(sourceStateResiduum(1:sizeDotState,mySource,g,i,e)) < & + sourceState(p)%p(mySource)%aTolState(1:sizeDotState)) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition endif From 1408d66c0caec280768039732cb09ad53b579475 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 23:02:59 +0100 Subject: [PATCH 048/309] s is used for source --- src/crystallite.f90 | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 100bd1aa4..b416573de 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1781,7 +1781,7 @@ subroutine integrateStateAdaptiveEuler() e, & ! element index in element loop i, & ! integration point index in ip loop g, & ! grain index in grain loop - s, & ! state index + u, & ! state index p, & c, & mySource, & @@ -1849,7 +1849,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & relSourceStateResiduum = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(sizeDotState,converged,p,c,s) + !$OMP PARALLEL DO PRIVATE(sizeDotState,converged,p,c,u) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -1868,9 +1868,9 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & plasticState(p)%aTolState(1:sizeDotState)) - forall (s = 1_pInt:sizeDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & - relPlasticStateResiduum(s,g,i,e) = & - plasticStateResiduum(s,g,i,e) / plasticState(p)%dotState(s,c) + forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%dotState(u,c)) > 0.0_pReal) & + relPlasticStateResiduum(u,g,i,e) = & + plasticStateResiduum(u,g,i,e) / plasticState(p)%dotState(u,c) do mySource = 1_pInt, phase_Nsources(p) @@ -1879,17 +1879,11 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & sourceStateResiduum(1:sizeDotState,mySource,g,i,e) & + 0.5_pReal * sourceState(p)%p(mySource)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - enddo + forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(mySource)%dotState(u,c)) > 0.0_pReal) & + relSourceStateResiduum(u,mySource,g,i,e) = & + sourceStateResiduum(u,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(u,c) - do mySource = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(mySource)%sizeDotState - forall (s = 1_pInt:sizeDotState,abs(sourceState(p)%p(mySource)%dotState(s,c)) > 0.0_pReal) & - relSourceStateResiduum(s,mySource,g,i,e) = & - sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(s,c) - enddo - - do mySource = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(mySource)%sizeDotState converged = converged .and. & all(abs(relSourceStateResiduum(1:sizeDotState,mySource,g,i,e)) < & From eade54a68f49c31e274577292970271efef2d915 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 23:04:50 +0100 Subject: [PATCH 049/309] consistent variable names --- src/crystallite.f90 | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b416573de..054bb9d22 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1784,7 +1784,7 @@ subroutine integrateStateAdaptiveEuler() u, & ! state index p, & c, & - mySource, & + s, & sizeDotState real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & @@ -1825,15 +1825,15 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & plasticState(p)%state (1:sizeDotState,c) & + plasticState(p)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) - do mySource = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(mySource)%sizeDotState - sourceStateResiduum(1:sizeDotState,mySource,g,i,e) = & + do s = 1_pInt, phase_Nsources(p) + sizeDotState = sourceState(p)%p(s)%sizeDotState + sourceStateResiduum(1:sizeDotState,s,g,i,e) = & - 0.5_pReal & - * sourceState(p)%p(mySource)%dotstate(1:sizeDotState,c) & + * sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - sourceState(p)%p(mySource)%state (1:sizeDotState,c) = & - sourceState(p)%p(mySource)%state (1:sizeDotState,c) & - + sourceState(p)%p(mySource)%dotstate(1:sizeDotState,c) & + sourceState(p)%p(s)%state (1:sizeDotState,c) = & + sourceState(p)%p(s)%state (1:sizeDotState,c) & + + sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) enddo endif @@ -1873,23 +1873,23 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & plasticStateResiduum(u,g,i,e) / plasticState(p)%dotState(u,c) - do mySource = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(mySource)%sizeDotState - sourceStateResiduum(1:sizeDotState,mySource,g,i,e) = & - sourceStateResiduum(1:sizeDotState,mySource,g,i,e) & - + 0.5_pReal * sourceState(p)%p(mySource)%dotState(:,c) & + do s = 1_pInt, phase_Nsources(p) + sizeDotState = sourceState(p)%p(s)%sizeDotState + sourceStateResiduum(1:sizeDotState,s,g,i,e) = & + sourceStateResiduum(1:sizeDotState,s,g,i,e) & + + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(mySource)%dotState(u,c)) > 0.0_pReal) & - relSourceStateResiduum(u,mySource,g,i,e) = & - sourceStateResiduum(u,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(u,c) + forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%dotState(u,c)) > 0.0_pReal) & + relSourceStateResiduum(u,s,g,i,e) = & + sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%dotState(u,c) - sizeDotState = sourceState(p)%p(mySource)%sizeDotState + sizeDotState = sourceState(p)%p(s)%sizeDotState converged = converged .and. & - all(abs(relSourceStateResiduum(1:sizeDotState,mySource,g,i,e)) < & + all(abs(relSourceStateResiduum(1:sizeDotState,s,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:sizeDotState,mySource,g,i,e)) < & - sourceState(p)%p(mySource)%aTolState(1:sizeDotState)) + abs(sourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition endif From bdd193fbd73eb9a1e2214684b90d4425edd94519 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 23:31:26 +0100 Subject: [PATCH 050/309] now readable (kind of) --- src/crystallite.f90 | 105 ++++++++++++++++++-------------------------- 1 file changed, 43 insertions(+), 62 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 054bb9d22..2e68ae756 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1619,12 +1619,12 @@ subroutine integrateStateFPI() do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + sizeDotState = plasticState(p)%sizeDotState zeta = damper(plasticState(p)%dotState (:,c), & plasticState(p)%previousDotState (:,c), & plasticState(p)%previousDotState2(:,c)) - sizeDotState = plasticState(p)%sizeDotState - + residuum_plastic(1:SizeDotState) = plasticState(p)%state (1:sizeDotState,c) & - plasticState(p)%subState0(1:sizeDotState,c) & - ( plasticState(p)%dotState (:,c) * zeta & @@ -1642,11 +1642,12 @@ subroutine integrateStateFPI() do s = 1_pInt, phase_Nsources(p) + sizeDotState = sourceState(p)%p(s)%sizeDotState + zeta = damper(sourceState(p)%p(s)%dotState (:,c), & sourceState(p)%p(s)%previousDotState (:,c), & sourceState(p)%p(s)%previousDotState2(:,c)) - sizeDotState = sourceState(p)%p(s)%sizeDotState - + residuum_source(1:sizeDotState) = sourceState(p)%p(s)%state (1:sizeDotState,c) & - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - ( sourceState(p)%p(s)%dotState (:,c) * zeta & @@ -1771,8 +1772,6 @@ subroutine integrateStateAdaptiveEuler() phase_Nsources, & homogenization_maxNgrains use constitutive, only: & - constitutive_collectDotState, & - constitutive_microstructure, & constitutive_plasticity_maxSizeDotState, & constitutive_source_maxSizeDotState @@ -1786,6 +1785,8 @@ subroutine integrateStateAdaptiveEuler() c, & s, & sizeDotState + + ! ToDo: MD: once all constitutives use allocate state, attach these arrays to the state in case of adaptive Euler real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & plasticStateResiduum, & ! residuum from evolution in micrstructure @@ -1796,45 +1797,29 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & sourceStateResiduum, & ! residuum from evolution in micrstructure relSourceStateResiduum ! relative residuum from evolution in microstructure - logical :: & - converged - - - plasticStateResiduum = 0.0_pReal - relPlasticStateResiduum = 0.0_pReal - sourceStateResiduum = 0.0_pReal - relSourceStateResiduum = 0.0_pReal - !-------------------------------------------------------------------------------------------------- ! contribution to state and relative residui and from Euler integration call update_dotState(1.0_pReal) !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:sizeDotState,g,i,e) = & - - 0.5_pReal & - * plasticState(p)%dotstate(1:sizeDotState,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - plasticState(p)%state (1:sizeDotState,c) = & - plasticState(p)%state (1:sizeDotState,c) & - + plasticState(p)%dotstate(1:sizeDotState,c) & - * crystallite_subdt(g,i,e) + + plasticStateResiduum(1:sizeDotState,g,i,e) = plasticState(p)%dotstate(1:sizeDotState,c) & + * (- 0.5_pReal * crystallite_subdt(g,i,e)) + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%state(1:sizeDotState,c) & + + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) !ToDo: state, partitioned state? do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s,g,i,e) = & - - 0.5_pReal & - * sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - sourceState(p)%p(s)%state (1:sizeDotState,c) = & - sourceState(p)%p(s)%state (1:sizeDotState,c) & - + sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & - * crystallite_subdt(g,i,e) + + sourceStateResiduum(1:sizeDotState,s,g,i,e) = sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & + * (- 0.5_pReal * crystallite_subdt(g,i,e)) + sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%state(1:sizeDotState,c) & + + sourceState(p)%p(s)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) !ToDo: state, partitioned state? enddo endif enddo; enddo; enddo @@ -1845,55 +1830,51 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & call update_stress(1.0_pReal) call update_dotState(1.0_pReal) - relPlasticStateResiduum = 0.0_pReal - relSourceStateResiduum = 0.0_pReal + relPlasticStateResiduum = 0.0_pReal + relSourceStateResiduum = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(sizeDotState,converged,p,c,u) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) + !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c,u) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + sizeDotState = plasticState(p)%sizeDotState ! --- contribution of heun step to absolute residui --- - sizeDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:sizeDotState,g,i,e) = & - plasticStateResiduum(1:sizeDotState,g,i,e) & - + 0.5_pReal * plasticState(p)%dotState(:,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state + + plasticStateResiduum(1:sizeDotState,g,i,e) = plasticStateResiduum(1:sizeDotState,g,i,e) & + + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - converged = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & + crystallite_converged(g,i,e) = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & rTol_crystalliteState .or. & abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & plasticState(p)%aTolState(1:sizeDotState)) forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%dotState(u,c)) > 0.0_pReal) & - relPlasticStateResiduum(u,g,i,e) = & - plasticStateResiduum(u,g,i,e) / plasticState(p)%dotState(u,c) + relPlasticStateResiduum(u,g,i,e) = plasticStateResiduum(u,g,i,e) & + / plasticState(p)%dotState(u,c) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s,g,i,e) = & - sourceStateResiduum(1:sizeDotState,s,g,i,e) & - + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - + + sourceStateResiduum(1:sizeDotState,s,g,i,e) = sourceStateResiduum(1:sizeDotState,s,g,i,e) & + + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) + forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%dotState(u,c)) > 0.0_pReal) & - relSourceStateResiduum(u,s,g,i,e) = & - sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%dotState(u,c) + relSourceStateResiduum(u,s,g,i,e) = sourceStateResiduum(u,s,g,i,e) & + / sourceState(p)%p(s)%dotState(u,c) - sizeDotState = sourceState(p)%p(s)%sizeDotState - converged = converged .and. & + crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & all(abs(relSourceStateResiduum(1:sizeDotState,s,g,i,e)) < & rTol_crystalliteState .or. & abs(sourceStateResiduum(1:sizeDotState,s,g,i,e)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo - if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition endif - enddo; enddo; enddo + enddo; enddo; enddo !$OMP END PARALLEL DO if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck From 6a3dac1df2ba3fe6fd0cd1bb457cdcc3b175ee72 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 23:45:41 +0100 Subject: [PATCH 051/309] still improving readability --- src/crystallite.f90 | 72 ++++++++++++++++++++++++--------------------- 1 file changed, 38 insertions(+), 34 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 2e68ae756..7fb3aefe6 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1758,6 +1758,8 @@ end subroutine integrateStateEuler !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler() + use prec, only: & + dNeq0 use numerics, only: & rTol_crystalliteState use mesh, only: & @@ -1780,22 +1782,23 @@ subroutine integrateStateAdaptiveEuler() e, & ! element index in element loop i, & ! integration point index in ip loop g, & ! grain index in grain loop - u, & ! state index p, & c, & s, & sizeDotState - ! ToDo: MD: once all constitutives use allocate state, attach these arrays to the state in case of adaptive Euler + ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler + ! ToDo: MD: rel residuu don't have to be pointwise + real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - plasticStateResiduum, & ! residuum from evolution in micrstructure - relPlasticStateResiduum ! relative residuum from evolution in microstructure + residuum_plastic, & + residuum_plastic_rel real(pReal), dimension(constitutive_source_maxSizeDotState,& maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - sourceStateResiduum, & ! residuum from evolution in micrstructure - relSourceStateResiduum ! relative residuum from evolution in microstructure + residuum_source_rel, & + residuum_source !-------------------------------------------------------------------------------------------------- ! contribution to state and relative residui and from Euler integration @@ -1809,15 +1812,15 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & p = phaseAt(g,i,e); c = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:sizeDotState,g,i,e) = plasticState(p)%dotstate(1:sizeDotState,c) & - * (- 0.5_pReal * crystallite_subdt(g,i,e)) + residuum_plastic(1:sizeDotState,g,i,e) = plasticState(p)%dotstate(1:sizeDotState,c) & + * (- 0.5_pReal * crystallite_subdt(g,i,e)) plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%state(1:sizeDotState,c) & + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) !ToDo: state, partitioned state? do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s,g,i,e) = sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & - * (- 0.5_pReal * crystallite_subdt(g,i,e)) + residuum_source(1:sizeDotState,s,g,i,e) = sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & + * (- 0.5_pReal * crystallite_subdt(g,i,e)) sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%state(1:sizeDotState,c) & + sourceState(p)%p(s)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) !ToDo: state, partitioned state? enddo @@ -1829,12 +1832,8 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & call update_dependentState call update_stress(1.0_pReal) call update_dotState(1.0_pReal) - - relPlasticStateResiduum = 0.0_pReal - relSourceStateResiduum = 0.0_pReal - - !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c,u) + !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -1844,33 +1843,38 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & ! --- contribution of heun step to absolute residui --- - plasticStateResiduum(1:sizeDotState,g,i,e) = plasticStateResiduum(1:sizeDotState,g,i,e) & - + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - - crystallite_converged(g,i,e) = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & - rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & - plasticState(p)%aTolState(1:sizeDotState)) - - forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%dotState(u,c)) > 0.0_pReal) & - relPlasticStateResiduum(u,g,i,e) = plasticStateResiduum(u,g,i,e) & - / plasticState(p)%dotState(u,c) + residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - + where(dNeq0(plasticState(p)%dotState(1:sizeDotState,c))) + residuum_plastic_rel(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + / plasticState(p)%dotState(1:sizeDotState,c) + else where + residuum_plastic_rel(1:sizeDotState,g,i,e) = 0.0_pReal + end where + + crystallite_converged(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState,g,i,e)) < & + rTol_crystalliteState .or. & + abs(residuum_plastic(1:sizeDotState,g,i,e)) < & + plasticState(p)%aTolState(1:sizeDotState)) + do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s,g,i,e) = sourceStateResiduum(1:sizeDotState,s,g,i,e) & - + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) + residuum_source(1:sizeDotState,s,g,i,e) = residuum_source(1:sizeDotState,s,g,i,e) & + + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) - forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%dotState(u,c)) > 0.0_pReal) & - relSourceStateResiduum(u,s,g,i,e) = sourceStateResiduum(u,s,g,i,e) & - / sourceState(p)%p(s)%dotState(u,c) + where(dNeq0(sourceState(p)%p(s)%dotState(1:sizeDotState,c))) + residuum_source_rel(1:sizeDotState,s,g,i,e) = residuum_source(1:sizeDotState,s,g,i,e) & + / sourceState(p)%p(s)%dotState(1:sizeDotState,c) + else where + residuum_source_rel(1:SizeDotState,s,g,i,e) = 0.0_pReal + end where crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & - all(abs(relSourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + all(abs(residuum_source_rel(1:sizeDotState,s,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + abs(residuum_source(1:sizeDotState,s,g,i,e)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif From 1a66f976b7e5d7f2edf6493562e92e10ea8f10d1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 00:01:40 +0100 Subject: [PATCH 052/309] common variable name --- src/crystallite.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 7fb3aefe6..b47f3334f 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1919,7 +1919,7 @@ subroutine integrateStateRK4() p, & ! phase loop c, & n, & - mySource + s integer(pInt), dimension(2) :: eIter ! bounds for element iteration integer(pInt), dimension(2,mesh_NcpElems) :: iIter, & ! bounds for ip iteration gIter ! bounds for grain iteration @@ -1938,8 +1938,8 @@ subroutine integrateStateRK4() if (.not. singleRun) then do p = 1_pInt, material_Nphase plasticState(p)%RK4dotState = 0.0_pReal - do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%RK4dotState = 0.0_pReal + do s = 1_pInt, phase_Nsources(p) + sourceState(p)%p(s)%RK4dotState = 0.0_pReal enddo enddo else @@ -1947,8 +1947,8 @@ subroutine integrateStateRK4() i = iIter(1,e) do g = gIter(1,e), gIter(2,e) plasticState(phaseAt(g,i,e))%RK4dotState(:,phasememberAt(g,i,e)) = 0.0_pReal - do mySource = 1_pInt, phase_Nsources(phaseAt(g,i,e)) - sourceState(phaseAt(g,i,e))%p(mySource)%RK4dotState(:,phasememberAt(g,i,e)) = 0.0_pReal + do s = 1_pInt, phase_Nsources(phaseAt(g,i,e)) + sourceState(phaseAt(g,i,e))%p(s)%RK4dotState(:,phasememberAt(g,i,e)) = 0.0_pReal enddo enddo endif @@ -1967,13 +1967,13 @@ subroutine integrateStateRK4() do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - c = phasememberAt(g,i,e) + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + plasticState(p)%RK4dotState(:,c) = plasticState(p)%RK4dotState(:,c) & + weight(n)*plasticState(p)%dotState(:,c) - do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%RK4dotState(:,c) = sourceState(p)%p(mySource)%RK4dotState(:,c) & - + weight(n)*sourceState(p)%p(mySource)%dotState(:,c) + do s = 1_pInt, phase_Nsources(p) + sourceState(p)%p(s)%RK4dotState(:,c) = sourceState(p)%p(s)%RK4dotState(:,c) & + + weight(n)*sourceState(p)%p(s)%dotState(:,c) enddo endif enddo; enddo; enddo From a09036ff4824531e4faebf787752bca6b60fdfbb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 00:11:10 +0100 Subject: [PATCH 053/309] on-the-fly initialization --- src/crystallite.f90 | 79 ++++++++++----------------------------------- 1 file changed, 17 insertions(+), 62 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b47f3334f..7767eb6f3 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1893,19 +1893,13 @@ subroutine integrateStateRK4() use, intrinsic :: & IEEE_arithmetic use mesh, only: & - mesh_element, & - mesh_NcpElems + mesh_element use material, only: & homogenization_Ngrains, & plasticState, & sourceState, & phase_Nsources, & phaseAt, phasememberAt - use config, only: & - material_Nphase - use constitutive, only: & - constitutive_collectDotState, & - constitutive_microstructure implicit none real(pReal), dimension(4), parameter :: & @@ -1920,65 +1914,28 @@ subroutine integrateStateRK4() c, & n, & s - integer(pInt), dimension(2) :: eIter ! bounds for element iteration - integer(pInt), dimension(2,mesh_NcpElems) :: iIter, & ! bounds for ip iteration - gIter ! bounds for grain iteration - logical :: singleRun ! flag indicating computation for single (g,i,e) triple - - eIter = FEsolving_execElem(1:2) - do e = eIter(1),eIter(2) - iIter(1:2,e) = FEsolving_execIP(1:2,e) - gIter(1:2,e) = [ 1_pInt,homogenization_Ngrains(mesh_element(3,e))] - enddo - - singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) - -!-------------------------------------------------------------------------------------------------- -! initialize dotState - if (.not. singleRun) then - do p = 1_pInt, material_Nphase - plasticState(p)%RK4dotState = 0.0_pReal - do s = 1_pInt, phase_Nsources(p) - sourceState(p)%p(s)%RK4dotState = 0.0_pReal - enddo - enddo - else - e = eIter(1) - i = iIter(1,e) - do g = gIter(1,e), gIter(2,e) - plasticState(phaseAt(g,i,e))%RK4dotState(:,phasememberAt(g,i,e)) = 0.0_pReal - do s = 1_pInt, phase_Nsources(phaseAt(g,i,e)) - sourceState(phaseAt(g,i,e))%p(s)%RK4dotState(:,phasememberAt(g,i,e)) = 0.0_pReal - enddo - enddo - endif call update_dotState(1.0_pReal) -!-------------------------------------------------------------------------------------------------- -! --- SECOND TO FOURTH RUNGE KUTTA STEP PLUS FINAL INTEGRATION --- do n = 1_pInt,4_pInt - ! --- state update --- - !$OMP PARALLEL - !$OMP DO PRIVATE(p,c) + !$OMP PARALLEL DO PRIVATE(p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - plasticState(p)%RK4dotState(:,c) = plasticState(p)%RK4dotState(:,c) & - + weight(n)*plasticState(p)%dotState(:,c) + plasticState(p)%RK4dotState(:,c) = WEIGHT(n)*plasticState(p)%dotState(:,c) & + + merge(plasticState(p)%RK4dotState(:,c),0.0_pReal,n>1_pInt) do s = 1_pInt, phase_Nsources(p) - sourceState(p)%p(s)%RK4dotState(:,c) = sourceState(p)%p(s)%RK4dotState(:,c) & - + weight(n)*sourceState(p)%p(s)%dotState(:,c) + sourceState(p)%p(s)%RK4dotState(:,c) = WEIGHT(n)*sourceState(p)%p(s)%dotState(:,c) & + + merge(sourceState(p)%p(s)%RK4dotState(:,c),0.0_pReal,n>1_pInt) enddo endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO call update_state(TIMESTEPFRACTION(n)) call update_deltaState @@ -1988,9 +1945,8 @@ subroutine integrateStateRK4() ! --- dot state and RK dot state--- first3steps: if (n < 4) then - call update_dotState(timeStepFraction(n)) + call update_dotState(TIMESTEPFRACTION(n)) endif first3steps - enddo @@ -2458,9 +2414,8 @@ subroutine update_deltaState i, & !< integration point index in ip loop g, & !< grain index in grain loop p, & - mySize, & + mySize, & myOffset, & - mySource, & c, & s logical :: & @@ -2469,7 +2424,7 @@ subroutine update_deltaState nonlocalStop = .false. - !$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize,mySource,NaN) + !$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize,NaN) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -2489,15 +2444,15 @@ subroutine update_deltaState plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) = & plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) + & plasticState(p)%deltaState(1:mySize,c) - do mySource = 1_pInt, phase_Nsources(p) - myOffset = sourceState(p)%p(mySource)%offsetDeltaState - mySize = sourceState(p)%p(mySource)%sizeDeltaState - NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySize,c))) + do s = 1_pInt, phase_Nsources(p) + myOffset = sourceState(p)%p(s)%offsetDeltaState + mySize = sourceState(p)%p(s)%sizeDeltaState + NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(s)%deltaState(1:mySize,c))) if (.not. NaN) then - sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) = & - sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) + & - sourceState(p)%p(mySource)%deltaState(1:mySize,c) + sourceState(p)%p(s)%state(myOffset + 1_pInt:myOffset +mySize,c) = & + sourceState(p)%p(s)%state(myOffset + 1_pInt:myOffset +mySize,c) + & + sourceState(p)%p(s)%deltaState(1:mySize,c) endif enddo endif From 77f1f45c231d4bcfd4dd3b6844d1cd7cbf4e1c32 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 00:17:04 +0100 Subject: [PATCH 054/309] just figured out that RK4 integrator is totally broken readable code helps ;) --- src/crystallite.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 7767eb6f3..a5f7592d6 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1888,6 +1888,7 @@ end subroutine integrateStateAdaptiveEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 4th order explicit Runge Kutta method +! ToDo: This is totally BROKEN: RK4dotState is never used!!! !-------------------------------------------------------------------------------------------------- subroutine integrateStateRK4() use, intrinsic :: & @@ -1941,7 +1942,6 @@ subroutine integrateStateRK4() call update_deltaState call update_dependentState call update_stress(TIMESTEPFRACTION(n)) - ! --- dot state and RK dot state--- first3steps: if (n < 4) then From 5908e3fd3486e1584081908ab56cfc5d1ad3a022 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 06:44:26 +0100 Subject: [PATCH 055/309] wrong tolerance selection --- src/crystallite.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index a5f7592d6..b29ede160 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1637,7 +1637,7 @@ subroutine integrateStateFPI() + plasticState(p)%previousDotState(:,c) * (1.0_pReal - zeta) crystallite_converged(g,i,e) = all(abs(residuum_plastic(1:sizeDotState)) & - < min(plasticState(p)%aTolState(1:sizeDotState), & + < max(plasticState(p)%aTolState(1:sizeDotState), & abs(plasticState(p)%state(1:sizeDotState,c)*rTol_crystalliteState))) @@ -1661,7 +1661,7 @@ subroutine integrateStateFPI() crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & all(abs(residuum_source(1:sizeDotState)) & - < min(sourceState(p)%p(s)%aTolState(1:sizeDotState), & + < max(sourceState(p)%p(s)%aTolState(1:sizeDotState), & abs(sourceState(p)%p(s)%state(1:sizeDotState,c)*rTol_crystalliteState))) enddo endif From 462b1b7c189e8370c9930736b15ffc8ed22306f9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 06:47:36 +0100 Subject: [PATCH 056/309] sorted according to importance --- src/crystallite.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b29ede160..0150d68b0 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1723,7 +1723,7 @@ subroutine integrateStateFPI() dot_prod12 = dot_product(current - previous, previous - previous2) dot_prod22 = dot_product(previous - previous2, previous - previous2) - if (dot_prod22 > 0.0_pReal .and. (dot_prod12 < 0.0_pReal .or. dot_product(current,previous) < 0.0_pReal)) then + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else damper = 1.0_pReal From 13af9fd3da8cfea3fe525c771b43da0760219d16 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 30 Jan 2019 09:04:55 +0100 Subject: [PATCH 057/309] [skip ci] updated version information after successful test of v2.0.2-1634-g370b23d5 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 82ddb5e1a..cd40c2f04 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1614-g8764c615 +v2.0.2-1634-g370b23d5 From ca7c105f363c80d49bce0fc5b9fd9add335961cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 08:56:16 +0100 Subject: [PATCH 058/309] only one loop needed --- src/crystallite.f90 | 35 +++++++++++------------------------ 1 file changed, 11 insertions(+), 24 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0150d68b0..b0f1c1f94 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2038,46 +2038,33 @@ subroutine integrateStateRKCK45() ! --- state update --- - !$OMP PARALLEL - !$OMP DO PRIVATE(p,cc) + !$OMP PARALLEL DO PRIVATE(p,cc) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) - plasticState(p)%RKCK45dotState(stage,:,cc) = plasticState(p)%dotState(:,cc) ! store Runge-Kutta dotState + plasticState(p)%RKCK45dotState(stage,:,cc) = plasticState(p)%dotState(:,cc) + plasticState(p)%dotState(:,cc) = A(1,stage) * plasticState(p)%RKCK45dotState(1,:,cc) + do mySource = 1_pInt, phase_Nsources(p) sourceState(p)%p(mySource)%RKCK45dotState(stage,:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) - enddo - endif - enddo; enddo; enddo - !$OMP ENDDO - - !$OMP DO PRIVATE(p,cc,n) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - cc = phasememberAt(g,i,e) - - plasticState(p)%dotState(:,cc) = A(1,stage) * plasticState(p)%RKCK45dotState(1,:,cc) - do mySource = 1_pInt, phase_Nsources(p) sourceState(p)%p(mySource)%dotState(:,cc) = A(1,stage) * sourceState(p)%p(mySource)%RKCK45dotState(1,:,cc) enddo + do n = 2_pInt, stage - plasticState(p)%dotState(:,cc) = & - plasticState(p)%dotState(:,cc) + A(n,stage) * plasticState(p)%RKCK45dotState(n,:,cc) + plasticState(p)%dotState(:,cc) = plasticState(p)%dotState(:,cc) & + + A(n,stage) * plasticState(p)%RKCK45dotState(n,:,cc) do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%dotState(:,cc) = & - sourceState(p)%p(mySource)%dotState(:,cc) + A(n,stage) * sourceState(p)%p(mySource)%RKCK45dotState(n,:,cc) + sourceState(p)%p(mySource)%dotState(:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) & + + A(n,stage) * sourceState(p)%p(mySource)%RKCK45dotState(n,:,cc) enddo enddo + endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO call update_state(1.0_pReal) !MD: 1.0 correct? call update_deltaState From df6ec59f76cdfa25e69e8e80486de4d47b56787b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 09:11:12 +0100 Subject: [PATCH 059/309] use "s" for source --- src/crystallite.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b0f1c1f94..de535e8c2 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2008,7 +2008,7 @@ subroutine integrateStateRKCK45() i, & ! integration point index in ip loop g, & ! grain index in grain loop stage, & ! stage index in integration stage loop - s, & ! state index + u, & ! state index n, & p, & cc, & @@ -2043,8 +2043,8 @@ subroutine integrateStateRKCK45() do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - cc = phasememberAt(g,i,e) + p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + plasticState(p)%RKCK45dotState(stage,:,cc) = plasticState(p)%dotState(:,cc) plasticState(p)%dotState(:,cc) = A(1,stage) * plasticState(p)%RKCK45dotState(1,:,cc) @@ -2134,7 +2134,7 @@ subroutine integrateStateRKCK45() !$OMP PARALLEL ! --- relative residui and state convergence --- - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc,s) + !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc,u) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -2142,15 +2142,15 @@ subroutine integrateStateRKCK45() p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState - forall (s = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%state(s,cc)) > 0.0_pReal) & - relPlasticStateResiduum(s,g,i,e) = & - plasticStateResiduum(s,g,i,e) / plasticState(p)%state(s,cc) + forall (u = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & + relPlasticStateResiduum(u,g,i,e) = & + plasticStateResiduum(u,g,i,e) / plasticState(p)%state(u,cc) do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - forall (s = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(mySource)%state(s,cc)) > 0.0_pReal) & - relSourceStateResiduum(s,mySource,g,i,e) = & - sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%state(s,cc) + forall (u = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(mySource)%state(u,cc)) > 0.0_pReal) & + relSourceStateResiduum(u,mySource,g,i,e) = & + sourceStateResiduum(u,mySource,g,i,e) / sourceState(p)%p(mySource)%state(u,cc) enddo crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & rTol_crystalliteState .or. & From 31906e3ebd70ea033e9f7fb652cd6280278f1fbd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 09:21:33 +0100 Subject: [PATCH 060/309] no need for 2 loops --- src/crystallite.f90 | 47 +++++++++++++++++---------------------------- 1 file changed, 18 insertions(+), 29 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index de535e8c2..3239f12c4 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2016,6 +2016,8 @@ subroutine integrateStateRKCK45() mySizePlasticDotState, & ! size of dot States mySizeSourceDotState + ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler + ! ToDo: MD: rel residuu don't have to be pointwise real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & @@ -2080,54 +2082,41 @@ subroutine integrateStateRKCK45() relPlasticStateResiduum = 0.0_pReal relSourceStateResiduum = 0.0_pReal - !$OMP PARALLEL - !$OMP DO PRIVATE(p,cc) + !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - cc = phasememberAt(g,i,e) - plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) ! store Runge-Kutta dotState - do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%RKCK45dotState(6,:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) ! store Runge-Kutta dotState - enddo - endif - enddo; enddo; enddo - !$OMP ENDDO - - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - cc = phasememberAt(g,i,e) - - ! --- absolute residuum in state --- - mySizePlasticDotState = plasticState(p)%sizeDotState + p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + + mySizePlasticDotState = plasticState(p)%sizeDotState + + plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) + plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)),DB) & * crystallite_subdt(g,i,e) + + plasticState(p)%dotState(:,cc) = & + matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)), B) + do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState + + sourceState(p)%p(mySource)%RKCK45dotState(6,:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) ! store Runge-Kutta dotState + sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) = & matmul(transpose(sourceState(p)%p(mySource)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),DB) & * crystallite_subdt(g,i,e) - enddo - ! --- dot state --- - plasticState(p)%dotState(:,cc) = & - matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)), B) - do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState sourceState(p)%p(mySource)%dotState(:,cc) = & matmul(transpose(sourceState(p)%p(mySource)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),B) enddo + endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO call update_state(1.0_pReal) From 46be595ea803004d09a157c440a2848ad33e7f9e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:28:47 +0100 Subject: [PATCH 061/309] no need to store relative residual for all points --- src/crystallite.f90 | 43 +++++++++++++++++++++---------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 3239f12c4..d24b16dbf 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1787,18 +1787,19 @@ subroutine integrateStateAdaptiveEuler() s, & sizeDotState - ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler - ! ToDo: MD: rel residuu don't have to be pointwise - -real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & + ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler + real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - residuum_plastic, & - residuum_plastic_rel + residuum_plastic real(pReal), dimension(constitutive_source_maxSizeDotState,& maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - residuum_source_rel, & residuum_source + + real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & + residuum_plastic_rel + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & + residuum_source_rel !-------------------------------------------------------------------------------------------------- ! contribution to state and relative residui and from Euler integration @@ -1828,10 +1829,10 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & enddo; enddo; enddo !$OMP END PARALLEL DO - call update_deltaState - call update_dependentState - call update_stress(1.0_pReal) - call update_dotState(1.0_pReal) + call update_deltaState + call update_dependentState + call update_stress(1.0_pReal) + call update_dotState(1.0_pReal) !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) @@ -1840,20 +1841,18 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState - - ! --- contribution of heun step to absolute residui --- residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) where(dNeq0(plasticState(p)%dotState(1:sizeDotState,c))) - residuum_plastic_rel(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & - / plasticState(p)%dotState(1:sizeDotState,c) + residuum_plastic_rel(1:sizeDotState) = residuum_plastic(1:sizeDotState,g,i,e) & + / plasticState(p)%dotState(1:sizeDotState,c) else where - residuum_plastic_rel(1:sizeDotState,g,i,e) = 0.0_pReal + residuum_plastic_rel(1:sizeDotState) = 0.0_pReal end where - crystallite_converged(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState,g,i,e)) < & + crystallite_converged(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState)) < & rTol_crystalliteState .or. & abs(residuum_plastic(1:sizeDotState,g,i,e)) < & plasticState(p)%aTolState(1:sizeDotState)) @@ -1865,14 +1864,14 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) where(dNeq0(sourceState(p)%p(s)%dotState(1:sizeDotState,c))) - residuum_source_rel(1:sizeDotState,s,g,i,e) = residuum_source(1:sizeDotState,s,g,i,e) & - / sourceState(p)%p(s)%dotState(1:sizeDotState,c) + residuum_source_rel(1:sizeDotState) = residuum_source(1:sizeDotState,s,g,i,e) & + / sourceState(p)%p(s)%dotState(1:sizeDotState,c) else where - residuum_source_rel(1:SizeDotState,s,g,i,e) = 0.0_pReal + residuum_source_rel(1:SizeDotState) = 0.0_pReal end where - crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & - all(abs(residuum_source_rel(1:sizeDotState,s,g,i,e)) < & + crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & + all(abs(residuum_source_rel(1:sizeDotState)) < & rTol_crystalliteState .or. & abs(residuum_source(1:sizeDotState,s,g,i,e)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState)) From 0745d7ebc20ab6803869d88ca88cb56a8afb0aca Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:33:57 +0100 Subject: [PATCH 062/309] convergence flag is set only later --- src/crystallite.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index d24b16dbf..053aa35eb 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1809,7 +1809,7 @@ subroutine integrateStateAdaptiveEuler() do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState @@ -1838,7 +1838,7 @@ subroutine integrateStateAdaptiveEuler() do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState From 72c4f2b25fae73f0c9ec665fbb1132571f80aa51 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:37:18 +0100 Subject: [PATCH 063/309] same names everywhere if possible --- src/crystallite.f90 | 54 ++++++++++++++++++++++----------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 053aa35eb..80e1a7ed6 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2011,7 +2011,7 @@ subroutine integrateStateRKCK45() n, & p, & cc, & - mySource, & + s, & mySizePlasticDotState, & ! size of dot States mySizeSourceDotState @@ -2049,17 +2049,17 @@ subroutine integrateStateRKCK45() plasticState(p)%RKCK45dotState(stage,:,cc) = plasticState(p)%dotState(:,cc) plasticState(p)%dotState(:,cc) = A(1,stage) * plasticState(p)%RKCK45dotState(1,:,cc) - do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%RKCK45dotState(stage,:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) - sourceState(p)%p(mySource)%dotState(:,cc) = A(1,stage) * sourceState(p)%p(mySource)%RKCK45dotState(1,:,cc) + do s = 1_pInt, phase_Nsources(p) + sourceState(p)%p(s)%RKCK45dotState(stage,:,cc) = sourceState(p)%p(s)%dotState(:,cc) + sourceState(p)%p(s)%dotState(:,cc) = A(1,stage) * sourceState(p)%p(s)%RKCK45dotState(1,:,cc) enddo do n = 2_pInt, stage plasticState(p)%dotState(:,cc) = plasticState(p)%dotState(:,cc) & + A(n,stage) * plasticState(p)%RKCK45dotState(n,:,cc) - do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%dotState(:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) & - + A(n,stage) * sourceState(p)%p(mySource)%RKCK45dotState(n,:,cc) + do s = 1_pInt, phase_Nsources(p) + sourceState(p)%p(s)%dotState(:,cc) = sourceState(p)%p(s)%dotState(:,cc) & + + A(n,stage) * sourceState(p)%p(s)%RKCK45dotState(n,:,cc) enddo enddo @@ -2099,18 +2099,18 @@ subroutine integrateStateRKCK45() plasticState(p)%dotState(:,cc) = & matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)), B) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(mySource)%RKCK45dotState(6,:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) ! store Runge-Kutta dotState + sourceState(p)%p(s)%RKCK45dotState(6,:,cc) = sourceState(p)%p(s)%dotState(:,cc) ! store Runge-Kutta dotState - sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) = & - matmul(transpose(sourceState(p)%p(mySource)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),DB) & + sourceStateResiduum(1:mySizeSourceDotState,s,g,i,e) = & + matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),DB) & * crystallite_subdt(g,i,e) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - sourceState(p)%p(mySource)%dotState(:,cc) = & - matmul(transpose(sourceState(p)%p(mySource)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),B) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sourceState(p)%p(s)%dotState(:,cc) = & + matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),B) enddo endif @@ -2127,30 +2127,30 @@ subroutine integrateStateRKCK45() do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - cc = phasememberAt(g,i,e) + p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + mySizePlasticDotState = plasticState(p)%sizeDotState forall (u = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & relPlasticStateResiduum(u,g,i,e) = & plasticStateResiduum(u,g,i,e) / plasticState(p)%state(u,cc) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - forall (u = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(mySource)%state(u,cc)) > 0.0_pReal) & - relSourceStateResiduum(u,mySource,g,i,e) = & - sourceStateResiduum(u,mySource,g,i,e) / sourceState(p)%p(mySource)%state(u,cc) + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + forall (u = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & + relSourceStateResiduum(u,s,g,i,e) = & + sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) enddo crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & rTol_crystalliteState .or. & abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & plasticState(p)%aTolState(1:mySizePlasticDotState)) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & - all(abs(relSourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & + all(abs(relSourceStateResiduum(1:mySizeSourceDotState,s,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & - sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) + abs(sourceStateResiduum(1:mySizeSourceDotState,s,g,i,e)) < & + sourceState(p)%p(s)%aTolState(1:mySizeSourceDotState)) enddo endif enddo; enddo; enddo From 0876787e3c56bd201214d599a74c1ce1c11ef9ce Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:46:53 +0100 Subject: [PATCH 064/309] avoid loops --- src/crystallite.f90 | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 80e1a7ed6..cc261726f 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1976,10 +1976,8 @@ subroutine integrateStateRKCK45() phaseAt, phasememberAt, & homogenization_maxNgrains use constitutive, only: & - constitutive_collectDotState, & constitutive_plasticity_maxSizeDotState, & - constitutive_source_maxSizeDotState, & - constitutive_microstructure + constitutive_source_maxSizeDotState implicit none real(pReal), dimension(5,5), parameter :: & @@ -2059,7 +2057,7 @@ subroutine integrateStateRKCK45() + A(n,stage) * plasticState(p)%RKCK45dotState(n,:,cc) do s = 1_pInt, phase_Nsources(p) sourceState(p)%p(s)%dotState(:,cc) = sourceState(p)%p(s)%dotState(:,cc) & - + A(n,stage) * sourceState(p)%p(s)%RKCK45dotState(n,:,cc) + + A(n,stage) * sourceState(p)%p(s)%RKCK45dotState(n,:,cc) enddo enddo @@ -2088,7 +2086,7 @@ subroutine integrateStateRKCK45() if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) - mySizePlasticDotState = plasticState(p)%sizeDotState + mySizePlasticDotState = plasticState(p)%sizeDotState plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) @@ -2133,18 +2131,18 @@ subroutine integrateStateRKCK45() forall (u = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & relPlasticStateResiduum(u,g,i,e) = & plasticStateResiduum(u,g,i,e) / plasticState(p)%state(u,cc) + + crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + rTol_crystalliteState .or. & + abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + plasticState(p)%aTolState(1:mySizePlasticDotState)) do s = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState forall (u = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & relSourceStateResiduum(u,s,g,i,e) = & sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) - enddo - crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState)) - do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & all(abs(relSourceStateResiduum(1:mySizeSourceDotState,s,g,i,e)) < & From 4ec0fd70a2574e2caa84497fea165d53fcffb608 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:48:59 +0100 Subject: [PATCH 065/309] only one variable needed --- src/crystallite.f90 | 47 ++++++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 24 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index cc261726f..81b730aad 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2010,8 +2010,7 @@ subroutine integrateStateRKCK45() p, & cc, & s, & - mySizePlasticDotState, & ! size of dot States - mySizeSourceDotState + sizeDotState ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler ! ToDo: MD: rel residuu don't have to be pointwise @@ -2079,36 +2078,36 @@ subroutine integrateStateRKCK45() relPlasticStateResiduum = 0.0_pReal relSourceStateResiduum = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc) + !$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) - mySizePlasticDotState = plasticState(p)%sizeDotState + sizeDotState = plasticState(p)%sizeDotState plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & - matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)),DB) & + plasticStateResiduum(1:sizeDotState,g,i,e) = & + matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & * crystallite_subdt(g,i,e) plasticState(p)%dotState(:,cc) = & - matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)), B) + matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)), B) do s = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sizeDotState = sourceState(p)%p(s)%sizeDotState sourceState(p)%p(s)%RKCK45dotState(6,:,cc) = sourceState(p)%p(s)%dotState(:,cc) ! store Runge-Kutta dotState - sourceStateResiduum(1:mySizeSourceDotState,s,g,i,e) = & - matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),DB) & + sourceStateResiduum(1:sizeDotState,s,g,i,e) = & + matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & * crystallite_subdt(g,i,e) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sizeDotState = sourceState(p)%p(s)%sizeDotState sourceState(p)%p(s)%dotState(:,cc) = & - matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),B) + matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:sizeDotState,cc)),B) enddo endif @@ -2120,35 +2119,35 @@ subroutine integrateStateRKCK45() !$OMP PARALLEL ! --- relative residui and state convergence --- - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc,u) + !$OMP DO PRIVATE(sizeDotState,p,cc,u) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) - mySizePlasticDotState = plasticState(p)%sizeDotState - forall (u = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & + sizeDotState = plasticState(p)%sizeDotState + forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & relPlasticStateResiduum(u,g,i,e) = & plasticStateResiduum(u,g,i,e) / plasticState(p)%state(u,cc) - crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState)) + abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState - forall (u = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & + sizeDotState = sourceState(p)%p(s)%sizeDotState + forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & relSourceStateResiduum(u,s,g,i,e) = & sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sizeDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & - all(abs(relSourceStateResiduum(1:mySizeSourceDotState,s,g,i,e)) < & + all(abs(relSourceStateResiduum(1:sizeDotState,s,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:mySizeSourceDotState,s,g,i,e)) < & - sourceState(p)%p(s)%aTolState(1:mySizeSourceDotState)) + abs(sourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif enddo; enddo; enddo From fd069a96cdc68941a44de7aca9083a2b03b5d5d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:51:24 +0100 Subject: [PATCH 066/309] unifying name --- src/crystallite.f90 | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 81b730aad..f9f469a5d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2017,13 +2017,13 @@ subroutine integrateStateRKCK45() real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - plasticStateResiduum, & ! residuum from evolution in microstructure - relPlasticStateResiduum ! relative residuum from evolution in microstructure + residuum_plastic, & ! residuum from evolution in microstructure + residuum_plastic_rel ! relative residuum from evolution in microstructure real(pReal), dimension(constitutive_source_maxSizeDotState, & maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - sourceStateResiduum, & ! residuum from evolution in microstructure - relSourceStateResiduum ! relative residuum from evolution in microstructure + residuum_source, & ! residuum from evolution in microstructure + residuum_source_rel ! relative residuum from evolution in microstructure @@ -2076,8 +2076,8 @@ subroutine integrateStateRKCK45() !-------------------------------------------------------------------------------------------------- ! --- STATE UPDATE WITH ERROR ESTIMATE FOR STATE --- - relPlasticStateResiduum = 0.0_pReal - relSourceStateResiduum = 0.0_pReal + residuum_plastic_rel = 0.0_pReal + residuum_source_rel = 0.0_pReal !$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) @@ -2089,7 +2089,7 @@ subroutine integrateStateRKCK45() plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) - plasticStateResiduum(1:sizeDotState,g,i,e) = & + residuum_plastic(1:sizeDotState,g,i,e) = & matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & * crystallite_subdt(g,i,e) @@ -2101,7 +2101,7 @@ subroutine integrateStateRKCK45() sourceState(p)%p(s)%RKCK45dotState(6,:,cc) = sourceState(p)%p(s)%dotState(:,cc) ! store Runge-Kutta dotState - sourceStateResiduum(1:sizeDotState,s,g,i,e) = & + residuum_source(1:sizeDotState,s,g,i,e) = & matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & * crystallite_subdt(g,i,e) @@ -2128,25 +2128,25 @@ subroutine integrateStateRKCK45() sizeDotState = plasticState(p)%sizeDotState forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & - relPlasticStateResiduum(u,g,i,e) = & - plasticStateResiduum(u,g,i,e) / plasticState(p)%state(u,cc) + residuum_plastic_rel(u,g,i,e) = & + residuum_plastic(u,g,i,e) / plasticState(p)%state(u,cc) - crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & + crystallite_todo(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState,g,i,e)) < & rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & + abs(residuum_plastic(1:sizeDotState,g,i,e)) < & plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & - relSourceStateResiduum(u,s,g,i,e) = & - sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) + residuum_source_rel(u,s,g,i,e) = & + residuum_source(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) sizeDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & - all(abs(relSourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + all(abs(residuum_source_rel(1:sizeDotState,s,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + abs(residuum_source(1:sizeDotState,s,g,i,e)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif From 3dd21177a0464faf46aca285cb7d3f8ca7325743 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 11:04:49 +0100 Subject: [PATCH 067/309] no need to store relative residual pointwise --- src/crystallite.f90 | 76 ++++++++++++++++++++++----------------------- 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index f9f469a5d..0a190e364 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1890,8 +1890,6 @@ end subroutine integrateStateAdaptiveEuler ! ToDo: This is totally BROKEN: RK4dotState is never used!!! !-------------------------------------------------------------------------------------------------- subroutine integrateStateRK4() - use, intrinsic :: & - IEEE_arithmetic use mesh, only: & mesh_element use material, only: & @@ -1960,8 +1958,8 @@ end subroutine integrateStateRK4 !> adaptive step size (use 5th order solution to advance = "local extrapolation") !-------------------------------------------------------------------------------------------------- subroutine integrateStateRKCK45() - use, intrinsic :: & - IEEE_arithmetic + use prec, only: & + dNeq0 use numerics, only: & rTol_crystalliteState use mesh, only: & @@ -2005,26 +2003,25 @@ subroutine integrateStateRKCK45() i, & ! integration point index in ip loop g, & ! grain index in grain loop stage, & ! stage index in integration stage loop - u, & ! state index n, & p, & cc, & s, & sizeDotState - ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler - ! ToDo: MD: rel residuu don't have to be pointwise + ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of RKCK45 real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - residuum_plastic, & ! residuum from evolution in microstructure - residuum_plastic_rel ! relative residuum from evolution in microstructure + residuum_plastic ! relative residuum from evolution in microstructure real(pReal), dimension(constitutive_source_maxSizeDotState, & maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - residuum_source, & ! residuum from evolution in microstructure - residuum_source_rel ! relative residuum from evolution in microstructure - + residuum_source ! relative residuum from evolution in microstructure + real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & + residuum_plastic_rel + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & + residuum_source_rel call update_dotState(1.0_pReal) @@ -2076,8 +2073,6 @@ subroutine integrateStateRKCK45() !-------------------------------------------------------------------------------------------------- ! --- STATE UPDATE WITH ERROR ESTIMATE FOR STATE --- - residuum_plastic_rel = 0.0_pReal - residuum_source_rel = 0.0_pReal !$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) @@ -2116,43 +2111,48 @@ subroutine integrateStateRKCK45() call update_state(1.0_pReal) -!$OMP PARALLEL ! --- relative residui and state convergence --- - !$OMP DO PRIVATE(sizeDotState,p,cc,u) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + !$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) + if (crystallite_todo(g,i,e)) then + p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) - sizeDotState = plasticState(p)%sizeDotState - forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & - residuum_plastic_rel(u,g,i,e) = & - residuum_plastic(u,g,i,e) / plasticState(p)%state(u,cc) + sizeDotState = plasticState(p)%sizeDotState + where(dNeq0(plasticState(p)%dotState(1:sizeDotState,cc))) + residuum_plastic_rel(1:sizeDotState) = residuum_plastic(1:sizeDotState,g,i,e) & + / plasticState(p)%state(1:sizeDotState,cc) + else where + residuum_plastic_rel(1:sizeDotState) = 0.0_pReal + end where + - crystallite_todo(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState,g,i,e)) < & - rTol_crystalliteState .or. & - abs(residuum_plastic(1:sizeDotState,g,i,e)) < & - plasticState(p)%aTolState(1:sizeDotState)) + crystallite_todo(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState)) < & + rTol_crystalliteState .or. & + abs(residuum_plastic(1:sizeDotState,g,i,e)) < & + plasticState(p)%aTolState(1:sizeDotState)) - do s = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & - residuum_source_rel(u,s,g,i,e) = & - residuum_source(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) + do s = 1_pInt, phase_Nsources(p) + sizeDotState = sourceState(p)%p(s)%sizeDotState + + where(dNeq0(sourceState(p)%p(s)%dotState(1:sizeDotState,cc))) + residuum_source_rel(1:sizeDotState) = residuum_source(1:sizeDotState,s,g,i,e) & + / sourceState(p)%p(s)%state(1:sizeDotState,cc) + else where + residuum_source_rel(1:SizeDotState) = 0.0_pReal + end where - sizeDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & - all(abs(residuum_source_rel(1:sizeDotState,s,g,i,e)) < & + all(abs(residuum_source_rel(1:sizeDotState)) < & rTol_crystalliteState .or. & abs(residuum_source(1:sizeDotState,s,g,i,e)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif enddo; enddo; enddo - !$OMP ENDDO -!$OMP END PARALLEL + !$OMP END PARALLEL DO call update_deltaState call update_dependentState From 39e766bba006e52742a952fbf523e413fa02750d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 12:36:02 +0100 Subject: [PATCH 068/309] improved readability --- src/crystallite.f90 | 139 +++++++++++++++++++++++--------------------- 1 file changed, 73 insertions(+), 66 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0a190e364..210bf8198 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1758,10 +1758,6 @@ end subroutine integrateStateEuler !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler() - use prec, only: & - dNeq0 - use numerics, only: & - rTol_crystalliteState use mesh, only: & mesh_element, & mesh_NcpElems, & @@ -1795,11 +1791,6 @@ subroutine integrateStateAdaptiveEuler() maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & residuum_source - - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & - residuum_plastic_rel - real(pReal), dimension(constitutive_source_maxSizeDotState) :: & - residuum_source_rel !-------------------------------------------------------------------------------------------------- ! contribution to state and relative residui and from Euler integration @@ -1845,42 +1836,55 @@ subroutine integrateStateAdaptiveEuler() residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - where(dNeq0(plasticState(p)%dotState(1:sizeDotState,c))) - residuum_plastic_rel(1:sizeDotState) = residuum_plastic(1:sizeDotState,g,i,e) & - / plasticState(p)%dotState(1:sizeDotState,c) - else where - residuum_plastic_rel(1:sizeDotState) = 0.0_pReal - end where - - crystallite_converged(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState)) < & - rTol_crystalliteState .or. & - abs(residuum_plastic(1:sizeDotState,g,i,e)) < & - plasticState(p)%aTolState(1:sizeDotState)) + crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & + plasticState(p)%dotState(1:sizeDotState,c), & + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState residuum_source(1:sizeDotState,s,g,i,e) = residuum_source(1:sizeDotState,s,g,i,e) & + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) - - where(dNeq0(sourceState(p)%p(s)%dotState(1:sizeDotState,c))) - residuum_source_rel(1:sizeDotState) = residuum_source(1:sizeDotState,s,g,i,e) & - / sourceState(p)%p(s)%dotState(1:sizeDotState,c) - else where - residuum_source_rel(1:SizeDotState) = 0.0_pReal - end where - crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & - all(abs(residuum_source_rel(1:sizeDotState)) < & - rTol_crystalliteState .or. & - abs(residuum_source(1:sizeDotState,s,g,i,e)) < & - sourceState(p)%p(s)%aTolState(1:sizeDotState)) - enddo + crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and.& + converged(residuum_source(1:sizeDotState,s,g,i,e), & + sourceState(p)%p(s)%dotState(1:sizeDotState,c), & + sourceState(p)%p(s)%aTolState(1:sizeDotState)) + enddo + endif enddo; enddo; enddo !$OMP END PARALLEL DO if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief determines whether a point is converged + !-------------------------------------------------------------------------------------------------- + logical pure function converged(residuum,dotState,absoluteTolerance) + use prec, only: & + dNeq0 + use numerics, only: & + rTol_crystalliteState + + implicit none + real(pReal), dimension(:), intent(in) ::& + residuum, dotState, absoluteTolerance + real(pReal), dimension(size(residuum,1)) ::& + residuum_rel + + where(dNeq0(dotState)) + residuum_rel = residuum/dotState + else where + residuum_rel = 0.0_pReal + end where + + converged = all(abs(residuum_rel) < rTol_crystalliteState .or. & + abs(residuum) < absoluteTolerance) + + end function converged end subroutine integrateStateAdaptiveEuler @@ -1958,10 +1962,6 @@ end subroutine integrateStateRK4 !> adaptive step size (use 5th order solution to advance = "local extrapolation") !-------------------------------------------------------------------------------------------------- subroutine integrateStateRKCK45() - use prec, only: & - dNeq0 - use numerics, only: & - rTol_crystalliteState use mesh, only: & mesh_element, & mesh_NcpElems, & @@ -2018,15 +2018,10 @@ subroutine integrateStateRKCK45() maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & residuum_source ! relative residuum from evolution in microstructure - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & - residuum_plastic_rel - real(pReal), dimension(constitutive_source_maxSizeDotState) :: & - residuum_source_rel call update_dotState(1.0_pReal) - ! --- SECOND TO SIXTH RUNGE KUTTA STEP --- do stage = 1_pInt,5_pInt @@ -2121,34 +2116,18 @@ subroutine integrateStateRKCK45() p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState - where(dNeq0(plasticState(p)%dotState(1:sizeDotState,cc))) - residuum_plastic_rel(1:sizeDotState) = residuum_plastic(1:sizeDotState,g,i,e) & - / plasticState(p)%state(1:sizeDotState,cc) - else where - residuum_plastic_rel(1:sizeDotState) = 0.0_pReal - end where - - - crystallite_todo(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState)) < & - rTol_crystalliteState .or. & - abs(residuum_plastic(1:sizeDotState,g,i,e)) < & - plasticState(p)%aTolState(1:sizeDotState)) + + crystallite_todo(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & + plasticState(p)%dotState(1:sizeDotState,cc), & + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - where(dNeq0(sourceState(p)%p(s)%dotState(1:sizeDotState,cc))) - residuum_source_rel(1:sizeDotState) = residuum_source(1:sizeDotState,s,g,i,e) & - / sourceState(p)%p(s)%state(1:sizeDotState,cc) - else where - residuum_source_rel(1:SizeDotState) = 0.0_pReal - end where - - crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & - all(abs(residuum_source_rel(1:sizeDotState)) < & - rTol_crystalliteState .or. & - abs(residuum_source(1:sizeDotState,s,g,i,e)) < & - sourceState(p)%p(s)%aTolState(1:sizeDotState)) + crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and.& + converged(residuum_source(1:sizeDotState,s,g,i,e), & + sourceState(p)%p(s)%dotState(1:sizeDotState,cc), & + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif enddo; enddo; enddo @@ -2159,6 +2138,34 @@ subroutine integrateStateRKCK45() call update_stress(1.0_pReal) call setConvergenceFlag if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief determines whether a point is converged + !-------------------------------------------------------------------------------------------------- + logical pure function converged(residuum,dotState,absoluteTolerance) + use prec, only: & + dNeq0 + use numerics, only: & + rTol_crystalliteState + + implicit none + real(pReal), dimension(:), intent(in) ::& + residuum, dotState, absoluteTolerance + real(pReal), dimension(size(residuum,1)) ::& + residuum_rel + + where(dNeq0(dotState)) + residuum_rel = residuum/dotState + else where + residuum_rel = 0.0_pReal + end where + + converged = all(abs(residuum_rel) < rTol_crystalliteState .or. & + abs(residuum) < absoluteTolerance) + + end function converged end subroutine integrateStateRKCK45 From 64b89484d2b75693b15be359427bb22244b336aa Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 12:56:02 +0100 Subject: [PATCH 069/309] logic better visible --- src/crystallite.f90 | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 210bf8198..dc3e5b154 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1872,17 +1872,16 @@ subroutine integrateStateAdaptiveEuler() implicit none real(pReal), dimension(:), intent(in) ::& residuum, dotState, absoluteTolerance - real(pReal), dimension(size(residuum,1)) ::& - residuum_rel - + logical, dimension(size(residuum,1)) ::& + converged_array + where(dNeq0(dotState)) - residuum_rel = residuum/dotState + converged_array = abs(residuum) < absoluteTolerance .or. (abs(residuum/dotState) < rTol_crystalliteState) else where - residuum_rel = 0.0_pReal + converged_array = .true. end where - converged = all(abs(residuum_rel) < rTol_crystalliteState .or. & - abs(residuum) < absoluteTolerance) + converged = all(converged_array) end function converged @@ -2153,17 +2152,16 @@ subroutine integrateStateRKCK45() implicit none real(pReal), dimension(:), intent(in) ::& residuum, dotState, absoluteTolerance - real(pReal), dimension(size(residuum,1)) ::& - residuum_rel - + logical, dimension(size(residuum,1)) ::& + converged_array + where(dNeq0(dotState)) - residuum_rel = residuum/dotState + converged_array = abs(residuum) < absoluteTolerance .or. (abs(residuum/dotState) < rTol_crystalliteState) else where - residuum_rel = 0.0_pReal + converged_array = .true. end where - converged = all(abs(residuum_rel) < rTol_crystalliteState .or. & - abs(residuum) < absoluteTolerance) + converged = all(converged_array) end function converged From 1d88057ce42c7069d5a0b5d6c7ff8c1f13d29589 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 13:24:35 +0100 Subject: [PATCH 070/309] avoid superflous variables --- src/crystallite.f90 | 60 ++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 33 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index dc3e5b154..4adae2a19 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1836,9 +1836,9 @@ subroutine integrateStateAdaptiveEuler() residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & + crystallite_converged(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & plasticState(p)%dotState(1:sizeDotState,c), & - plasticState(p)%aTolState(1:sizeDotState)) + plasticState(p)%aTolState(1:sizeDotState))) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState @@ -1847,9 +1847,9 @@ subroutine integrateStateAdaptiveEuler() + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and.& - converged(residuum_source(1:sizeDotState,s,g,i,e), & + all(converged(residuum_source(1:sizeDotState,s,g,i,e), & sourceState(p)%p(s)%dotState(1:sizeDotState,c), & - sourceState(p)%p(s)%aTolState(1:sizeDotState)) + sourceState(p)%p(s)%aTolState(1:sizeDotState))) enddo endif @@ -1863,25 +1863,22 @@ subroutine integrateStateAdaptiveEuler() !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure function converged(residuum,dotState,absoluteTolerance) + logical pure elemental function converged(residuum,dotState,absoluteTolerance) use prec, only: & - dNeq0 + dEq0 use numerics, only: & rTol_crystalliteState implicit none - real(pReal), dimension(:), intent(in) ::& + real(pReal), intent(in) ::& residuum, dotState, absoluteTolerance - logical, dimension(size(residuum,1)) ::& - converged_array - where(dNeq0(dotState)) - converged_array = abs(residuum) < absoluteTolerance .or. (abs(residuum/dotState) < rTol_crystalliteState) - else where - converged_array = .true. - end where - - converged = all(converged_array) + if (dEq0(dotState)) then + converged = .true. + else + converged = abs(residuum) < absoluteTolerance & + .or. abs(residuum/dotState) < rTol_crystalliteState + endif end function converged @@ -2116,17 +2113,17 @@ subroutine integrateStateRKCK45() sizeDotState = plasticState(p)%sizeDotState - crystallite_todo(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & + crystallite_todo(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & plasticState(p)%dotState(1:sizeDotState,cc), & - plasticState(p)%aTolState(1:sizeDotState)) + plasticState(p)%aTolState(1:sizeDotState))) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and.& - converged(residuum_source(1:sizeDotState,s,g,i,e), & + all(converged(residuum_source(1:sizeDotState,s,g,i,e), & sourceState(p)%p(s)%dotState(1:sizeDotState,cc), & - sourceState(p)%p(s)%aTolState(1:sizeDotState)) + sourceState(p)%p(s)%aTolState(1:sizeDotState))) enddo endif enddo; enddo; enddo @@ -2138,30 +2135,27 @@ subroutine integrateStateRKCK45() call setConvergenceFlag if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck - contains + contains !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure function converged(residuum,dotState,absoluteTolerance) + logical pure elemental function converged(residuum,dotState,absoluteTolerance) use prec, only: & - dNeq0 + dEq0 use numerics, only: & rTol_crystalliteState implicit none - real(pReal), dimension(:), intent(in) ::& + real(pReal), intent(in) ::& residuum, dotState, absoluteTolerance - logical, dimension(size(residuum,1)) ::& - converged_array - where(dNeq0(dotState)) - converged_array = abs(residuum) < absoluteTolerance .or. (abs(residuum/dotState) < rTol_crystalliteState) - else where - converged_array = .true. - end where - - converged = all(converged_array) + if (dEq0(dotState)) then + converged = .true. + else + converged = abs(residuum) < absoluteTolerance & + .or. abs(residuum/dotState) < rTol_crystalliteState + endif end function converged From fe88e5bf9cda3e38e2c7f46ce058052316f9b465 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 14:52:12 +0100 Subject: [PATCH 071/309] [skip ci] cleaning --- src/crystallite.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 4adae2a19..b089e2f77 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2085,13 +2085,12 @@ subroutine integrateStateRKCK45() do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%RKCK45dotState(6,:,cc) = sourceState(p)%p(s)%dotState(:,cc) ! store Runge-Kutta dotState - + sourceState(p)%p(s)%RKCK45dotState(6,:,cc) = sourceState(p)%p(s)%dotState(:,cc) + residuum_source(1:sizeDotState,s,g,i,e) = & matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & * crystallite_subdt(g,i,e) - sizeDotState = sourceState(p)%p(s)%sizeDotState sourceState(p)%p(s)%dotState(:,cc) = & matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:sizeDotState,cc)),B) enddo @@ -2124,7 +2123,7 @@ subroutine integrateStateRKCK45() all(converged(residuum_source(1:sizeDotState,s,g,i,e), & sourceState(p)%p(s)%dotState(1:sizeDotState,cc), & sourceState(p)%p(s)%aTolState(1:sizeDotState))) - enddo + enddo endif enddo; enddo; enddo !$OMP END PARALLEL DO From e1c2747393392543bfee7cdcfe25a243d35116d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 16:06:14 +0100 Subject: [PATCH 072/309] logic error for nonlocal --- src/crystallite.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b089e2f77..3ad592147 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2340,7 +2340,7 @@ subroutine update_dotState(timeFraction) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) !$OMP FLUSH(nonlocalStop) - if (nonlocalStop .or. (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e))) then + if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe, & crystallite_Fi(1:3,1:3,g,i,e), & @@ -2399,7 +2399,7 @@ subroutine update_deltaState do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) !$OMP FLUSH(nonlocalStop) - if (nonlocalStop .or. (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e))) then + if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,g,i,e)), & crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e), & From 3b13a1af6376314ef50f2f240bd2def7f7570c5e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 17:04:58 +0100 Subject: [PATCH 073/309] calculated convergence criteria wrongly --- src/crystallite.f90 | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 3ad592147..749f202e4 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1837,7 +1837,7 @@ subroutine integrateStateAdaptiveEuler() + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) crystallite_converged(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & - plasticState(p)%dotState(1:sizeDotState,c), & + plasticState(p)%state(1:sizeDotState,c), & plasticState(p)%aTolState(1:sizeDotState))) do s = 1_pInt, phase_Nsources(p) @@ -1848,7 +1848,7 @@ subroutine integrateStateAdaptiveEuler() crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and.& all(converged(residuum_source(1:sizeDotState,s,g,i,e), & - sourceState(p)%p(s)%dotState(1:sizeDotState,c), & + sourceState(p)%p(s)%state(1:sizeDotState,c), & sourceState(p)%p(s)%aTolState(1:sizeDotState))) enddo @@ -1863,21 +1863,21 @@ subroutine integrateStateAdaptiveEuler() !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure elemental function converged(residuum,dotState,absoluteTolerance) + logical pure elemental function converged(residuum,state,aTol) use prec, only: & dEq0 use numerics, only: & - rTol_crystalliteState + rTol => rTol_crystalliteState implicit none real(pReal), intent(in) ::& - residuum, dotState, absoluteTolerance + residuum, state, aTol - if (dEq0(dotState)) then - converged = .true. + if (dEq0(state)) then + converged = .true. ! ToDo: intended behavior? Not rely on absoluteTolerance else - converged = abs(residuum) < absoluteTolerance & - .or. abs(residuum/dotState) < rTol_crystalliteState + converged = abs(residuum) < aTol & + .or. abs(residuum/state) < rTol endif end function converged @@ -2113,7 +2113,7 @@ subroutine integrateStateRKCK45() sizeDotState = plasticState(p)%sizeDotState crystallite_todo(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & - plasticState(p)%dotState(1:sizeDotState,cc), & + plasticState(p)%state(1:sizeDotState,cc), & plasticState(p)%aTolState(1:sizeDotState))) do s = 1_pInt, phase_Nsources(p) @@ -2121,7 +2121,7 @@ subroutine integrateStateRKCK45() crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and.& all(converged(residuum_source(1:sizeDotState,s,g,i,e), & - sourceState(p)%p(s)%dotState(1:sizeDotState,cc), & + sourceState(p)%p(s)%state(1:sizeDotState,cc), & sourceState(p)%p(s)%aTolState(1:sizeDotState))) enddo endif @@ -2139,21 +2139,21 @@ subroutine integrateStateRKCK45() !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure elemental function converged(residuum,dotState,absoluteTolerance) + logical pure elemental function converged(residuum,state,aTol) use prec, only: & dEq0 use numerics, only: & - rTol_crystalliteState + rTol => rTol_crystalliteState implicit none real(pReal), intent(in) ::& - residuum, dotState, absoluteTolerance + residuum, state, aTol - if (dEq0(dotState)) then - converged = .true. + if (dEq0(state)) then + converged = .true. ! ToDo: intended behavior? Not rely on absoluteTolerance else - converged = abs(residuum) < absoluteTolerance & - .or. abs(residuum/dotState) < rTol_crystalliteState + converged = abs(residuum) < aTol & + .or. abs(residuum/state) < rTol endif end function converged From 5eaeb37ea48d2d8b23721d981f24cc8a9a25eda7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 05:17:46 +0100 Subject: [PATCH 074/309] just polishing --- src/crystallite.f90 | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 749f202e4..7c99c4d7a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -819,8 +819,8 @@ subroutine crystallite_stressTangent() crystallite_invFi(1:3,1:3,c,i,e)) & + math_mul33x33(temp_33_3,dLidS(1:3,1:3,p,o)) end forall - lhs_3333 = crystallite_subdt(c,i,e)*math_mul3333xx3333(dSdFe,temp_3333) + & - math_mul3333xx3333(dSdFi,dFidS) + lhs_3333 = crystallite_subdt(c,i,e)*math_mul3333xx3333(dSdFe,temp_3333) & + + math_mul3333xx3333(dSdFi,dFidS) call math_invert2(temp_99,error,math_identity2nd(9_pInt)+math_3333to99(lhs_3333)) if (error) then @@ -1350,11 +1350,10 @@ logical function integrateStress(& !* calculate Jacobian for correction term if (mod(jacoCounterLp, iJacoLpresiduum) == 0_pInt) then - forall(o=1_pInt:3_pInt,p=1_pInt:3_pInt) & - dFe_dLp(o,1:3,p,1:3) = A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) - dFe_dLp = - dt * dFe_dLp - dRLp_dLp = math_identity2nd(9_pInt) & - - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) + forall(o=1_pInt:3_pInt,p=1_pInt:3_pInt) dFe_dLp(o,1:3,p,1:3) = A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) + dFe_dLp = - dt * dFe_dLp + dRLp_dLp = math_identity2nd(9_pInt) & + - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & @@ -2076,11 +2075,11 @@ subroutine integrateStateRKCK45() plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) residuum_plastic(1:sizeDotState,g,i,e) = & - matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & + matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & ! why transpose? Better to transpose constant DB * crystallite_subdt(g,i,e) plasticState(p)%dotState(:,cc) = & - matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)), B) + matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)), B) ! why transpose? Better to transpose constant B do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState From cbeb3dcff0133022622f1b16a2bf1375f463d4bf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 09:12:44 +0100 Subject: [PATCH 075/309] use the same formulation for convergence every where --- src/crystallite.f90 | 73 +++++++++++++++++++++++---------------------- 1 file changed, 38 insertions(+), 35 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 7c99c4d7a..f9ceab03c 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1535,11 +1535,8 @@ end function integrateStress !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- subroutine integrateStateFPI() - use, intrinsic :: & - IEEE_arithmetic use numerics, only: & - nState, & - rTol_crystalliteState + nState use mesh, only: & mesh_element use material, only: & @@ -1549,7 +1546,6 @@ subroutine integrateStateFPI() phase_Nsources, & homogenization_Ngrains use constitutive, only: & - constitutive_collectDotState, & constitutive_plasticity_maxSizeDotState, & constitutive_source_maxSizeDotState @@ -1635,9 +1631,9 @@ subroutine integrateStateFPI() plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * zeta & + plasticState(p)%previousDotState(:,c) * (1.0_pReal - zeta) - crystallite_converged(g,i,e) = all(abs(residuum_plastic(1:sizeDotState)) & - < max(plasticState(p)%aTolState(1:sizeDotState), & - abs(plasticState(p)%state(1:sizeDotState,c)*rTol_crystalliteState))) + crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState), & + plasticState(p)%state(1:sizeDotState,c), & + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) @@ -1659,9 +1655,9 @@ subroutine integrateStateFPI() + sourceState(p)%p(s)%previousDotState(:,c)* (1.0_pReal - zeta) crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & - all(abs(residuum_source(1:sizeDotState)) & - < max(sourceState(p)%p(s)%aTolState(1:sizeDotState), & - abs(sourceState(p)%p(s)%state(1:sizeDotState,c)*rTol_crystalliteState))) + converged(residuum_source(1:sizeDotState), & + sourceState(p)%p(s)%state(1:sizeDotState,c), & + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif enddo; enddo; enddo @@ -1729,6 +1725,23 @@ subroutine integrateStateFPI() endif end function damper + + !-------------------------------------------------------------------------------------------------- + !> @brief determines whether a point is converged + !-------------------------------------------------------------------------------------------------- + logical pure function converged(residuum,state,aTol) + use prec, only: & + dEq0 + use numerics, only: & + rTol => rTol_crystalliteState + + implicit none + real(pReal), intent(in), dimension(:) ::& + residuum, state, aTol + + converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) + + end function converged end subroutine integrateStateFPI @@ -1835,9 +1848,9 @@ subroutine integrateStateAdaptiveEuler() residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - crystallite_converged(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & + crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & plasticState(p)%state(1:sizeDotState,c), & - plasticState(p)%aTolState(1:sizeDotState))) + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState @@ -1846,9 +1859,9 @@ subroutine integrateStateAdaptiveEuler() + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and.& - all(converged(residuum_source(1:sizeDotState,s,g,i,e), & + converged(residuum_source(1:sizeDotState,s,g,i,e), & sourceState(p)%p(s)%state(1:sizeDotState,c), & - sourceState(p)%p(s)%aTolState(1:sizeDotState))) + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif @@ -1862,22 +1875,17 @@ subroutine integrateStateAdaptiveEuler() !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure elemental function converged(residuum,state,aTol) + logical pure function converged(residuum,state,aTol) use prec, only: & dEq0 use numerics, only: & rTol => rTol_crystalliteState implicit none - real(pReal), intent(in) ::& + real(pReal), intent(in), dimension(:) ::& residuum, state, aTol - if (dEq0(state)) then - converged = .true. ! ToDo: intended behavior? Not rely on absoluteTolerance - else - converged = abs(residuum) < aTol & - .or. abs(residuum/state) < rTol - endif + converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) end function converged @@ -2111,17 +2119,17 @@ subroutine integrateStateRKCK45() sizeDotState = plasticState(p)%sizeDotState - crystallite_todo(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & + crystallite_todo(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & plasticState(p)%state(1:sizeDotState,cc), & - plasticState(p)%aTolState(1:sizeDotState))) + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and.& - all(converged(residuum_source(1:sizeDotState,s,g,i,e), & + converged(residuum_source(1:sizeDotState,s,g,i,e), & sourceState(p)%p(s)%state(1:sizeDotState,cc), & - sourceState(p)%p(s)%aTolState(1:sizeDotState))) + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif enddo; enddo; enddo @@ -2138,22 +2146,17 @@ subroutine integrateStateRKCK45() !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure elemental function converged(residuum,state,aTol) + logical pure function converged(residuum,state,aTol) use prec, only: & dEq0 use numerics, only: & rTol => rTol_crystalliteState implicit none - real(pReal), intent(in) ::& + real(pReal), intent(in), dimension(:) ::& residuum, state, aTol - if (dEq0(state)) then - converged = .true. ! ToDo: intended behavior? Not rely on absoluteTolerance - else - converged = abs(residuum) < aTol & - .or. abs(residuum/state) < rTol - endif + converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) end function converged From aabd98bee9fe4d0a8eaec49bc545ebfe6f073b91 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 09:14:02 +0100 Subject: [PATCH 076/309] no need to repeat the same code --- src/crystallite.f90 | 73 +++++++++++---------------------------------- 1 file changed, 18 insertions(+), 55 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index f9ceab03c..45aca46d1 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1725,23 +1725,6 @@ subroutine integrateStateFPI() endif end function damper - - !-------------------------------------------------------------------------------------------------- - !> @brief determines whether a point is converged - !-------------------------------------------------------------------------------------------------- - logical pure function converged(residuum,state,aTol) - use prec, only: & - dEq0 - use numerics, only: & - rTol => rTol_crystalliteState - - implicit none - real(pReal), intent(in), dimension(:) ::& - residuum, state, aTol - - converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) - - end function converged end subroutine integrateStateFPI @@ -1870,25 +1853,6 @@ subroutine integrateStateAdaptiveEuler() if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief determines whether a point is converged - !-------------------------------------------------------------------------------------------------- - logical pure function converged(residuum,state,aTol) - use prec, only: & - dEq0 - use numerics, only: & - rTol => rTol_crystalliteState - - implicit none - real(pReal), intent(in), dimension(:) ::& - residuum, state, aTol - - converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) - - end function converged - end subroutine integrateStateAdaptiveEuler @@ -2141,25 +2105,6 @@ subroutine integrateStateRKCK45() call setConvergenceFlag if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief determines whether a point is converged - !-------------------------------------------------------------------------------------------------- - logical pure function converged(residuum,state,aTol) - use prec, only: & - dEq0 - use numerics, only: & - rTol => rTol_crystalliteState - - implicit none - real(pReal), intent(in), dimension(:) ::& - residuum, state, aTol - - converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) - - end function converged - end subroutine integrateStateRKCK45 @@ -2201,6 +2146,24 @@ subroutine setConvergenceFlag() end subroutine setConvergenceFlag + !-------------------------------------------------------------------------------------------------- + !> @brief determines whether a point is converged + !-------------------------------------------------------------------------------------------------- + logical pure function converged(residuum,state,aTol) + use prec, only: & + dEq0 + use numerics, only: & + rTol => rTol_crystalliteState + + implicit none + real(pReal), intent(in), dimension(:) ::& + residuum, state, aTol + + converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) + + end function converged + + !-------------------------------------------------------------------------------------------------- !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- From beb0ca01eb388721ee78caa62df777a0e534318c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 11:29:56 +0100 Subject: [PATCH 077/309] define functions where needed only use solver specific element names --- src/IO.f90 | 143 ++++++++++++++++---------------------------- src/mesh_abaqus.f90 | 68 +++++++++++---------- src/mesh_marc.f90 | 36 +++-------- 3 files changed, 97 insertions(+), 150 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 1f9ff937c..66ebb2d88 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -57,19 +57,11 @@ module IO public :: & IO_open_inputFile, & IO_open_logFile -#endif -#ifdef Abaqus - public :: & - IO_abaqus_hasNoPart #endif private :: & IO_fixedFloatValue, & IO_verifyFloatValue, & IO_verifyIntValue -#ifdef Abaqus - private :: & - abaqus_assembleInputFile -#endif contains @@ -385,6 +377,59 @@ subroutine IO_open_inputFile(fileUnit,modelName) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s close(fileUnit+1_pInt) + + contains + +!-------------------------------------------------------------------------------------------------- +!> @brief create a new input file for abaqus simulations by removing all comment lines and +!> including "include"s +!-------------------------------------------------------------------------------------------------- +recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) + + implicit none + integer(pInt), intent(in) :: unit1, & + unit2 + + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line,fname + logical :: createSuccess,fexist + + + do + read(unit2,'(A65536)',END=220) line + chunkPos = IO_stringPos(line) + + if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then + fname = trim(line(9+scan(line(9:),'='):)) + inquire(file=fname, exist=fexist) + if (.not.(fexist)) then + !$OMP CRITICAL (write2out) + write(6,*)'ERROR: file does not exist error in abaqus_assembleInputFile' + write(6,*)'filename: ', trim(fname) + !$OMP END CRITICAL (write2out) + createSuccess = .false. + return + endif + open(unit2+1,err=200,status='old',file=fname) + if (abaqus_assembleInputFile(unit1,unit2+1_pInt)) then + createSuccess=.true. + close(unit2+1) + else + createSuccess=.false. + return + endif + else if (line(1:2) /= '**' .OR. line(1:8)=='**damask') then + write(unit1,'(A)') trim(line) + endif + enddo + +220 createSuccess = .true. + return + +200 createSuccess =.false. + +end function abaqus_assembleInputFile #endif #ifdef Marc4DAMASK path = trim(modelName)//inputFileExtension @@ -556,35 +601,6 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) end subroutine IO_read_intFile -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief check if the input file for Abaqus contains part info -!-------------------------------------------------------------------------------------------------- -logical function IO_abaqus_hasNoPart(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line - - IO_abaqus_hasNoPart = .true. - -610 FORMAT(A65536) - rewind(fileUnit) - do - read(fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then - IO_abaqus_hasNoPart = .false. - exit - endif - enddo - -620 end function IO_abaqus_hasNoPart -#endif - - !-------------------------------------------------------------------------------------------------- !> @brief identifies strings without content !-------------------------------------------------------------------------------------------------- @@ -1598,57 +1614,4 @@ real(pReal) function IO_verifyFloatValue (string,validChars,myName) end function IO_verifyFloatValue -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief create a new input file for abaqus simulations by removing all comment lines and -!> including "include"s -!-------------------------------------------------------------------------------------------------- -recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) - - implicit none - integer(pInt), intent(in) :: unit1, & - unit2 - - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line,fname - logical :: createSuccess,fexist - - - do - read(unit2,'(A65536)',END=220) line - chunkPos = IO_stringPos(line) - - if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then - fname = trim(line(9+scan(line(9:),'='):)) - inquire(file=fname, exist=fexist) - if (.not.(fexist)) then - !$OMP CRITICAL (write2out) - write(6,*)'ERROR: file does not exist error in abaqus_assembleInputFile' - write(6,*)'filename: ', trim(fname) - !$OMP END CRITICAL (write2out) - createSuccess = .false. - return - endif - open(unit2+1,err=200,status='old',file=fname) - if (abaqus_assembleInputFile(unit1,unit2+1_pInt)) then - createSuccess=.true. - close(unit2+1) - else - createSuccess=.false. - return - endif - else if (line(1:2) /= '**' .OR. line(1:8)=='**damask') then - write(unit1,'(A)') trim(line) - endif - enddo - -220 createSuccess = .true. - return - -200 createSuccess =.false. - -end function abaqus_assembleInputFile -#endif - end module IO diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 5d225bfb9..1758c5986 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -434,7 +434,6 @@ subroutine mesh_init(ip,el) #endif use DAMASK_interface use IO, only: & - IO_abaqus_hasNoPart, & IO_open_InputFile, & IO_timeStamp, & IO_error, & @@ -471,7 +470,7 @@ subroutine mesh_init(ip,el) call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - noPart = IO_abaqus_hasNoPart(FILEUNIT) + noPart = hasNoPart(FILEUNIT) call mesh_abaqus_count_nodesAndElements(FILEUNIT) if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) call mesh_abaqus_count_elementSets(FILEUNIT) @@ -542,6 +541,33 @@ subroutine mesh_init(ip,el) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! +contains +!-------------------------------------------------------------------------------------------------- +!> @brief check if the input file for Abaqus contains part info +!-------------------------------------------------------------------------------------------------- +logical function hasNoPart(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line + + hasNoPart = .true. + +610 FORMAT(A65536) + rewind(fileUnit) + do + read(fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then + hasNoPart = .false. + exit + endif + enddo + +620 end function hasNoPart + end subroutine mesh_init @@ -1497,7 +1523,6 @@ subroutine mesh_abaqus_build_elements(fileUnit) use IO, only: IO_lc, & IO_stringValue, & - IO_skipChunks, & IO_stringPos, & IO_intValue, & IO_extractValue, & @@ -2173,49 +2198,28 @@ integer(pInt) function FE_mapElemtype(what) character(len=*), intent(in) :: what select case (IO_lc(what)) - case ( '6') - FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle - case ( '155', & - '125', & - '128') - FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) - case ( '11', & - 'cpe4', & + case ( 'cpe4', & 'cpe4t') FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27', & - 'cpe8', & + case ( 'cpe8', & 'cpe8t') FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral - case ( '54') - FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration - case ( '134', & - 'c3d4', & + case ( 'c3d4', & 'c3d4t') FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron - case ( '157') - FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations - case ( '127') - FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron - case ( '136', & - 'c3d6', & + case ( 'c3d6', & 'c3d6t') FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral - case ( '117', & - '123', & - 'c3d8r', & + case ( 'c3d8r', & 'c3d8rt') FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7', & - 'c3d8', & + case ( 'c3d8', & 'c3d8t') FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57', & - 'c3d20r', & + case ( 'c3d20r', & 'c3d20rt') FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21', & - 'c3d20', & + case ( 'c3d20', & 'c3d20t') FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral case default diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 3e0447285..67c343ebe 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -1909,44 +1909,28 @@ integer(pInt) function FE_mapElemtype(what) '125', & '128') FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) - case ( '11', & - 'cpe4', & - 'cpe4t') + case ( '11') FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27', & - 'cpe8', & - 'cpe8t') + case ( '27') FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral case ( '54') FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration - case ( '134', & - 'c3d4', & - 'c3d4t') + case ( '134') FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron case ( '157') FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations case ( '127') FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron - case ( '136', & - 'c3d6', & - 'c3d6t') + case ( '136') FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral case ( '117', & - '123', & - 'c3d8r', & - 'c3d8rt') + '123') FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7', & - 'c3d8', & - 'c3d8t') + case ( '7') FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57', & - 'c3d20r', & - 'c3d20rt') + case ( '57') FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21', & - 'c3d20', & - 'c3d20t') + case ( '21') FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral case default call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) @@ -2807,7 +2791,3 @@ end function mesh_get_nodeAtIP end module mesh - - - - From 615b1669928c6f66b2bbc8d83b95242be4947a46 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 11:39:28 +0100 Subject: [PATCH 078/309] removed unused stuff --- src/CPFEM2.f90 | 2 -- src/IO.f90 | 31 ------------------------------- src/constitutive.f90 | 1 - src/mesh_marc.f90 | 4 ---- 4 files changed, 38 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 91cc08296..b2aa2f598 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -95,8 +95,6 @@ subroutine CPFEM_init use prec, only: & pInt, pReal, pLongInt use IO, only: & - IO_read_realFile,& - IO_read_intFile, & IO_timeStamp, & IO_error use numerics, only: & diff --git a/src/IO.f90 b/src/IO.f90 index 66ebb2d88..698b8f1d5 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -30,7 +30,6 @@ module IO IO_open_jobFile, & IO_write_jobFile, & IO_write_jobRealFile, & - IO_write_jobIntFile, & IO_read_realFile, & IO_read_intFile, & IO_isBlank, & @@ -515,36 +514,6 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) end subroutine IO_write_jobRealFile -!-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pInt numbers to given unit for writing. File is -!! named after solver job name plus given extension and located in current working directory -!-------------------------------------------------------------------------------------------------- -subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) - use DAMASK_interface, only: & - getSolverJobName - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext !< extension of file - integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(getSolverJobName())//'.'//ext - if (present(recMultiplier)) then - open(fileUnit,status='replace',form='unformatted',access='direct', & - recl=pInt*recMultiplier,iostat=myStat,file=path) - else - open(fileUnit,status='replace',form='unformatted',access='direct', & - recl=pInt,iostat=myStat,file=path) - endif - - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - -end subroutine IO_write_jobIntFile - - !-------------------------------------------------------------------------------------------------- !> @brief opens binary file containing array of pReal numbers to given unit for reading. File is !! located in current working directory diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a0d7147a6..43d57a493 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -56,7 +56,6 @@ subroutine constitutive_init() IO_checkAndRewind, & IO_open_jobFile_stat, & IO_write_jobFile, & - IO_write_jobIntFile, & IO_timeStamp use config, only: & config_phase diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 67c343ebe..3db48fe8c 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -515,9 +515,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - - - call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -532,7 +529,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) close (FILEUNIT) - call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems From bcd9908a88b1e138354935ebac1c47bb7a18276f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 12:23:23 +0100 Subject: [PATCH 079/309] all variables/functions were not used --- src/homogenization.f90 | 2 - src/mesh_abaqus.f90 | 50 -------- src/mesh_grid.f90 | 267 ++--------------------------------------- src/mesh_marc.f90 | 62 +--------- 4 files changed, 12 insertions(+), 369 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index ac41158a1..20ce008fd 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -74,7 +74,6 @@ subroutine homogenization_init mesh_maxNips, & mesh_NcpElems, & mesh_element, & - FE_Nips, & FE_geomtype use constitutive, only: & constitutive_plasticity_maxSizePostResults, & @@ -346,7 +345,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_Lp, & crystallite_Li0, & crystallite_Li, & - crystallite_dPdF, & crystallite_Tstar0_v, & crystallite_Tstar_v, & crystallite_partionedF0, & diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 1758c5986..ec6b11ffa 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -363,9 +363,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_ipVolumes, & mesh_build_ipCoordinates, & mesh_cellCenterCoordinates, & - mesh_get_Ncellnodes, & - mesh_get_unitlength, & - mesh_get_nodeAtIP, & mesh_FEasCP private :: & @@ -3033,51 +3030,4 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_Ncellnodes -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_Ncellnodes() - - implicit none - - mesh_get_Ncellnodes = mesh_Ncellnodes - -end function mesh_get_Ncellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_unitlength -!-------------------------------------------------------------------------------------------------- -real(pReal) function mesh_get_unitlength() - - implicit none - - mesh_get_unitlength = mesh_unitlength - -end function mesh_get_unitlength - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns node that is located at an ip -!> @details return zero if requested ip does not exist or not available (more ips than nodes) -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) - - implicit none - character(len=*), intent(in) :: elemtypeFE - integer(pInt), intent(in) :: ip - integer(pInt) :: elemtype - integer(pInt) :: geomtype - - mesh_get_nodeAtIP = 0_pInt - - elemtype = FE_mapElemtype(elemtypeFE) - geomtype = FE_geomtype(elemtype) - if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & - mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) - -end function mesh_get_nodeAtIP - - end module mesh diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 8b1659ed8..a2a041955 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -61,10 +61,7 @@ module mesh real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) - logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) - - integer(pInt), dimension(2), private :: & - mesh_maxValStateVar = 0_pInt + logical, dimension(3), public, parameter :: mesh_periodicSurface = .true. !< flag indicating periodic outer surfaces (used for fluxes) integer(pInt), dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID @@ -81,9 +78,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & real(pReal), dimension(:,:,:), allocatable, private :: & FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes - integer(pInt), dimension(:,:,:,:), allocatable, private :: & - FE_subNodeOnIPFace - ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! Hence, I suggest to prefix with "FE_" @@ -192,86 +186,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8 & ! element 21 (3D 20node 27ip) ],pInt) - integer(pInt), dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: & - FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry - reshape(int([ & - 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) - 2,2,2,0,0,0, & ! element 125 (2D 6node 3ip) - 2,2,2,2,0,0, & ! element 11 (2D 4node 4ip) - 2,2,2,2,0,0, & ! element 27 (2D 8node 9ip) - 3,3,3,3,0,0, & ! element 134 (3D 4node 1ip) - 3,3,3,3,0,0, & ! element 127 (3D 10node 4ip) - 3,4,4,4,3,0, & ! element 136 (3D 6node 6ip) - 4,4,4,4,4,4, & ! element 117 (3D 8node 1ip) - 4,4,4,4,4,4, & ! element 7 (3D 8node 8ip) - 4,4,4,4,4,4 & ! element 21 (3D 20node 27ip) - ],pInt),[FE_maxNipNeighbors,FE_Ngeomtypes]) - - integer(pInt), dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & - parameter, private :: FE_face = & !< List of node indices on each face of a specific type of element geometry - reshape(int([& - 1,2,0,0 , & ! element 6 (2D 3node 1ip) - 2,3,0,0 , & - 3,1,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,0,0 , & ! element 125 (2D 6node 3ip) - 2,3,0,0 , & - 3,1,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,0,0 , & ! element 11 (2D 4node 4ip) - 2,3,0,0 , & - 3,4,0,0 , & - 4,1,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,0,0 , & ! element 27 (2D 8node 9ip) - 2,3,0,0 , & - 3,4,0,0 , & - 4,1,0,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,3,0 , & ! element 134 (3D 4node 1ip) - 1,4,2,0 , & - 2,3,4,0 , & - 1,3,4,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,3,0 , & ! element 127 (3D 10node 4ip) - 1,4,2,0 , & - 2,4,3,0 , & - 1,3,4,0 , & - 0,0,0,0 , & - 0,0,0,0 , & - 1,2,3,0 , & ! element 136 (3D 6node 6ip) - 1,4,5,2 , & - 2,5,6,3 , & - 1,3,6,4 , & - 4,6,5,0 , & - 0,0,0,0 , & - 1,2,3,4 , & ! element 117 (3D 8node 1ip) - 2,1,5,6 , & - 3,2,6,7 , & - 4,3,7,8 , & - 4,1,5,8 , & - 8,7,6,5 , & - 1,2,3,4 , & ! element 7 (3D 8node 8ip) - 2,1,5,6 , & - 3,2,6,7 , & - 4,3,7,8 , & - 4,1,5,8 , & - 8,7,6,5 , & - 1,2,3,4 , & ! element 21 (3D 20node 27ip) - 2,1,5,6 , & - 3,2,6,7 , & - 4,3,7,8 , & - 4,1,5,8 , & - 8,7,6,5 & - ],pInt),[FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes]) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type int([ & 3, & ! element 6 (2D 3node 1ip) @@ -354,29 +268,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & public :: & mesh_init, & - mesh_build_cellnodes, & - mesh_build_ipVolumes, & - mesh_build_ipCoordinates, & - mesh_cellCenterCoordinates, & - mesh_get_Ncellnodes, & - mesh_get_unitlength, & - mesh_get_nodeAtIP, & + mesh_cellCenterCoordinates - mesh_spectral_getGrid, & - mesh_spectral_getSize private :: & - mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_faceMatch, & mesh_build_FEdata, & mesh_spectral_getHomogenization, & mesh_spectral_count, & mesh_spectral_count_cpSizes, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & - mesh_spectral_build_ipNeighborhood + mesh_spectral_build_ipNeighborhood, & + mesh_spectral_getGrid, & + mesh_spectral_getSize, & + mesh_build_cellnodes, & + mesh_build_ipVolumes, & + mesh_build_ipCoordinates type, public, extends(tMesh) :: tMesh_grid @@ -437,9 +346,7 @@ subroutine mesh_init(ip,el) debug_mesh, & debug_levelBasic use numerics, only: & - usePingPong, & - numerics_unitlength, & - worldrank + numerics_unitlength use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -491,8 +398,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) call mesh_spectral_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - call mesh_get_damaskOptions(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -1160,8 +1065,6 @@ subroutine mesh_spectral_build_elements(fileUnit) mesh_element(10,e) = mesh_element(9,e) + 1_pInt mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) enddo if (e /= mesh_NcpElems) call IO_error(880_pInt,e) @@ -1314,25 +1217,6 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) end function mesh_nodesAroundCentres -!-------------------------------------------------------------------------------------------------- -!> @brief get any additional damask options from input file, sets mesh_periodicSurface -!-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) - -use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - - mesh_periodicSurface = .true. - - end subroutine mesh_get_damaskOptions - - !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' !-------------------------------------------------------------------------------------------------- @@ -1407,93 +1291,6 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -!-------------------------------------------------------------------------------------------------- -!> @brief find face-matching element of same type -!-------------------------------------------------------------------------------------------------- -subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) - -implicit none -integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID - matchingFace ! matching face ID -integer(pInt), intent(in) :: face, & ! face ID - elem ! CP elem ID -integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & - myFaceNodes ! global node ids on my face -integer(pInt) :: myType, & - candidateType, & - candidateElem, & - candidateFace, & - candidateFaceNode, & - minNsharedElems, & - NsharedElems, & - lonelyNode = 0_pInt, & - i, & - n, & - dir ! periodicity direction -integer(pInt), dimension(:), allocatable :: element_seen -logical checkTwins - -matchingElem = 0_pInt -matchingFace = 0_pInt -minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case -myType = FE_geomtype(mesh_element(2_pInt,elem)) ! figure elemGeomType - -do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face - myFaceNodes(n) = mesh_element(4_pInt+FE_face(n,face,myType),elem) ! CP id of face node - NsharedElems = mesh_sharedElem(1_pInt,myFaceNodes(n)) ! figure # shared elements for this node - if (NsharedElems < minNsharedElems) then - minNsharedElems = NsharedElems ! remember min # shared elems - lonelyNode = n ! remember most lonely node - endif -enddo - -allocate(element_seen(minNsharedElems)) -element_seen = 0_pInt - -checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements - candidateElem = mesh_sharedElem(1_pInt+i,myFaceNodes(lonelyNode)) ! present candidate elem - if (all(element_seen /= candidateElem)) then ! element seen for the first time? - element_seen(i) = candidateElem - candidateType = FE_geomtype(mesh_element(2_pInt,candidateElem)) ! figure elemGeomType of candidate -checkCandidateFace: do candidateFace = 1_pInt,FE_maxNipNeighbors ! check each face of candidate - if (FE_NmatchingNodesPerFace(candidateFace,candidateType) & - /= FE_NmatchingNodesPerFace(face,myType) & ! incompatible face - .or. (candidateElem == elem .and. candidateFace == face)) then ! this is my face - cycle checkCandidateFace - endif - checkTwins = .false. - do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face - candidateFaceNode = mesh_element(4_pInt+FE_face(n,candidateFace,candidateType),candidateElem) - if (all(myFaceNodes /= candidateFaceNode)) then ! candidate node does not match any of my face nodes - checkTwins = .true. ! perhaps the twin nodes do match - exit - endif - enddo - if(checkTwins) then -checkCandidateFaceTwins: do dir = 1_pInt,3_pInt - do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face - candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) - if (all(myFaceNodes /= mesh_nodeTwins(dir,candidateFaceNode))) then ! node twin does not match either - if (dir == 3_pInt) then - cycle checkCandidateFace - else - cycle checkCandidateFaceTwins ! try twins in next dimension - endif - endif - enddo - exit checkCandidateFaceTwins - enddo checkCandidateFaceTwins - endif - matchingFace = candidateFace - matchingElem = candidateElem - exit checkCandidate ! found my matching candidate - enddo checkCandidateFace - endif -enddo checkCandidate - -end subroutine mesh_faceMatch - - !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements !> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace @@ -2212,50 +2009,4 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_Ncellnodes -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_Ncellnodes() - - implicit none - - mesh_get_Ncellnodes = mesh_Ncellnodes - -end function mesh_get_Ncellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_unitlength -!-------------------------------------------------------------------------------------------------- -real(pReal) function mesh_get_unitlength() - - implicit none - - mesh_get_unitlength = mesh_unitlength - -end function mesh_get_unitlength - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns node that is located at an ip -!> @details return zero if requested ip does not exist or not available (more ips than nodes) -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) - - implicit none - character(len=*), intent(in) :: elemtypeFE - integer(pInt), intent(in) :: ip - integer(pInt) :: elemtype - integer(pInt) :: geomtype - - mesh_get_nodeAtIP = 0_pInt - - elemtype = 10_pInt - geomtype = FE_geomtype(elemtype) - if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & - mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) - -end function mesh_get_nodeAtIP - - end module mesh diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 3db48fe8c..7deb14fff 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -67,9 +67,6 @@ module mesh mesh_maxNelemInSet, & mesh_Nmaterials - integer(pInt), dimension(2), private :: & - mesh_maxValStateVar = 0_pInt - integer(pInt), dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID @@ -371,9 +368,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_ipVolumes, & mesh_build_ipCoordinates, & mesh_cellCenterCoordinates, & - mesh_get_Ncellnodes, & - mesh_get_unitlength, & - mesh_get_nodeAtIP, & mesh_FEasCP @@ -422,9 +416,7 @@ type, public, extends(tMesh) :: tMesh_marc mesh_maxNelemInSet integer(pInt), dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(2):: & - mesh_maxValStateVar = 0_pInt - + contains procedure :: init => tMesh_marc_init end type tMesh_marc @@ -1442,7 +1434,6 @@ subroutine mesh_marc_build_elements(fileUnit) chunkPos = IO_stringPos(line) do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value - mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index if (initialcondTableStyle == 2_pInt) then read (fileUnit,610,END=630) line ! read extra line read (fileUnit,610,END=630) line ! read extra line @@ -1493,12 +1484,12 @@ use IO, only: & read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) select case(damaskOption) case('periodic') ! damask Option that allows to specify periodic fluxes do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) - v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? + v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' @@ -2739,51 +2730,4 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_Ncellnodes -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_Ncellnodes() - - implicit none - - mesh_get_Ncellnodes = mesh_Ncellnodes - -end function mesh_get_Ncellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_unitlength -!-------------------------------------------------------------------------------------------------- -real(pReal) function mesh_get_unitlength() - - implicit none - - mesh_get_unitlength = mesh_unitlength - -end function mesh_get_unitlength - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns node that is located at an ip -!> @details return zero if requested ip does not exist or not available (more ips than nodes) -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) - - implicit none - character(len=*), intent(in) :: elemtypeFE - integer(pInt), intent(in) :: ip - integer(pInt) :: elemtype - integer(pInt) :: geomtype - - mesh_get_nodeAtIP = 0_pInt - - elemtype = FE_mapElemtype(elemtypeFE) - geomtype = FE_geomtype(elemtype) - if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & - mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) - -end function mesh_get_nodeAtIP - - end module mesh From ccb320fa6ebd46cc2b8087457ce49eaa8adddd97 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 14:00:26 +0100 Subject: [PATCH 080/309] central function for less depencies --- src/plastic_nonlocal.f90 | 48 +++++++++++++--------------------------- 1 file changed, 15 insertions(+), 33 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index c43de6627..417800629 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -216,8 +216,7 @@ contains !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_init(fileUnit) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) -use math, only: math_Mandel3333to66, & - math_Voigt66to3333, & +use math, only: math_Voigt66to3333, & math_mul3x3, & math_transpose33 use IO, only: IO_read, & @@ -245,11 +244,11 @@ use material, only: phase_plasticity, & PLASTICITY_NONLOCAL_label, & PLASTICITY_NONLOCAL_ID, & plasticState, & - material_phase + material_phase, & + material_allocatePlasticState use config, only: MATERIAL_partPhase use lattice -use numerics,only: & - numerics_integrator + implicit none @@ -929,30 +928,13 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), endif enddo outputsLoop - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_nonlocal_sizePostResults(instance) plasticState(phase)%nonlocal = .true. - plasticState(phase)%nSlip = totalNslip(instance) - plasticState(phase)%nTwin = 0_pInt - plasticState(phase)%nTrans= 0_pInt - allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) + call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & + totalNslip(instance),0_pInt,0_pInt) - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + plasticState(phase)%slipRate => & plasticState(phase)%dotState(iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) plasticState(phase)%accumulatedSlip => & @@ -1638,10 +1620,10 @@ end subroutine plastic_nonlocal_kinetics !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature, ip, el) -use math, only: math_Plain3333to99, & +use math, only: math_3333to99, & math_mul6x6, & math_mul33xx33, & - math_Mandel6to33 + math_6toSym33 use debug, only: debug_level, & debug_constitutive, & debug_levelExtensive, & @@ -1733,11 +1715,11 @@ do s = 1_pInt,ns tauNS(s,1) = tau(s) tauNS(s,2) = tau(s) if (tau(s) > 0.0_pReal) then - tauNS(s,3) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,1,s,instance)) - tauNS(s,4) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,3,s,instance)) + tauNS(s,3) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,1,s,instance)) + tauNS(s,4) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,3,s,instance)) else - tauNS(s,3) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,2,s,instance)) - tauNS(s,4) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,4,s,instance)) + tauNS(s,3) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,2,s,instance)) + tauNS(s,4) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,4,s,instance)) endif enddo forall (t = 1_pInt:4_pInt) & @@ -1812,7 +1794,7 @@ do s = 1_pInt,ns * burgers(s,instance) endif enddo -dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) +dLp_dTstar99 = math_3333to99(dLp_dTstar3333) #ifdef DEBUG From d33c7a28030375b488a48f538a452d44682bafda Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 31 Jan 2019 14:24:28 +0100 Subject: [PATCH 081/309] [skip ci] updated version information after successful test of v2.0.2-1667-g6b66563b --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index cd40c2f04..2479c4238 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1634-g370b23d5 +v2.0.2-1667-g6b66563b From b9c834f86a60b8789404d187c9586786ca998eba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 17:01:26 +0100 Subject: [PATCH 082/309] missing use from IO --- src/mesh_abaqus.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index ec6b11ffa..8c93a899a 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -543,7 +543,11 @@ contains !> @brief check if the input file for Abaqus contains part info !-------------------------------------------------------------------------------------------------- logical function hasNoPart(fileUnit) - + use IO, only: & + IO_stringPos, & + IO_stringValue, & + IO_lc + implicit none integer(pInt), intent(in) :: fileUnit From 721af0a9a9ad75c8789ad6fe1f5ce256d7a93704 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 07:06:19 +0100 Subject: [PATCH 083/309] plastic_nonlocal still has confusing state handling --- src/plastic_nonlocal.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 417800629..cba989cb5 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -933,7 +933,8 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), plasticState(phase)%nonlocal = .true. call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & totalNslip(instance),0_pInt,0_pInt) - + + plasticState(phase)%offsetDeltaState = 0_pInt plasticState(phase)%slipRate => & plasticState(phase)%dotState(iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) From 8a2689da0ab0d7be1b45ee9cf56cdb872b6ad097 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 08:52:38 +0100 Subject: [PATCH 084/309] documentation was for a lot of things that are not in here setting constants without truncation --- src/Lambert.f90 | 88 ++++++++++++++++++++++++++----------------------- 1 file changed, 46 insertions(+), 42 deletions(-) diff --git a/src/Lambert.f90 b/src/Lambert.f90 index ab939bcc6..68ae2ab41 100644 --- a/src/Lambert.f90 +++ b/src/Lambert.f90 @@ -1,5 +1,6 @@ ! ################################################################### ! Copyright (c) 2013-2015, Marc De Graef/Carnegie Mellon University +! Modified 2017-2019, Martin Diehl/Max-Planck-Institut für Eisenforschung GmbH ! All rights reserved. ! ! Redistribution and use in source and binary forms, with or without modification, are @@ -29,19 +30,8 @@ !-------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University ! -!> @brief everything that has to do with the modified Lambert projections +!> @brief Mapping homochoric <-> cubochoric ! -!> @details This module contains a number of projection functions for the modified -!> Lambert projection between square lattice and 2D hemisphere, hexagonal lattice -!> and 2D hemisphere, as well as the more complex mapping between a 3D cubic grid -!> and the unit quaternion hemisphere with positive scalar component. In addition, there -!> are some other projections, such as the stereographic one. Each function is named -!> by the projection, the dimensionality of the starting grid, and the forward or inverse -!> character. For each function, there is also a single precision and a double precision -!> version, but we use the interface formalism to have only a single call. The Forward -!> mapping is taken to be the one from the simple grid to the curved grid. Since the module -!> deals with various grids, we also add a few functions/subroutines that apply symmetry -!> operations on those grids. !> References: !> D. Rosca, A. Morawiec, and M. De Graef. “A new method of constructing a grid !> in the space of 3D rotations and its applications to texture analysis”. @@ -49,24 +39,23 @@ !-------------------------------------------------------------------------- module Lambert use math - use prec + use prec, only: & + pReal implicit none - - real(pReal), private :: & - sPi = sqrt(PI), & - pref = sqrt(6.0_pReal/PI), & - ! the following constants are used for the cube to quaternion hemisphere mapping - ap = PI**(2.0_pReal/3.0_pReal), & - sc = 0.897772786961286_pReal, & ! a/ap - beta = 0.962874509979126_pReal, & ! pi^(5/6)/6^(1/6)/2 - R1 = 1.330670039491469_pReal, & ! (3pi/4)^(1/3) - r2 = sqrt(2.0_pReal), & - pi12 = PI/12.0_pReal, & - prek = 1.643456402972504_pReal, & ! R1 2^(1/4)/beta - r24 = sqrt(24.0_pReal) - private + real(pReal), parameter, private :: & + SPI = sqrt(PI), & + PREF = sqrt(6.0_pReal/PI), & + A = PI**(5.0_pReal/6.0_pReal)/6.0_pReal**(1.0_pReal/6.0_pReal), & + AP = PI**(2.0_pReal/3.0_pReal), & + SC = A/AP, & + BETA = A/2.0_pReal, & + R1 = (3.0_pReal*PI/4.0_pReal)**(1.0_pReal/3.0_pReal), & + R2 = sqrt(2.0_pReal), & + PI12 = PI/12.0_pReal, & + PREK = R1 * 2.0_pReal**(1.0_pReal/4.0_pReal)/BETA + public :: & LambertCubeToBall, & LambertBallToCube @@ -78,20 +67,24 @@ contains !-------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief map from 3D cubic grid to 3D ball !-------------------------------------------------------------------------- function LambertCubeToBall(cube) result(ball) use, intrinsic :: IEEE_ARITHMETIC + use prec, only: & + pInt, & + dEq0 implicit none real(pReal), intent(in), dimension(3) :: cube real(pReal), dimension(3) :: ball, LamXYZ, XYZ - real(pReal) :: T(2), c, s, q - real(pReal), parameter :: eps = 1.0e-8_pReal + real(pReal) :: T(2), c, s, q + real(pReal), parameter :: eps = 1.0e-8_pReal integer(pInt), dimension(3) :: p integer(pInt), dimension(2) :: order - if (maxval(abs(cube)) > ap/2.0+eps) then + if (maxval(abs(cube)) > AP/2.0+eps) then ball = IEEE_value(cube,IEEE_positive_inf) return end if @@ -109,17 +102,17 @@ function LambertCubeToBall(cube) result(ball) LamXYZ = [ 0.0_pReal, 0.0_pReal, pref * XYZ(3) ] else special order = merge( [2,1], [1,2], abs(XYZ(2)) <= abs(XYZ(1))) ! order of absolute values of XYZ - q = pi12 * XYZ(order(1))/XYZ(order(2)) ! smaller by larger + q = PI12 * XYZ(order(1))/XYZ(order(2)) ! smaller by larger c = cos(q) s = sin(q) - q = prek * XYZ(order(2))/ sqrt(r2-c) - T = [ (r2*c - 1.0), r2 * s] * q + q = prek * XYZ(order(2))/ sqrt(R2-c) + T = [ (R2*c - 1.0), R2 * s] * q ! transform to sphere grid (inverse Lambert) ! [note that there is no need to worry about dividing by zero, since XYZ(3) can not become zero] c = sum(T**2) s = Pi * c/(24.0*XYZ(3)**2) - c = sPi * c / r24 / XYZ(3) + c = sPi * c / sqrt(24.0_pReal) / XYZ(3) q = sqrt( 1.0 - s ) LamXYZ = [ T(order(2)) * q, T(order(1)) * q, pref * XYZ(3) - c ] endif special @@ -131,19 +124,26 @@ function LambertCubeToBall(cube) result(ball) end function LambertCubeToBall + !-------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief map from 3D ball to 3D cubic grid !-------------------------------------------------------------------------- pure function LambertBallToCube(xyz) result(cube) - use, intrinsic :: IEEE_ARITHMETIC + use, intrinsic :: IEEE_ARITHMETIC, only:& + IEEE_positive_inf, & + IEEE_value + use prec, only: & + pInt, & + dEq0 implicit none real(pReal), intent(in), dimension(3) :: xyz real(pReal), dimension(3) :: cube, xyz1, xyz3 real(pReal), dimension(2) :: Tinv, xyz2 real(pReal) :: rs, qxy, q2, sq2, q, tt - integer(pInt) , dimension(3) :: p + integer(pInt), dimension(3) :: p rs = norm2(xyz) if (rs > R1) then @@ -168,10 +168,10 @@ pure function LambertBallToCube(xyz) result(cube) else special q2 = qxy + maxval(abs(xyz2))**2 sq2 = sqrt(q2) - q = (beta/r2/R1) * sqrt(q2*qxy/(q2-maxval(abs(xyz2))*sq2)) - tt = (minval(abs(xyz2))**2+maxval(abs(xyz2))*sq2)/r2/qxy - Tinv = q * sign(1.0,xyz2) * merge([ 1.0_pReal, acos(math_clip(tt,-1.0_pReal,1.0_pReal))/pi12], & - [ acos(math_clip(tt,-1.0_pReal,1.0_pReal))/pi12, 1.0_pReal], & + q = (beta/R2/R1) * sqrt(q2*qxy/(q2-maxval(abs(xyz2))*sq2)) + tt = (minval(abs(xyz2))**2+maxval(abs(xyz2))*sq2)/R2/qxy + Tinv = q * sign(1.0,xyz2) * merge([ 1.0_pReal, acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12], & + [ acos(math_clip(tt,-1.0_pReal,1.0_pReal))/PI12, 1.0_pReal], & abs(xyz2(2)) <= abs(xyz2(1))) endif special @@ -185,15 +185,19 @@ pure function LambertBallToCube(xyz) result(cube) end function LambertBallToCube + !-------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief determine to which pyramid a point in a cubic grid belongs !-------------------------------------------------------------------------- pure function GetPyramidOrder(xyz) + use prec, only: & + pInt implicit none real(pReal),intent(in),dimension(3) :: xyz - integer(pInt), dimension(3) :: GetPyramidOrder + integer(pInt), dimension(3) :: GetPyramidOrder if (((abs(xyz(1)) <= xyz(3)).and.(abs(xyz(2)) <= xyz(3))) .or. & ((abs(xyz(1)) <= -xyz(3)).and.(abs(xyz(2)) <= -xyz(3)))) then @@ -205,7 +209,7 @@ pure function GetPyramidOrder(xyz) ((abs(xyz(1)) <= -xyz(2)).and.(abs(xyz(3)) <= -xyz(2)))) then GetPyramidOrder = [3,1,2] else - GetPyramidOrder = -1 ! should be impossible, but might simplify debugging + GetPyramidOrder = -1 ! should be impossible, but might simplify debugging end if end function GetPyramidOrder From 17a682e883d363a5b5b0051649dc9695c9ef5995 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 08:53:57 +0100 Subject: [PATCH 085/309] P/epsijk parameter has nothing to do with precision --- src/prec.f90 | 2 -- src/quaternions.f90 | 17 +++++++++++------ 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/src/prec.f90 b/src/prec.f90 index bc7f523d0..ea539011f 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -29,8 +29,6 @@ module prec real(pReal), parameter, public :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation) integer(pInt), allocatable, dimension(:) :: realloc_lhs_test - - real(pReal), parameter, public :: epsijk = -1.0_pReal !< parameter for orientation conversion. ToDo: Better place? type, public :: group_float !< variable length datatype used for storage of state real(pReal), dimension(:), pointer :: p diff --git a/src/quaternions.f90 b/src/quaternions.f90 index 78379c49b..d4574e734 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -1,5 +1,6 @@ ! ################################################################### ! Copyright (c) 2013-2015, Marc De Graef/Carnegie Mellon University +! Modified 2017-2019, Martin Diehl/Max-Planck-Institut für Eisenforschung GmbH ! All rights reserved. ! ! Redistribution and use in source and binary forms, with or without modification, are @@ -27,10 +28,14 @@ ! ################################################################### module quaternions - use prec + use prec, only: & + pReal implicit none public + + real(pReal), parameter, public :: epsijk = -1.0_pReal !< parameter for orientation conversion. ToDo: Better place? + type, public :: quaternion real(pReal) :: w = 0.0_pReal real(pReal) :: x = 0.0_pReal @@ -73,9 +78,6 @@ module quaternions procedure, public :: homomorphed => quat_homomorphed - !procedure,private :: quat_write - !generic :: write(formatted) => quat_write - end type interface assignment (=) @@ -150,7 +152,7 @@ pure subroutine assign_vec__(self,other) implicit none type(quaternion), intent(out) :: self - real(pReal), intent(in), dimension(4) :: other + real(pReal), intent(in), dimension(4) :: other self%w = other(1) self%x = other(2) @@ -288,6 +290,9 @@ end function div_scal__ !> equality of two quaternions !-------------------------------------------------------------------------- logical elemental function eq__(self,other) + use prec, only: & + dEq + implicit none class(quaternion), intent(in) :: self,other @@ -346,7 +351,7 @@ type(quaternion) elemental function exp__(self) implicit none class(quaternion), intent(in) :: self - real(pReal) :: absImag + real(pReal) :: absImag absImag = norm2([self%x, self%y, self%z]) From 53a95ea84f9b1464af1385f781ea68e8360343bc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 10:01:54 +0100 Subject: [PATCH 086/309] cleaned and documented --- src/Lambert.f90 | 4 +- src/orientations.f90 | 6 + src/quaternions.f90 | 89 ++++--- src/rotations.f90 | 614 +++++++++++++++++++++++++------------------ 4 files changed, 413 insertions(+), 300 deletions(-) diff --git a/src/Lambert.f90 b/src/Lambert.f90 index 68ae2ab41..86c019688 100644 --- a/src/Lambert.f90 +++ b/src/Lambert.f90 @@ -29,10 +29,10 @@ !-------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -! +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief Mapping homochoric <-> cubochoric ! -!> References: +!> @details !> D. Rosca, A. Morawiec, and M. De Graef. “A new method of constructing a grid !> in the space of 3D rotations and its applications to texture analysis”. !> Modeling and Simulations in Materials Science and Engineering 22, 075013 (2014). diff --git a/src/orientations.f90 b/src/orientations.f90 index 67c46c2bb..285492729 100644 --- a/src/orientations.f90 +++ b/src/orientations.f90 @@ -1,3 +1,9 @@ +!--------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief orientation storage +!> @details: orientation = rotation + symmetry +!--------------------------------------------------------------------------------------------------- + module orientations use rotations use prec, only: & diff --git a/src/quaternions.f90 b/src/quaternions.f90 index d4574e734..b0dd37291 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -27,6 +27,11 @@ ! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ################################################################### +!--------------------------------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief general quaternion math, not limited to unit quaternions +!--------------------------------------------------------------------------------------------------- module quaternions use prec, only: & pReal @@ -112,9 +117,9 @@ end interface log contains -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> constructor for a quaternion from a 4-vector -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) pure function init__(array) implicit none @@ -128,9 +133,9 @@ type(quaternion) pure function init__(array) end function init__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> assing a quaternion -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- elemental subroutine assign_quat__(self,other) implicit none @@ -145,9 +150,9 @@ elemental subroutine assign_quat__(self,other) end subroutine assign_quat__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> assing a 4-vector -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- pure subroutine assign_vec__(self,other) implicit none @@ -162,9 +167,9 @@ pure subroutine assign_vec__(self,other) end subroutine assign_vec__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> addition of two quaternions -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function add__(self,other) implicit none @@ -178,9 +183,9 @@ type(quaternion) elemental function add__(self,other) end function add__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> unary positive operator -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pos__(self) implicit none @@ -194,9 +199,9 @@ type(quaternion) elemental function pos__(self) end function pos__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> subtraction of two quaternions -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function sub__(self,other) implicit none @@ -210,9 +215,9 @@ type(quaternion) elemental function sub__(self,other) end function sub__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> unary positive operator -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function neg__(self) implicit none @@ -226,9 +231,9 @@ type(quaternion) elemental function neg__(self) end function neg__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> multiplication of two quaternions -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function mul_quat__(self,other) implicit none @@ -242,9 +247,9 @@ type(quaternion) elemental function mul_quat__(self,other) end function mul_quat__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> multiplication of quaternions with scalar -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function mul_scal__(self,scal) implicit none @@ -259,9 +264,9 @@ type(quaternion) elemental function mul_scal__(self,scal) end function mul_scal__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> division of two quaternions -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function div_quat__(self,other) implicit none @@ -272,9 +277,9 @@ type(quaternion) elemental function div_quat__(self,other) end function div_quat__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> divisiont of quaternions by scalar -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function div_scal__(self,scal) implicit none @@ -286,9 +291,9 @@ type(quaternion) elemental function div_scal__(self,scal) end function div_scal__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> equality of two quaternions -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- logical elemental function eq__(self,other) use prec, only: & dEq @@ -302,9 +307,9 @@ logical elemental function eq__(self,other) end function eq__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> inequality of two quaternions -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- logical elemental function neq__(self,other) implicit none @@ -315,9 +320,9 @@ logical elemental function neq__(self,other) end function neq__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> quaternion to the power of a scalar -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pow_scal__(self,expon) implicit none @@ -329,9 +334,9 @@ type(quaternion) elemental function pow_scal__(self,expon) end function pow_scal__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> quaternion to the power of a quaternion -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pow_quat__(self,expon) implicit none @@ -343,10 +348,10 @@ type(quaternion) elemental function pow_quat__(self,expon) end function pow_quat__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> exponential of a quaternion !> ToDo: Lacks any check for invalid operations -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function exp__(self) implicit none @@ -363,10 +368,10 @@ type(quaternion) elemental function exp__(self) end function exp__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> logarithm of a quaternion !> ToDo: Lacks any check for invalid operations -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function log__(self) implicit none @@ -383,9 +388,9 @@ type(quaternion) elemental function log__(self) end function log__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> norm of a quaternion -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- real(pReal) elemental function abs__(a) implicit none @@ -396,9 +401,9 @@ real(pReal) elemental function abs__(a) end function abs__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> dot product of two quaternions -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- real(pReal) elemental function dot_product__(a,b) implicit none @@ -409,9 +414,9 @@ real(pReal) elemental function dot_product__(a,b) end function dot_product__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> conjugate complex of a quaternion -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function conjg__(a) implicit none @@ -422,9 +427,9 @@ type(quaternion) elemental function conjg__(a) end function conjg__ -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> homomorphed quaternion of a quaternion -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- type(quaternion) elemental function quat_homomorphed(a) implicit none diff --git a/src/rotations.f90 b/src/rotations.f90 index 28c9b208f..e58963dea 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -1,5 +1,6 @@ ! ################################################################### ! Copyright (c) 2013-2014, Marc De Graef/Carnegie Mellon University +! Modified 2017-2019, Martin Diehl/Max-Planck-Institut für Eisenforschung GmbH ! All rights reserved. ! ! Redistribution and use in source and binary forms, with or without modification, are @@ -26,11 +27,21 @@ ! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ################################################################### +!--------------------------------------------------------------------------------------------------- +!> @author Marc De Graef, Carnegie Mellon University +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief rotation storage and conversion +!> @details: rotation is internally stored as quaternion. It cabe inialized from different +!> represantations and also returns itself in different representations. +!--------------------------------------------------------------------------------------------------- + module rotations - use prec + use prec, only: & + pReal use quaternions implicit none + private type, public :: rotation type(quaternion), private :: q contains @@ -39,138 +50,179 @@ module rotations procedure, public :: asAxisAnglePair procedure, public :: asRodriguesFrankVector procedure, public :: asRotationMatrix + !------------------------------------------ procedure, public :: fromRotationMatrix + !------------------------------------------ procedure, public :: rotVector procedure, public :: rotTensor end type rotation + public :: & + asQuaternion, & + asEulerAngles, & + asAxisAnglePair, & + asRotationMatrix, & + asRodriguesFrankVector, & + asHomochoric, & + fromRotationMatrix, & + rotVector, & + rotTensor contains + +!--------------------------------------------------------------------------------------------------- +! Return rotation in different represenations +!--------------------------------------------------------------------------------------------------- function asQuaternion(this) + + implicit none class(rotation), intent(in) :: this - real(pReal), dimension(4) :: asQuaternion + real(pReal), dimension(4) :: asQuaternion asQuaternion = [this%q%w, this%q%x, this%q%y, this%q%z] end function asQuaternion - - +!--------------------------------------------------------------------------------------------------- function asEulerAngles(this) + + implicit none class(rotation), intent(in) :: this - real(pReal), dimension(3) :: asEulerAngles - + real(pReal), dimension(3) :: asEulerAngles + asEulerAngles = qu2eu(this%q) end function asEulerAngles - - +!--------------------------------------------------------------------------------------------------- function asAxisAnglePair(this) + + implicit none class(rotation), intent(in) :: this - real(pReal), dimension(4) :: asAxisAnglePair + real(pReal), dimension(4) :: asAxisAnglePair asAxisAnglePair = qu2ax(this%q) end function asAxisAnglePair - - +!--------------------------------------------------------------------------------------------------- function asRotationMatrix(this) + + implicit none class(rotation), intent(in) :: this - real(pReal), dimension(3,3) :: asRotationMatrix + real(pReal), dimension(3,3) :: asRotationMatrix asRotationMatrix = qu2om(this%q) end function asRotationMatrix - - +!--------------------------------------------------------------------------------------------------- function asRodriguesFrankVector(this) + + implicit none class(rotation), intent(in) :: this - real(pReal), dimension(4) :: asRodriguesFrankVector + real(pReal), dimension(4) :: asRodriguesFrankVector asRodriguesFrankVector = qu2ro(this%q) + end function asRodriguesFrankVector - - +!--------------------------------------------------------------------------------------------------- function asHomochoric(this) + + implicit none class(rotation), intent(in) :: this - real(pReal), dimension(3) :: asHomochoric + real(pReal), dimension(3) :: asHomochoric asHomochoric = qu2ho(this%q) end function asHomochoric - - + +!--------------------------------------------------------------------------------------------------- +! Initialize rotation from different representations +!--------------------------------------------------------------------------------------------------- subroutine fromRotationMatrix(this,om) - class(rotation), intent(out) :: this - real(pReal), dimension(3,3), intent(in) :: om + + implicit none + class(rotation), intent(out) :: this + real(pReal), dimension(3,3), intent(in) :: om this%q = om2qu(om) end subroutine -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief rotates a vector passively (default) or actively -!-------------------------------------------------------------------------- +!> @brief rotate a vector passively (default) or actively +!> @details: rotation is based on unit quaternion or rotation matrix (fallback) +!--------------------------------------------------------------------------------------------------- function rotVector(this,v,active) - class(rotation), intent(in) :: this - logical, intent(in), optional :: active - real(pReal),intent(in),dimension(3) :: v - real(pReal),dimension(3) :: rotVector - type(quaternion) :: q + use prec, only: & + dEq + + implicit none + real(pReal), dimension(3) :: rotVector + class(rotation), intent(in) :: this + real(pReal), intent(in), dimension(3) :: v + logical, intent(in), optional :: active + + type(quaternion) :: q - if (dEq(norm2(v),1.0_pReal,tol=1.0e-15_pReal)) then - passive: if (merge(.not. active, .true., present(active))) then - q = this%q * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * conjg(this%q) ) - else passive - q = conjg(this%q) * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * this%q ) - endif passive - rotVector = [q%x,q%y,q%z] - else - passive2: if (merge(.not. active, .true., present(active))) then - rotVector = matmul(this%asRotationMatrix(),v) - else passive2 - rotVector = matmul(transpose(this%asRotationMatrix()),v) - endif passive2 - endif + 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) + q = this%q * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * conjg(this%q) ) + else passive + q = conjg(this%q) * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * this%q ) + endif passive + rotVector = [q%x,q%y,q%z] + else + passive2: if (merge(.not. active, .true., present(active))) then ! ToDo: not save (PGI) + rotVector = matmul(this%asRotationMatrix(),v) + else passive2 + rotVector = matmul(transpose(this%asRotationMatrix()),v) + endif passive2 + endif end function rotVector -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief rotate a second rank tensor using a rotation matrix, active or passive (single precision) -!-------------------------------------------------------------------------- +!> @brief rotate a second rank tensor passively (default) or actively +!> @details: rotation is based on rotation matrix +!--------------------------------------------------------------------------------------------------- function rotTensor(this,m,active) - class(rotation), intent(in) :: this - real(pReal),intent(in),dimension(3,3) :: m - logical, intent(in), optional :: active - real(pReal),dimension(3,3) :: rotTensor + + implicit none + real(pReal), dimension(3,3) :: rotTensor + class(rotation), intent(in) :: this + real(pReal), intent(in), dimension(3,3) :: m + logical, intent(in), optional :: active + - passive: if (merge(.not. active, .true., present(active))) then - rotTensor = matmul(matmul(this%asRotationMatrix(),m),transpose(this%asRotationMatrix())) - else passive - rotTensor = matmul(matmul(transpose(this%asRotationMatrix()),m),this%asRotationMatrix()) - endif passive + passive: if (merge(.not. active, .true., present(active))) then + rotTensor = matmul(matmul(this%asRotationMatrix(),m),transpose(this%asRotationMatrix())) + else passive + rotTensor = matmul(matmul(transpose(this%asRotationMatrix()),m),this%asRotationMatrix()) + endif passive end function rotTensor -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- -! here we start with a series of conversion routines between representations -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- +! The following routines convert between different representations +!--------------------------------------------------------------------------------------------------- + + +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Euler angles to orientation matrix [Morawiec, page 28] -!-------------------------------------------------------------------------- +!> @brief Euler angles to orientation matrix +!--------------------------------------------------------------------------------------------------- pure function eu2om(eu) result(om) + use prec, only: & + dEq0 implicit none - real(pReal), intent(in), dimension(3) :: eu !< Euler angles in radians - real(pReal), dimension(3,3) :: om !< output orientation matrix + real(pReal), intent(in), dimension(3) :: eu + real(pReal), dimension(3,3) :: om + real(pReal), dimension(3) :: c, s c = cos(eu) @@ -191,17 +243,21 @@ pure function eu2om(eu) result(om) end function eu2om -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief convert euler to axis angle -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- pure function eu2ax(eu) result(ax) + use prec, only: & + dEq0, & + dEq use math, only: & PI implicit none - real(pReal), intent(in), dimension(3) :: eu !< Euler angles in radians - real(pReal), dimension(4) :: ax + real(pReal), intent(in), dimension(3) :: eu + real(pReal), dimension(4) :: ax + real(pReal) :: t, delta, tau, alpha, sigma t = tan(eu(2)*0.5) @@ -211,22 +267,24 @@ pure function eu2ax(eu) result(ax) alpha = merge(PI, 2.0*atan(tau/cos(sigma)), dEq(sigma,PI*0.5_pReal,tol=1.0e-15_pReal)) - if (dEq0(alpha)) then ! return a default identity axis-angle pair + if (dEq0(alpha)) then ! return a default identity axis-angle pair ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ] else - ax(1:3) = -epsijk/tau * [ t*cos(delta), t*sin(delta), sin(sigma) ] ! passive axis-angle pair so a minus sign in front + ax(1:3) = -epsijk/tau * [ t*cos(delta), t*sin(delta), sin(sigma) ] ! passive axis-angle pair so a minus sign in front ax(4) = alpha - if (alpha < 0.0) ax = -ax ! ensure alpha is positive + if (alpha < 0.0) ax = -ax ! ensure alpha is positive end if end function eu2ax -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief Euler angles to Rodrigues vector -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- pure function eu2ro(eu) result(ro) + use prec, only: & + dEq0 use, intrinsic :: IEEE_ARITHMETIC, only: & IEEE_value, & IEEE_positive_inf @@ -234,10 +292,10 @@ pure function eu2ro(eu) result(ro) PI implicit none - real(pReal), intent(in), dimension(3) :: eu !< Euler angles in radians + real(pReal), intent(in), dimension(3) :: eu real(pReal), dimension(4) :: ro - ro = eu2ax(eu) ! convert to axis angle representation + ro = eu2ax(eu) if (ro(4) >= PI) then ro(4) = IEEE_value(ro(4),IEEE_positive_inf) elseif(dEq0(ro(4))) then @@ -249,24 +307,23 @@ pure function eu2ro(eu) result(ro) end function eu2ro -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Euler angles to quaternion -!-------------------------------------------------------------------------- +!> @brief Euler angles to unit quaternion +!--------------------------------------------------------------------------------------------------- pure function eu2qu(eu) result(qu) implicit none - real(pReal), intent(in), dimension(3) :: eu + real(pReal), intent(in), dimension(3) :: eu type(quaternion) :: qu - real(pReal), dimension(3) :: ee - real(pReal) :: cPhi, sPhi + real(pReal), dimension(3) :: ee + real(pReal) :: cPhi, sPhi ee = 0.5_pReal*eu cPhi = cos(ee(2)) sPhi = sin(ee(2)) - ! passive quaternion qu = quaternion([ cPhi*cos(ee(1)+ee(3)), & -epsijk*sPhi*cos(ee(1)-ee(3)), & -epsijk*sPhi*sin(ee(1)-ee(3)), & @@ -276,16 +333,18 @@ pure function eu2qu(eu) result(qu) end function eu2qu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief orientation matrix to euler angles -!-------------------------------------------------------------------------- +!> @brief orientation matrix to Euler angles +!--------------------------------------------------------------------------------------------------- pure function om2eu(om) result(eu) + use prec, only: & + dEq use math, only: & PI implicit none - real(pReal), intent(in), dimension(3,3) :: om !< orientation matrix + real(pReal), intent(in), dimension(3,3) :: om real(pReal), dimension(3) :: eu real(pReal) :: zeta @@ -302,17 +361,20 @@ pure function om2eu(om) result(eu) end function om2eu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Axis angle pair to orientation matrix -!-------------------------------------------------------------------------- +!> @brief convert axis angle pair to orientation matrix +!--------------------------------------------------------------------------------------------------- pure function ax2om(ax) result(om) + use prec, only: & + pInt implicit none real(pReal), intent(in), dimension(4) :: ax - real(pReal), dimension(3,3) :: om !< orientation matrix + real(pReal), dimension(3,3) :: om + real(pReal) :: q, c, s, omc - integer(pInt) :: i + integer(pInt) :: i c = cos(ax(4)) s = sin(ax(4)) @@ -337,18 +399,21 @@ pure function ax2om(ax) result(om) end function ax2om -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Quaternion to Euler angles [Morawiec page 40, with errata !!!! ] -!-------------------------------------------------------------------------- +!> @brief convert unit quaternion to Euler angles +!--------------------------------------------------------------------------------------------------- pure function qu2eu(qu) result(eu) + use prec, only: & + dEq0 use math, only: & PI implicit none - type(quaternion), intent(in) :: qu !< quaternion - real(pReal), dimension(3) :: eu - real(pReal) :: q12, q03, chi, chiInv + type(quaternion), intent(in) :: qu + real(pReal), dimension(3) :: eu + + real(pReal) :: q12, q03, chi, chiInv q03 = qu%w**2+qu%z**2 q12 = qu%x**2+qu%y**2 @@ -369,15 +434,16 @@ pure function qu2eu(qu) result(eu) end function qu2eu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Axis angle pair to homochoric -!-------------------------------------------------------------------------- +!> @brief convert axis angle pair to homochoric +!--------------------------------------------------------------------------------------------------- pure function ax2ho(ax) result(ho) - - real(pReal), intent(in), dimension(4) :: ax !< axis angle in degree/radians? + implicit none + real(pReal), intent(in), dimension(4) :: ax real(pReal), dimension(3) :: ho + real(pReal) :: f f = 0.75 * ( ax(4) - sin(ax(4)) ) @@ -387,16 +453,19 @@ pure function ax2ho(ax) result(ho) end function ax2ho -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Homochoric to axis angle pair -!-------------------------------------------------------------------------- +!> @brief convert homochoric to axis angle pair +!--------------------------------------------------------------------------------------------------- pure function ho2ax(ho) result(ax) - + use prec, only: & + pInt, & + dEq0 implicit none - real(pReal), intent(in), dimension(3) :: ho !< homochoric coordinates + real(pReal), intent(in), dimension(3) :: ho real(pReal), dimension(4) :: ax - integer(pInt) :: i + + integer(pInt) :: i real(pReal) :: hmag_squared, s, hm real(pReal), parameter, dimension(16) :: & tfit = [ 1.0000000000018852_pReal, -0.5000000002194847_pReal, & @@ -427,11 +496,16 @@ pure function ho2ax(ho) result(ax) end function ho2ax -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert orientation matrix to axis angle -!-------------------------------------------------------------------------- +!> @brief convert orientation matrix to axis angle pair +!--------------------------------------------------------------------------------------------------- function om2ax(om) result(ax) + use prec, only: & + pInt, & + dEq0, & + cEq, & + dNeq0 use IO, only: & IO_error use math, only: & @@ -439,13 +513,13 @@ function om2ax(om) result(ax) math_trace33 implicit none - real(pReal), intent(in) :: om(3,3) - real(pReal) :: ax(4) + real(pReal), intent(in) :: om(3,3) + real(pReal) :: ax(4) - real(pReal) :: t - real(pReal), dimension(3) :: Wr, Wi - real(pReal), dimension(10) :: WORK - real(pReal), dimension(3,3) :: VR, devNull, o + real(pReal) :: t + real(pReal), dimension(3) :: Wr, Wi + real(pReal), dimension(10) :: WORK + real(pReal), dimension(3,3) :: VR, devNull, o integer(pInt) :: INFO, LWORK, i external :: dgeev,sgeev @@ -482,18 +556,22 @@ function om2ax(om) result(ax) end function om2ax -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Rodrigues vector to axis angle pair -!-------------------------------------------------------------------------- +!> @brief convert Rodrigues vector to axis angle pair +!--------------------------------------------------------------------------------------------------- pure function ro2ax(ro) result(ax) - use, intrinsic :: IEEE_ARITHMETIC + use, intrinsic :: IEEE_ARITHMETIC, only: & + IEEE_is_finite + use prec, only: & + dEq0 use math, only: & PI implicit none - real(pReal), intent(in), dimension(4) :: ro !< homochoric coordinates + real(pReal), intent(in), dimension(4) :: ro real(pReal), dimension(4) :: ax + real(pReal) :: ta, angle ta = ro(4) @@ -511,18 +589,23 @@ pure function ro2ax(ro) result(ax) end function ro2ax -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert axis angle to Rodrigues -!-------------------------------------------------------------------------- +!> @brief convert axis angle pair to Rodrigues vector +!--------------------------------------------------------------------------------------------------- pure function ax2ro(ax) result(ro) - use, intrinsic :: IEEE_ARITHMETIC + use, intrinsic :: IEEE_ARITHMETIC, only: & + IEEE_value, & + IEEE_positive_inf + use prec, only: & + dEq0 use math, only: & PI implicit none - real(pReal), intent(in), dimension(4) :: ax !< axis angle in degree/radians? + real(pReal), intent(in), dimension(4) :: ax real(pReal), dimension(4) :: ro + real(pReal), parameter :: thr = 1.0E-7 if (dEq0(ax(4))) then @@ -536,16 +619,19 @@ pure function ax2ro(ax) result(ro) end function ax2ro -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert axis angle to quaternion -!-------------------------------------------------------------------------- +!> @brief convert axis angle pair to quaternion +!--------------------------------------------------------------------------------------------------- pure function ax2qu(ax) result(qu) - + use prec, only: & + dEq0 + implicit none - real(pReal), intent(in), dimension(4) :: ax + real(pReal), intent(in), dimension(4) :: ax type(quaternion) :: qu - real(pReal) :: c, s + + real(pReal) :: c, s if (dEq0(ax(4))) then @@ -559,18 +645,22 @@ pure function ax2qu(ax) result(qu) end function ax2qu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert rodrigues to homochoric -!-------------------------------------------------------------------------- +!> @brief convert Rodrigues vector to homochoric +!--------------------------------------------------------------------------------------------------- pure function ro2ho(ro) result(ho) - use, intrinsic :: IEEE_ARITHMETIC + use, intrinsic :: IEEE_ARITHMETIC, only: & + IEEE_is_finite + use prec, only: & + dEq0 use math, only: & PI implicit none real(pReal), intent(in), dimension(4) :: ro real(pReal), dimension(3) :: ho + real(pReal) :: f if (dEq0(norm2(ro(1:3)))) then @@ -583,16 +673,17 @@ pure function ro2ho(ro) result(ho) end function ro2ho -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert a quaternion to a 3x3 matrix -!-------------------------------------------------------------------------- +!> @brief convert unit quaternion to rotation matrix +!--------------------------------------------------------------------------------------------------- pure function qu2om(qu) result(om) implicit none type(quaternion), intent(in) :: qu - real(pReal), dimension(3,3) :: om - real(pReal) :: qq + real(pReal), dimension(3,3) :: om + + real(pReal) :: qq qq = qu%w**2-(qu%x**2 + qu%y**2 + qu%z**2) @@ -613,17 +704,20 @@ pure function qu2om(qu) result(om) end function qu2om -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert a 3x3 rotation matrix to a unit quaternion (see Morawiec, page 37) -!-------------------------------------------------------------------------- +!> @brief convert rotation matrix to a unit quaternion +!--------------------------------------------------------------------------------------------------- function om2qu(om) result(qu) + use prec, only: & + dEq implicit none - real(pReal), intent(in), dimension(3,3) :: om + real(pReal), intent(in), dimension(3,3) :: om type(quaternion) :: qu - real(pReal), dimension(4) :: qu_A - real(pReal), dimension(4) :: s + + real(pReal), dimension(4) :: qu_A + real(pReal), dimension(4) :: s s = [+om(1,1) +om(2,2) +om(3,3) +1.0_pReal, & +om(1,1) -om(2,2) -om(3,3) +1.0_pReal, & @@ -647,18 +741,22 @@ function om2qu(om) result(qu) end function om2qu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert quaternion to axis angle -!-------------------------------------------------------------------------- +!> @brief convert unit quaternion to axis angle pair +!--------------------------------------------------------------------------------------------------- pure function qu2ax(qu) result(ax) + use prec, only: & + dEq0, & + dNeq0 use math, only: & PI implicit none type(quaternion), intent(in) :: qu - real(pReal), dimension(4) :: ax - real(pReal) :: omega, s + real(pReal), dimension(4) :: ax + + real(pReal) :: omega, s omega = 2.0 * acos(qu%w) ! if the angle equals zero, then we return the rotation axis as [001] @@ -674,15 +772,20 @@ pure function qu2ax(qu) result(ax) end function qu2ax -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert quaternion to Rodrigues -!-------------------------------------------------------------------------- +!> @brief convert unit quaternion to Rodrigues vector +!--------------------------------------------------------------------------------------------------- pure function qu2ro(qu) result(ro) - use, intrinsic :: IEEE_ARITHMETIC + use, intrinsic :: IEEE_ARITHMETIC, only: & + IEEE_value, & + IEEE_positive_inf + use prec, only: & + dEq0 type(quaternion), intent(in) :: qu real(pReal), dimension(4) :: ro + real(pReal) :: s real(pReal), parameter :: thr = 1.0e-8_pReal @@ -690,24 +793,27 @@ pure function qu2ro(qu) result(ro) ro = [qu%x, qu%y, qu%z, IEEE_value(ro(4),IEEE_positive_inf)] else s = norm2([qu%x,qu%y,qu%z]) - ro = merge ( [ 0.0_pReal, 0.0_pReal, epsijk, 0.0_pReal] , & + ro = merge ( [ 0.0_pReal, 0.0_pReal, epsijk, 0.0_pReal], & [ qu%x/s, qu%y/s, qu%z/s, tan(acos(qu%w))], & - s < thr) + s < thr) !ToDo: not save (PGI compiler) end if end function qu2ro -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert quaternion to homochoric -!-------------------------------------------------------------------------- +!> @brief convert unit quaternion to homochoric +!--------------------------------------------------------------------------------------------------- pure function qu2ho(qu) result(ho) + use prec, only: & + dEq0 implicit none type(quaternion), intent(in) :: qu - real(pReal), dimension(3) :: ho - real(pReal) :: omega, f + real(pReal), dimension(3) :: ho + + real(pReal) :: omega, f omega = 2.0 * acos(qu%w) @@ -722,12 +828,13 @@ pure function qu2ho(qu) result(ho) end function qu2ho -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief convert homochoric to cubochoric -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- function ho2cu(ho) result(cu) - use Lambert, only: LambertBallToCube + use Lambert, only: & + LambertBallToCube implicit none real(pReal), intent(in), dimension(3) :: ho @@ -738,12 +845,13 @@ function ho2cu(ho) result(cu) end function ho2cu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @brief convert cubochoric to homochoric -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- function cu2ho(cu) result(ho) - use Lambert, only: LambertCubeToBall + use Lambert, only: & + LambertCubeToBall implicit none real(pReal), intent(in), dimension(3) :: cu @@ -753,21 +861,15 @@ function cu2ho(cu) result(ho) end function cu2ho -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- -! and here are a bunch of transformation routines that are derived from the others -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief Rodrigues vector to Euler angles -!-------------------------------------------------------------------------- +!> @brief convert Rodrigues vector to Euler angles +!--------------------------------------------------------------------------------------------------- pure function ro2eu(ro) result(eu) implicit none - real(pReal), intent(in), dimension(4) :: ro !< Rodrigues vector + real(pReal), intent(in), dimension(4) :: ro real(pReal), dimension(3) :: eu eu = om2eu(ro2om(ro)) @@ -775,10 +877,10 @@ pure function ro2eu(ro) result(eu) end function ro2eu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert euler to homochoric -!-------------------------------------------------------------------------- +!> @brief convert Euler angles to homochoric +!--------------------------------------------------------------------------------------------------- pure function eu2ho(eu) result(ho) implicit none @@ -790,10 +892,10 @@ pure function eu2ho(eu) result(ho) end function eu2ho -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert orientation matrix to Rodrigues -!-------------------------------------------------------------------------- +!> @brief convert rotation matrix to Rodrigues vector +!--------------------------------------------------------------------------------------------------- pure function om2ro(om) result(ro) implicit none @@ -805,10 +907,10 @@ pure function om2ro(om) result(ro) end function om2ro -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert orientation matrix to homochoric -!-------------------------------------------------------------------------- +!> @brief convert rotation matrix to homochoric +!--------------------------------------------------------------------------------------------------- function om2ho(om) result(ho) implicit none @@ -820,10 +922,10 @@ function om2ho(om) result(ho) end function om2ho -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert axis angle to euler -!-------------------------------------------------------------------------- +!> @brief convert axis angle pair to Euler angles +!--------------------------------------------------------------------------------------------------- pure function ax2eu(ax) result(eu) implicit none @@ -835,10 +937,10 @@ pure function ax2eu(ax) result(eu) end function ax2eu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert rodrigues to orientation matrix -!-------------------------------------------------------------------------- +!> @brief convert Rodrigues vector to rotation matrix +!--------------------------------------------------------------------------------------------------- pure function ro2om(ro) result(om) implicit none @@ -850,14 +952,14 @@ pure function ro2om(ro) result(om) end function ro2om -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert rodrigues to quaternion -!-------------------------------------------------------------------------- +!> @brief convert Rodrigues vector to unit quaternion +!--------------------------------------------------------------------------------------------------- pure function ro2qu(ro) result(qu) implicit none - real(pReal), intent(in), dimension(4) :: ro + real(pReal), intent(in), dimension(4) :: ro type(quaternion) :: qu qu = ax2qu(ro2ax(ro)) @@ -865,10 +967,10 @@ pure function ro2qu(ro) result(qu) end function ro2qu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert homochoric to euler -!-------------------------------------------------------------------------- +!> @brief convert homochoric to Euler angles +!--------------------------------------------------------------------------------------------------- pure function ho2eu(ho) result(eu) implicit none @@ -880,10 +982,10 @@ pure function ho2eu(ho) result(eu) end function ho2eu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert homochoric to orientation matrix -!-------------------------------------------------------------------------- +!> @brief convert homochoric to rotation matrix +!--------------------------------------------------------------------------------------------------- pure function ho2om(ho) result(om) implicit none @@ -895,10 +997,10 @@ pure function ho2om(ho) result(om) end function ho2om -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert homochoric to Rodrigues -!-------------------------------------------------------------------------- +!> @brief convert homochoric to Rodrigues vector +!--------------------------------------------------------------------------------------------------- pure function ho2ro(ho) result(ro) implicit none @@ -911,14 +1013,14 @@ pure function ho2ro(ho) result(ro) end function ho2ro -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert homochoric to quaternion -!-------------------------------------------------------------------------- +!> @brief convert homochoric to unit quaternion +!--------------------------------------------------------------------------------------------------- pure function ho2qu(ho) result(qu) implicit none - real(pReal), intent(in), dimension(3) :: ho + real(pReal), intent(in), dimension(3) :: ho type(quaternion) :: qu qu = ax2qu(ho2ax(ho)) @@ -926,14 +1028,14 @@ pure function ho2qu(ho) result(qu) end function ho2qu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert euler angles to cubochoric -!-------------------------------------------------------------------------- +!> @brief convert Euler angles to cubochoric +!--------------------------------------------------------------------------------------------------- function eu2cu(eu) result(cu) implicit none - real(pReal), intent(in), dimension(3) :: eu !< Bunge-Euler angles in radians + real(pReal), intent(in), dimension(3) :: eu real(pReal), dimension(3) :: cu cu = ho2cu(eu2ho(eu)) @@ -941,14 +1043,14 @@ function eu2cu(eu) result(cu) end function eu2cu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert orientation matrix to cubochoric -!-------------------------------------------------------------------------- +!> @brief convert rotation matrix to cubochoric +!--------------------------------------------------------------------------------------------------- function om2cu(om) result(cu) implicit none - real(pReal), intent(in), dimension(3,3) :: om !< rotation matrix + real(pReal), intent(in), dimension(3,3) :: om real(pReal), dimension(3) :: cu cu = ho2cu(om2ho(om)) @@ -956,14 +1058,14 @@ function om2cu(om) result(cu) end function om2cu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert axis angle to cubochoric -!-------------------------------------------------------------------------- +!> @brief convert axis angle pair to cubochoric +!--------------------------------------------------------------------------------------------------- function ax2cu(ax) result(cu) implicit none - real(pReal), intent(in), dimension(4) :: ax !< axis angle in degree/radians? + real(pReal), intent(in), dimension(4) :: ax real(pReal), dimension(3) :: cu cu = ho2cu(ax2ho(ax)) @@ -971,14 +1073,14 @@ function ax2cu(ax) result(cu) end function ax2cu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert Rodrigues to cubochoric -!-------------------------------------------------------------------------- +!> @brief convert Rodrigues vector to cubochoric +!--------------------------------------------------------------------------------------------------- function ro2cu(ro) result(cu) implicit none - real(pReal), intent(in), dimension(4) :: ro !< Rodrigues vector + real(pReal), intent(in), dimension(4) :: ro real(pReal), dimension(3) :: cu cu = ho2cu(ro2ho(ro)) @@ -986,29 +1088,29 @@ function ro2cu(ro) result(cu) end function ro2cu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert quaternion to cubochoric -!-------------------------------------------------------------------------- +!> @brief convert unit quaternion to cubochoric +!--------------------------------------------------------------------------------------------------- function qu2cu(qu) result(cu) implicit none - type(quaternion), intent(in) :: qu ! unit quaternion - real(pReal), dimension(3) :: cu + type(quaternion), intent(in) :: qu + real(pReal), dimension(3) :: cu cu = ho2cu(qu2ho(qu)) end function qu2cu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert cubochoric to euler angles -!-------------------------------------------------------------------------- +!> @brief convert cubochoric to Euler angles +!--------------------------------------------------------------------------------------------------- function cu2eu(cu) result(eu) implicit none - real(pReal), intent(in), dimension(3) :: cu ! cubochoric? + real(pReal), intent(in), dimension(3) :: cu real(pReal), dimension(3) :: eu eu = ho2eu(cu2ho(cu)) @@ -1016,14 +1118,14 @@ function cu2eu(cu) result(eu) end function cu2eu -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert cubochoric to orientation matrix -!-------------------------------------------------------------------------- +!> @brief convert cubochoric to rotation matrix +!--------------------------------------------------------------------------------------------------- function cu2om(cu) result(om) implicit none - real(pReal), intent(in), dimension(3) :: cu ! cubochoric? + real(pReal), intent(in), dimension(3) :: cu real(pReal), dimension(3,3) :: om om = ho2om(cu2ho(cu)) @@ -1031,14 +1133,14 @@ function cu2om(cu) result(om) end function cu2om -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert cubochoric to axis angle -!-------------------------------------------------------------------------- +!> @brief convert cubochoric to axis angle pair +!--------------------------------------------------------------------------------------------------- function cu2ax(cu) result(ax) implicit none - real(pReal), intent(in), dimension(3) :: cu ! cubochoric? + real(pReal), intent(in), dimension(3) :: cu real(pReal), dimension(4) :: ax ax = ho2ax(cu2ho(cu)) @@ -1046,14 +1148,14 @@ function cu2ax(cu) result(ax) end function cu2ax -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert cubochoric to Rodrigues -!-------------------------------------------------------------------------- +!> @brief convert cubochoric to Rodrigues vector +!--------------------------------------------------------------------------------------------------- function cu2ro(cu) result(ro) implicit none - real(pReal), intent(in), dimension(3) :: cu ! cubochoric? + real(pReal), intent(in), dimension(3) :: cu real(pReal), dimension(4) :: ro ro = ho2ro(cu2ho(cu)) @@ -1061,15 +1163,15 @@ function cu2ro(cu) result(ro) end function cu2ro -!-------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief convert cubochoric to quaternion -!-------------------------------------------------------------------------- +!> @brief convert cubochoric to unit quaternion +!--------------------------------------------------------------------------------------------------- function cu2qu(cu) result(qu) implicit none - real(pReal), intent(in), dimension(3) :: cu ! cubochoric? - type(quaternion) :: qu ! cubochoric? + real(pReal), intent(in), dimension(3) :: cu + type(quaternion) :: qu qu = ho2qu(cu2ho(cu)) From 9d25d677e6695e6f532cef4835dadceb0b533cf0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 10:11:46 +0100 Subject: [PATCH 087/309] using new orientation class not sure if transpose is needed for initialization --- src/crystallite.f90 | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 45aca46d1..a9126015d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -9,6 +9,11 @@ !-------------------------------------------------------------------------------------------------- module crystallite + use prec, only: & + pReal, & + pInt + use orientations, only: & + orientation use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -16,9 +21,7 @@ module crystallite mesh_element use material, only: & homogenization_Ngrains - use prec, only: & - pReal, & - pInt + implicit none @@ -42,6 +45,9 @@ module crystallite crystallite_Tstar_v, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) ToDo: Should be called S, 3x3 crystallite_Tstar0_v, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc ToDo: Should be called S, 3x3 crystallite_partionedTstar0_v !< 2nd Piola-Kirchhoff stress vector at start of homog inc ToDo: Should be called S, 3x3 + type(orientation), dimension(:,:,:), allocatable, private :: & + crystallite_ori, & !< orientation as quaternion + crystallite_ori0 !< initial orientation as quaternion real(pReal), dimension(:,:,:,:), allocatable, private :: & crystallite_orientation, & !< orientation as quaternion crystallite_orientation0, & !< initial orientation as quaternion @@ -239,6 +245,8 @@ subroutine crystallite_init allocate(crystallite_subStep(cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_orientation(4,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_orientation0(4,cMax,iMax,eMax), source=0.0_pReal) + allocate(crystallite_ori(cMax,iMax,eMax)) + !allocate(crystallite_ori0(cMax,iMax,eMax)) allocate(crystallite_rotation(4,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_localPlasticity(cMax,iMax,eMax), source=.true.) allocate(crystallite_requested(cMax,iMax,eMax), source=.false.) @@ -900,6 +908,7 @@ subroutine crystallite_orientations do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do c = 1_pInt,homogenization_Ngrains(mesh_element(3,e)) + call crystallite_ori(c,i,e)%fromRotationMatrix(transpose(math_rotationalPart33(crystallite_Fe(1:3,1:3,c,i,e)))) crystallite_orientation(1:4,c,i,e) = math_RtoQ(transpose(math_rotationalPart33(crystallite_Fe(1:3,1:3,c,i,e)))) crystallite_rotation(1:4,c,i,e) = lattice_qDisorientation(crystallite_orientation0(1:4,c,i,e), &! active rotation from initial crystallite_orientation(1:4,c,i,e)) ! to current orientation (with no symmetry) @@ -1020,7 +1029,7 @@ function crystallite_postResults(ipc, ip, el) / real(homogenization_Ngrains(mesh_element(3,el)),pReal) ! grain volume (not fraction but absolute) case (orientation_ID) mySize = 4_pInt - crystallite_postResults(c+1:c+mySize) = crystallite_orientation(1:4,ipc,ip,el) ! grain orientation as quaternion + crystallite_postResults(c+1:c+mySize) = crystallite_ori(ipc,ip,el)%asQuaternion() case (eulerangles_ID) mySize = 3_pInt crystallite_postResults(c+1:c+mySize) = inDeg & From 11a509970b8870736f816b90a721ed399323972d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 10:17:20 +0100 Subject: [PATCH 088/309] some comments --- python/damask/orientation.py | 3 ++- src/quaternions.f90 | 3 ++- src/rotations.f90 | 10 ++++++++++ 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 63880a3e6..6a2685a2b 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -20,7 +20,8 @@ class Quaternion: Convention 4: Euler angle triplets are implemented using the Bunge convention, with the angular ranges as [0, 2π],[0, π],[0, 2π] Convention 5: the rotation angle ω is limited to the interval [0, π] - + Convention 6: P = 1 (as default) + w is the real part, (x, y, z) are the imaginary parts. Vector "a" (defined in coordinate system "A") is passively rotated diff --git a/src/quaternions.f90 b/src/quaternions.f90 index b0dd37291..b3a92ffdf 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -31,6 +31,7 @@ !> @author Marc De Graef, Carnegie Mellon University !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief general quaternion math, not limited to unit quaternions +!> @details w is the real part, (x, y, z) are the imaginary parts. !--------------------------------------------------------------------------------------------------- module quaternions use prec, only: & @@ -39,7 +40,7 @@ module quaternions implicit none public - real(pReal), parameter, public :: epsijk = -1.0_pReal !< parameter for orientation conversion. ToDo: Better place? + real(pReal), parameter, public :: epsijk = -1.0_pReal !< parameter for orientation conversion. type, public :: quaternion real(pReal) :: w = 0.0_pReal diff --git a/src/rotations.f90 b/src/rotations.f90 index e58963dea..a0e6e9250 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -33,6 +33,16 @@ !> @brief rotation storage and conversion !> @details: rotation is internally stored as quaternion. It cabe inialized from different !> represantations and also returns itself in different representations. +! +! All methods and naming conventions based on Rowenhorst_etal2015 +! Convention 1: coordinate frames are right-handed +! Convention 2: a rotation angle ω is taken to be positive for a counterclockwise rotation +! when viewing from the end point of the rotation axis towards the origin +! Convention 3: rotations will be interpreted in the passive sense +! Convention 4: Euler angle triplets are implemented using the Bunge convention, +! with the angular ranges as [0, 2π],[0, π],[0, 2π] +! Convention 5: the rotation angle ω is limited to the interval [0, π] +! Convention 6: epsijk/P = -1 !--------------------------------------------------------------------------------------------------- module rotations From 06f67ce500aa77c9f965ac2558b853a4b409c12a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 10:24:10 +0100 Subject: [PATCH 089/309] orientations module was not compiled but is needed now --- src/commercialFEM_fileList.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 353ca1497..a5d633e83 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -14,6 +14,7 @@ #include "quaternions.f90" #include "Lambert.f90" #include "rotations.f90" +#include "orientations.f90" #include "FEsolving.f90" #include "mesh.f90" #include "material.f90" From b87a09a46698faf233c1dbbea4c896fd929a5f36 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 11:22:06 +0100 Subject: [PATCH 090/309] not needed --- src/mesh_abaqus.f90 | 5 +---- src/mesh_marc.f90 | 5 +---- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 8c93a899a..98bdda4ef 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -746,10 +746,7 @@ subroutine mesh_build_ipVolumes integer(pInt) :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - if (.not. allocated(mesh_ipVolume)) then - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) - mesh_ipVolume = 0.0_pReal - endif + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) do e = 1_pInt,mesh_NcpElems ! loop over cpElems diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 7deb14fff..2cca47239 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -730,10 +730,7 @@ subroutine mesh_build_ipVolumes integer(pInt) :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - if (.not. allocated(mesh_ipVolume)) then - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) - mesh_ipVolume = 0.0_pReal - endif + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) do e = 1_pInt,mesh_NcpElems ! loop over cpElems From 5f8b110f63cd69dcaea26d239ab35e2d51bc4107 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 12:24:23 +0100 Subject: [PATCH 091/309] initialize mesh and element --- src/mesh_abaqus.f90 | 109 +++++--------------------------------------- src/mesh_base.f90 | 20 +++++++- src/mesh_grid.f90 | 86 +++++++++++----------------------- src/mesh_marc.f90 | 17 +++++-- 4 files changed, 70 insertions(+), 162 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 98bdda4ef..62ece4c93 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -389,7 +389,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_abaqus_build_elements - type, public, extends(tMesh) :: tMesh_Abaqus + type, public, extends(tMesh) :: tMesh_abaqus integer(pInt):: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) @@ -406,16 +406,22 @@ integer(pInt), dimension(:,:), allocatable, private :: & logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information contains - procedure :: init=>tMesh_abaqus_init - end type tMesh_Abaqus + procedure, pass(self) :: tMesh_abaqus_init + generic, public :: init => tMesh_abaqus_init + end type tMesh_abaqus - type(tMesh_Abaqus), public, protected :: theMesh + type(tMesh_abaqus), public, protected :: theMesh contains -subroutine tMesh_abaqus_init(self) +subroutine tMesh_abaqus_init(self,elemType,nodes) + implicit none class(tMesh_abaqus) :: self + real(pReal), dimension(:,:), intent(in) :: nodes + integer(pInt), intent(in) :: elemType + + call self%tMesh%init('mesh',elemType,nodes) end subroutine tMesh_abaqus_init @@ -537,7 +543,7 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%init(mesh_element(2,1),mesh_node0) contains !-------------------------------------------------------------------------------------------------- !> @brief check if the input file for Abaqus contains part info @@ -859,97 +865,6 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates - -!-------------------------------------------------------------------------------------------------- -!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) -!-------------------------------------------------------------------------------------------------- -function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) - use debug, only: & - debug_mesh, & - debug_level, & - debug_levelBasic - use math, only: & - math_mul33x3 - - implicit none - real(pReal), intent(in), dimension(:,:,:,:) :: & - centres - real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: & - nodes - real(pReal), intent(in), dimension(3) :: & - gDim - real(pReal), intent(in), dimension(3,3) :: & - Favg - real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: & - wrappedCentres - - integer(pInt) :: & - i,j,k,n - integer(pInt), dimension(3), parameter :: & - diag = 1_pInt - integer(pInt), dimension(3) :: & - shift = 0_pInt, & - lookup = 0_pInt, & - me = 0_pInt, & - iRes = 0_pInt - integer(pInt), dimension(3,8) :: & - neighbor = reshape([ & - 0_pInt, 0_pInt, 0_pInt, & - 1_pInt, 0_pInt, 0_pInt, & - 1_pInt, 1_pInt, 0_pInt, & - 0_pInt, 1_pInt, 0_pInt, & - 0_pInt, 0_pInt, 1_pInt, & - 1_pInt, 0_pInt, 1_pInt, & - 1_pInt, 1_pInt, 1_pInt, & - 0_pInt, 1_pInt, 1_pInt ], [3,8]) - -!-------------------------------------------------------------------------------------------------- -! initializing variables - iRes = [size(centres,2),size(centres,3),size(centres,4)] - nodes = 0.0_pReal - wrappedCentres = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! report - if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then - write(6,'(a)') ' Meshing cubes around centroids' - write(6,'(a,3(e12.5))') ' Dimension: ', gDim - write(6,'(a,3(i5))') ' Resolution:', iRes - endif - -!-------------------------------------------------------------------------------------------------- -! building wrappedCentres = centroids + ghosts - wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres - do k = 0_pInt,iRes(3)+1_pInt - do j = 0_pInt,iRes(2)+1_pInt - do i = 0_pInt,iRes(1)+1_pInt - if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin - j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin - i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin - me = [i,j,k] ! me on skin - shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me) - lookup = me-diag+shift*iRes - wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = & - centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) & - - math_mul33x3(Favg, real(shift,pReal)*gDim) - endif - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! averaging - do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) - do n = 1_pInt,8_pInt - nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = & - nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), & - j+1_pInt+neighbor(2,n), & - k+1_pInt+neighbor(3,n) ) - enddo - enddo; enddo; enddo - nodes = nodes/8.0_pReal - -end function mesh_nodesAroundCentres - - !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of nodes and elements in mesh and stores them in !! 'mesh_Nelems' and 'mesh_Nnodes' diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index 477fc3aed..f9a076f03 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -29,7 +29,7 @@ module mesh_base node !< node x,y,z coordinates (deformed) integer(pInt), dimension(:,:), allocatable, public :: & cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID - character(pStringLen) :: solver = "undefined" + character(pStringLen) :: type = "n/a" integer(pInt) :: & Nnodes, & !< total number of nodes in mesh Nelems = -1_pInt, & @@ -43,6 +43,24 @@ module mesh_base microstructureAt integer(pInt), dimension(:,:), allocatable, public :: & connectivity + contains + procedure, pass(self) :: tMesh_base_init + generic, public :: init => tMesh_base_init end type tMesh +contains +subroutine tMesh_base_init(self,meshType,elemType,nodes) + + implicit none + class(tMesh) :: self + character(len=*), intent(in) :: meshType + integer(pInt), intent(in) :: elemType + real(pReal), dimension(:,:), intent(in) :: nodes + + self%type = meshType + call self%elem%init(elemType) + self%node0 = nodes + +end subroutine tMesh_base_init + end module mesh_base diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index a2a041955..cff0dbc21 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -270,14 +270,11 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_init, & mesh_cellCenterCoordinates - private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & mesh_build_FEdata, & mesh_spectral_getHomogenization, & - mesh_spectral_count, & - mesh_spectral_count_cpSizes, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & @@ -302,19 +299,21 @@ integer(pInt), dimension(:,:), allocatable, private :: & size3offset contains - procedure :: init => tMesh_grid_init + procedure, pass(self) :: tMesh_grid_init + generic, public :: init => tMesh_grid_init end type tMesh_grid type(tMesh_grid), public, protected :: theMesh contains -subroutine tMesh_grid_init(self) +subroutine tMesh_grid_init(self,nodes) implicit none class(tMesh_grid) :: self + real(pReal), dimension(:,:), intent(in) :: nodes - call self%elem%init(10_pInt) + call self%tMesh%init('grid',10_pInt,nodes) end subroutine tMesh_grid_init @@ -364,7 +363,8 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - call theMesh%init + + call mesh_build_FEdata ! get properties of the different types of elements mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh @@ -389,13 +389,23 @@ subroutine mesh_init(ip,el) grid3Offset = int(local_K_offset,pInt) size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) - if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) - call mesh_spectral_count() - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_spectral_count_cpSizes - if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) + mesh_NcpElems= product(grid(1:2))*grid3 + mesh_NcpElemsGlobal = product(grid) + + mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) + call mesh_spectral_build_nodes() + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call theMesh%init(mesh_node) + ! For compatibility + + mesh_maxNips = theMesh%elem%nIPs + mesh_maxNipNeighbors = theMesh%elem%nIPneighbors + mesh_maxNcellnodes = theMesh%elem%Ncellnodes + + + call mesh_spectral_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_build_cellconnectivity @@ -434,8 +444,6 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - - end subroutine mesh_init @@ -563,10 +571,9 @@ subroutine mesh_build_ipVolumes integer(pInt) :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - if (.not. allocated(mesh_ipVolume)) then - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) - mesh_ipVolume = 0.0_pReal - endif + + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) do e = 1_pInt,mesh_NcpElems ! loop over cpElems @@ -894,43 +901,6 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) end function mesh_spectral_getHomogenization -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count() - - implicit none - - mesh_NcpElems= product(grid(1:2))*grid3 - mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) - - mesh_NcpElemsGlobal = product(grid) - -end subroutine mesh_spectral_count - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count_cpSizes - - implicit none - integer(pInt) :: t,g,c - - t = 10_pInt - g = FE_geomtype(t) - c = FE_celltype(g) - - mesh_maxNips = FE_Nips(g) - mesh_maxNipNeighbors = FE_NipNeighbors(c) - mesh_maxNcellnodes = FE_Ncellnodes(g) - -end subroutine mesh_spectral_count_cpSizes - - !-------------------------------------------------------------------------------------------------- !> @brief Store x,y,z coordinates of all nodes in mesh. !! Allocates global arrays 'mesh_node0' and 'mesh_node' @@ -941,7 +911,6 @@ subroutine mesh_spectral_build_nodes() integer(pInt) :: n allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) - allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) forall (n = 0_pInt:mesh_Nnodes-1_pInt) mesh_node0(1,n+1_pInt) = mesh_unitlength * & @@ -986,7 +955,6 @@ subroutine mesh_spectral_build_elements(fileUnit) headerLength = 0_pInt, & maxDataPerLine, & homog, & - elemType, & elemOffset integer(pInt), dimension(:), allocatable :: & microstructures, & @@ -1047,13 +1015,13 @@ subroutine mesh_spectral_build_elements(fileUnit) enddo enddo - elemType = 10_pInt + elemOffset = product(grid(1:2))*grid3Offset e = 0_pInt do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) e = e+1_pInt ! valid element entry mesh_element( 1,e) = -1_pInt ! DEPRECATED - mesh_element( 2,e) = elemType ! elem type + mesh_element( 2,e) = 10_pInt mesh_element( 3,e) = homog ! homogenization mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 2cca47239..5607791fb 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -417,8 +417,9 @@ type, public, extends(tMesh) :: tMesh_marc integer(pInt), dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet - contains - procedure :: init => tMesh_marc_init + contains + procedure, pass(self) :: tMesh_marc_init + generic, public :: init => tMesh_marc_init end type tMesh_marc type(tMesh_marc), public, protected :: theMesh @@ -426,10 +427,15 @@ end type tMesh_marc contains -subroutine tMesh_marc_init(self) +subroutine tMesh_marc_init(self,elemType,nodes) + implicit none class(tMesh_marc) :: self - + real(pReal), dimension(:,:), intent(in) :: nodes + integer(pInt), intent(in) :: elemType + + call self%tMesh%init('mesh',elemType,nodes) + end subroutine tMesh_marc_init !-------------------------------------------------------------------------------------------------- @@ -553,7 +559,8 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%init(mesh_element(2,1),mesh_node0) + end subroutine mesh_init From 614a8d694cbbd2442dcc83f14f97270e2f8e82cd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 12:28:18 +0100 Subject: [PATCH 092/309] re-implement mesh reporting later on in mesh_base --- src/mesh_abaqus.f90 | 132 -------------------------------------------- 1 file changed, 132 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 62ece4c93..159f2a7f6 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -369,7 +369,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_tell_statistics, & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & @@ -516,10 +515,6 @@ subroutine mesh_init(ip,el) call mesh_build_ipNeighborhood if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (worldrank == 0_pInt) then - call mesh_tell_statistics - endif - if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements if (debug_e < 1 .or. debug_e > mesh_NcpElems) & @@ -1974,133 +1969,6 @@ subroutine mesh_build_ipNeighborhood end subroutine mesh_build_ipNeighborhood - -!-------------------------------------------------------------------------------------------------- -!> @brief write statistics regarding input file parsing to the output file -!-------------------------------------------------------------------------------------------------- -subroutine mesh_tell_statistics - use math, only: & - math_range - use IO, only: & - IO_error - use debug, only: & - debug_level, & - debug_MESH, & - debug_LEVELBASIC, & - debug_LEVELEXTENSIVE, & - debug_LEVELSELECTIVE, & - debug_e, & - debug_i - - implicit none - integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro - character(len=64) :: myFmt - integer(pInt) :: i,e,n,f,t,g,c, myDebug - - myDebug = debug_level(debug_mesh) - - if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified - if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified - - allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) - do e = 1_pInt,mesh_NcpElems - if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified - if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure - enddo -!$OMP CRITICAL (write2out) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - write(6,'(/,a,/)') ' Input Parser: STATISTICS' - write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' - write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' - write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' - write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' - write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' - write(6,*) - write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) - write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations - write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures - enddo - write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' - write(6,*) 'periodic surface : ', mesh_periodicSurface - write(6,*) - flush(6) - endif - - if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' - write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get elemType - g = FE_geomtype(t) ! get elemGeomType - c = FE_celltype(g) ! get cellType - write(6,'(i8,3(1x,i8))') e,t,g,c - enddo - write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' - write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) - write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) - do f = 1_pInt,FE_NipNeighbors(c) - write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) - enddo - enddo - enddo - write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' - write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i2)') e,i - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell - write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & - mesh_cellnode(1:3,mesh_cell(n,i,e)) - enddo - enddo - enddo - write(6,'(/,a)') 'Input Parser: IP COORDINATES' - write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) - enddo - enddo - write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' - write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP - write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) - enddo - enddo - enddo - endif -!$OMP END CRITICAL (write2out) - -end subroutine mesh_tell_statistics - - !-------------------------------------------------------------------------------------------------- !> @brief mapping of FE element types to internal representation !-------------------------------------------------------------------------------------------------- From 8e0556fe3e8cdd0fdb685b88c017e65ec32592c0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 12:43:14 +0100 Subject: [PATCH 093/309] [skip ci] nicer reporting --- src/element.f90 | 28 ++++++++++------------------ src/mesh_base.f90 | 7 ++++++- 2 files changed, 16 insertions(+), 19 deletions(-) diff --git a/src/element.f90 b/src/element.f90 index 4c0f1e810..473d9c73c 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -904,26 +904,18 @@ contains self%nIPneighbors = size(self%IPneighbor,1) - write(6,*) 'tElement_init' - - write(6,*)'elemType ',self%elemType - write(6,*)'geomType ',self%geomType - write(6,*)'cellType ',self%cellType - write(6,*)'Nnodes ',self%Nnodes - write(6,*)'Ncellnodes ',self%Ncellnodes - write(6,*)'NcellnodesPerCell ',self%NcellnodesPerCell - write(6,*)'nIPs ',self%nIPs - write(6,*)'nIPneighbors ',self%nIPneighbors - write(6,*)'maxNnodeAtIP ',self%maxNnodeAtIP - write(6,*)'Cell ',self%Cell - write(6,*)'NnodeAtIP ',self%NnodeAtIP - write(6,*)'IPneighbor ',self%IPneighbor - write(6,*)'cellFace ',self%cellFace - write(6,*)'cellNodeParentNodeWeights',self%cellNodeParentNodeWeights + write(6,'(/,a)') ' <<<+- element_init -+>>>' + write(6,*)' element type ',self%elemType + write(6,*)' geom type ',self%geomType + write(6,*)' cell type ',self%cellType + write(6,*)' # node ',self%Nnodes + write(6,*)' # IP ',self%nIPs + write(6,*)' # cellnode ',self%Ncellnodes + write(6,*)' # cellnode/cell ',self%NcellnodesPerCell + write(6,*)' # IP neighbor ',self%nIPneighbors + write(6,*)' max # node at IP ',self%maxNnodeAtIP end subroutine tElement_init - - end module element diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index f9a076f03..e0ca78c03 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -57,10 +57,15 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes) integer(pInt), intent(in) :: elemType real(pReal), dimension(:,:), intent(in) :: nodes + write(6,'(/,a)') ' <<<+- mesh_base_init -+>>>' + + write(6,*)' mesh type ',meshType + write(6,*)' # node ',size(nodes,2) + self%type = meshType call self%elem%init(elemType) self%node0 = nodes - + end subroutine tMesh_base_init end module mesh_base From e6fe312f853451995e778b4c32304fe15b245541 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 1 Feb 2019 14:04:55 +0100 Subject: [PATCH 094/309] Corrected documented value for P (= -1!). Instead of repeating the assignment P=-1 in multiple internal functions, it might be advisable to define a class-wide parameter? --- python/damask/orientation.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 6a2685a2b..29ecaf626 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -20,7 +20,7 @@ class Quaternion: Convention 4: Euler angle triplets are implemented using the Bunge convention, with the angular ranges as [0, 2π],[0, π],[0, 2π] Convention 5: the rotation angle ω is limited to the interval [0, π] - Convention 6: P = 1 (as default) + Convention 6: P = -1 (as default) w is the real part, (x, y, z) are the imaginary parts. From 0c1c40f1de8d3e862591f588787d0c775ab024a8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 16:43:34 +0100 Subject: [PATCH 095/309] don't use euler angles any more updated test --- PRIVATE | 2 +- examples/ConfigFiles/Crystallite_All.config | 1 - examples/SpectralMethod/Polycrystal/material.config | 1 - 3 files changed, 1 insertion(+), 3 deletions(-) diff --git a/PRIVATE b/PRIVATE index beb9682ff..25006bc97 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b +Subproject commit 25006bc974b752faf3464b082511590d50093c37 diff --git a/examples/ConfigFiles/Crystallite_All.config b/examples/ConfigFiles/Crystallite_All.config index d46c3e0e6..ab4b63de4 100644 --- a/examples/ConfigFiles/Crystallite_All.config +++ b/examples/ConfigFiles/Crystallite_All.config @@ -3,7 +3,6 @@ (output) texture (output) volume (output) orientation # quaternion -(output) eulerangles # orientation as Bunge triple in degree (output) grainrotation # deviation from initial orientation as axis (1-3) and angle in degree (4) in crystal reference coordinates (output) f # deformation gradient tensor (output) fe # elastic deformation gradient tensor diff --git a/examples/SpectralMethod/Polycrystal/material.config b/examples/SpectralMethod/Polycrystal/material.config index 93a5a6710..39e7f1952 100644 --- a/examples/SpectralMethod/Polycrystal/material.config +++ b/examples/SpectralMethod/Polycrystal/material.config @@ -13,7 +13,6 @@ mech none (output) texture (output) volume (output) orientation # quaternion -(output) eulerangles # orientation as Bunge triple (output) grainrotation # deviation from initial orientation as axis (1-3) and angle in degree (4) (output) f # deformation gradient tensor; synonyms: "defgrad" (output) fe # elastic deformation gradient tensor From 407f94082fb845682d7d18c5ff7d9dae27f2d513 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 16:52:42 +0100 Subject: [PATCH 096/309] no need for orientation class at the moment implement only if we need symmetry aware operations --- src/CMakeLists.txt | 8 ++----- src/commercialFEM_fileList.f90 | 1 - src/crystallite.f90 | 6 +++--- src/orientations.f90 | 39 ---------------------------------- 4 files changed, 5 insertions(+), 49 deletions(-) delete mode 100644 src/orientations.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index d1af42911..37913b6df 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -69,18 +69,14 @@ add_library(ROTATIONS OBJECT "rotations.f90") add_dependencies(ROTATIONS LAMBERT QUATERNIONS) list(APPEND OBJECTFILES $) -add_library(ORIENTATIONS OBJECT "orientations.f90") -add_dependencies(ORIENTATIONS ROTATIONS) -list(APPEND OBJECTFILES $) - # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh.f90") - add_dependencies(MESH ORIENTATIONS FEsolving) + add_dependencies(MESH ROTATIONS FEsolving) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") - add_dependencies(FEZoo ORIENTATIONS FEsolving) + add_dependencies(FEZoo ROTATIONS FEsolving) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "meshFEM.f90") add_dependencies(MESH FEZoo) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index a5d633e83..353ca1497 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -14,7 +14,6 @@ #include "quaternions.f90" #include "Lambert.f90" #include "rotations.f90" -#include "orientations.f90" #include "FEsolving.f90" #include "mesh.f90" #include "material.f90" diff --git a/src/crystallite.f90 b/src/crystallite.f90 index a9126015d..e2f05284e 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -12,8 +12,8 @@ module crystallite use prec, only: & pReal, & pInt - use orientations, only: & - orientation + use rotations, only: & + rotation use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -45,7 +45,7 @@ module crystallite crystallite_Tstar_v, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) ToDo: Should be called S, 3x3 crystallite_Tstar0_v, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc ToDo: Should be called S, 3x3 crystallite_partionedTstar0_v !< 2nd Piola-Kirchhoff stress vector at start of homog inc ToDo: Should be called S, 3x3 - type(orientation), dimension(:,:,:), allocatable, private :: & + type(rotation), dimension(:,:,:), allocatable, private :: & crystallite_ori, & !< orientation as quaternion crystallite_ori0 !< initial orientation as quaternion real(pReal), dimension(:,:,:,:), allocatable, private :: & diff --git a/src/orientations.f90 b/src/orientations.f90 deleted file mode 100644 index 285492729..000000000 --- a/src/orientations.f90 +++ /dev/null @@ -1,39 +0,0 @@ -!--------------------------------------------------------------------------------------------------- -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief orientation storage -!> @details: orientation = rotation + symmetry -!--------------------------------------------------------------------------------------------------- - -module orientations - use rotations - use prec, only: & - pStringLen - - implicit none - type, extends(rotation), public :: orientation - character(len=pStringLen) :: sym = 'none' - end type orientation - - interface orientation - module procedure :: orientation_init - end interface orientation - -contains - -type(orientation) function orientation_init(sym,eu,ax,om,qu,cu,ho,ro) - use prec - implicit none - character(len=pStringLen), intent(in), optional :: sym - real(pReal), intent(in), optional, dimension(3) :: eu, cu, ho - real(pReal), intent(in), optional, dimension(4) :: ax, qu, ro - real(pReal), intent(in), optional, dimension(3,3) :: om - - if (present(sym)) orientation_init%sym = sym - - if (present(om)) then - call orientation_init%fromRotationMatrix(om) - endif - -end function orientation_init - -end module From feb87c7db846ae29cb55e5617589207b4f229207 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 19:09:17 +0100 Subject: [PATCH 097/309] same name as in the python module --- src/quaternions.f90 | 8 ++++---- src/rotations.f90 | 36 ++++++++++++++++++------------------ 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/quaternions.f90 b/src/quaternions.f90 index b3a92ffdf..17f943aa6 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -40,7 +40,7 @@ module quaternions implicit none public - real(pReal), parameter, public :: epsijk = -1.0_pReal !< parameter for orientation conversion. + real(pReal), parameter, public :: P = -1.0_pReal !< parameter for orientation conversion. type, public :: quaternion real(pReal) :: w = 0.0_pReal @@ -241,9 +241,9 @@ type(quaternion) elemental function mul_quat__(self,other) class(quaternion), intent(in) :: self, other mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z - mul_quat__%x = self%w*other%x + self%x*other%w + epsijk * (self%y*other%z - self%z*other%y) - mul_quat__%y = self%w*other%y + self%y*other%w + epsijk * (self%z*other%x - self%x*other%z) - mul_quat__%z = self%w*other%z + self%z*other%w + epsijk * (self%x*other%y - self%y*other%x) + mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y) + mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z) + mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x) end function mul_quat__ diff --git a/src/rotations.f90 b/src/rotations.f90 index a0e6e9250..4ccea592b 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -42,7 +42,7 @@ ! Convention 4: Euler angle triplets are implemented using the Bunge convention, ! with the angular ranges as [0, 2π],[0, π],[0, 2π] ! Convention 5: the rotation angle ω is limited to the interval [0, π] -! Convention 6: epsijk/P = -1 +! Convention 6: P = -1 !--------------------------------------------------------------------------------------------------- module rotations @@ -280,7 +280,7 @@ pure function eu2ax(eu) result(ax) if (dEq0(alpha)) then ! return a default identity axis-angle pair ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ] else - ax(1:3) = -epsijk/tau * [ t*cos(delta), t*sin(delta), sin(sigma) ] ! passive axis-angle pair so a minus sign in front + ax(1:3) = -P/tau * [ t*cos(delta), t*sin(delta), sin(sigma) ] ! passive axis-angle pair so a minus sign in front ax(4) = alpha if (alpha < 0.0) ax = -ax ! ensure alpha is positive end if @@ -309,7 +309,7 @@ pure function eu2ro(eu) result(ro) if (ro(4) >= PI) then ro(4) = IEEE_value(ro(4),IEEE_positive_inf) elseif(dEq0(ro(4))) then - ro = [ 0.0_pReal, 0.0_pReal, epsijk, 0.0_pReal ] + ro = [ 0.0_pReal, 0.0_pReal, P, 0.0_pReal ] else ro(4) = tan(ro(4)*0.5) end if @@ -334,10 +334,10 @@ pure function eu2qu(eu) result(qu) cPhi = cos(ee(2)) sPhi = sin(ee(2)) - qu = quaternion([ cPhi*cos(ee(1)+ee(3)), & - -epsijk*sPhi*cos(ee(1)-ee(3)), & - -epsijk*sPhi*sin(ee(1)-ee(3)), & - -epsijk*cPhi*sin(ee(1)+ee(3))]) + qu = quaternion([ cPhi*cos(ee(1)+ee(3)), & + -P*sPhi*cos(ee(1)-ee(3)), & + -P*sPhi*sin(ee(1)-ee(3)), & + -P*cPhi*sin(ee(1)+ee(3))]) if(qu%w < 0.0_pReal) qu = qu%homomorphed() end function eu2qu @@ -404,7 +404,7 @@ pure function ax2om(ax) result(om) om(3,1) = q + s*ax(2) om(1,3) = q - s*ax(2) - if (epsijk > 0.0) om = transpose(om) + if (P > 0.0) om = transpose(om) end function ax2om @@ -430,14 +430,14 @@ pure function qu2eu(qu) result(eu) chi = sqrt(q03*q12) degenerated: if (dEq0(chi)) then - eu = merge([atan2(-epsijk*2.0*qu%w*qu%z,qu%w**2-qu%z**2), 0.0_pReal, 0.0_pReal], & - [atan2(2.0*qu%x*qu%y,qu%x**2-qu%y**2), PI, 0.0_pReal], & + eu = merge([atan2(-P*2.0*qu%w*qu%z,qu%w**2-qu%z**2), 0.0_pReal, 0.0_pReal], & + [atan2(2.0*qu%x*qu%y,qu%x**2-qu%y**2), PI, 0.0_pReal], & dEq0(q12)) else degenerated chiInv = 1.0/chi - eu = [atan2((-epsijk*qu%w*qu%y+qu%x*qu%z)*chi, (-epsijk*qu%w*qu%x-qu%y*qu%z)*chi ), & + eu = [atan2((-P*qu%w*qu%y+qu%x*qu%z)*chi, (-P*qu%w*qu%x-qu%y*qu%z)*chi ), & atan2( 2.0*chi, q03-q12 ), & - atan2(( epsijk*qu%w*qu%y+qu%x*qu%z)*chi, (-epsijk*qu%w*qu%x+qu%y*qu%z)*chi )] + atan2(( P*qu%w*qu%y+qu%x*qu%z)*chi, (-P*qu%w*qu%x+qu%y*qu%z)*chi )] endif degenerated where(eu<0.0_pReal) eu = mod(eu+2.0_pReal*PI,[2.0_pReal*PI,PI,2.0_pReal*PI]) @@ -559,8 +559,8 @@ function om2ax(om) result(ax) if (INFO /= 0) call IO_error(0_pInt,ext_msg='Error in om2ax/(s/d)geev: (S/D)GEEV return not zero') i = maxloc(merge(1.0_pReal,0.0_pReal,cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal)),dim=1) ! poor substitute for findloc ax(1:3) = VR(1:3,i) - where ( dNeq0([om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])) & - ax(1:3) = sign(ax(1:3),-epsijk *[om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)]) + where ( dNeq0([om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])) & + ax(1:3) = sign(ax(1:3),-P *[om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)]) endif end function om2ax @@ -619,7 +619,7 @@ pure function ax2ro(ax) result(ro) real(pReal), parameter :: thr = 1.0E-7 if (dEq0(ax(4))) then - ro = [ 0.0_pReal, 0.0_pReal, epsijk, 0.0_pReal ] + ro = [ 0.0_pReal, 0.0_pReal, P, 0.0_pReal ] else ro(1:3) = ax(1:3) ! we need to deal with the 180 degree case @@ -709,7 +709,7 @@ pure function qu2om(qu) result(om) om(3,2) = 2.0*(qu%z*qu%y+qu%w*qu%x) om(1,3) = 2.0*(qu%x*qu%z+qu%w*qu%y) - if (epsijk < 0.0) om = transpose(om) + if (P < 0.0) om = transpose(om) end function qu2om @@ -734,7 +734,7 @@ function om2qu(om) result(qu) -om(1,1) +om(2,2) -om(3,3) +1.0_pReal, & -om(1,1) -om(2,2) +om(3,3) +1.0_pReal] - qu_A = sqrt(max(s,0.0_pReal))*0.5_pReal*[1.0_pReal,epsijk,epsijk,epsijk] + qu_A = sqrt(max(s,0.0_pReal))*0.5_pReal*[1.0_pReal,P,P,P] qu_A = qu_A/norm2(qu_A) if(any(dEq(abs(qu_A),1.0_pReal,1.0e-15_pReal))) & @@ -803,7 +803,7 @@ pure function qu2ro(qu) result(ro) ro = [qu%x, qu%y, qu%z, IEEE_value(ro(4),IEEE_positive_inf)] else s = norm2([qu%x,qu%y,qu%z]) - ro = merge ( [ 0.0_pReal, 0.0_pReal, epsijk, 0.0_pReal], & + ro = merge ( [ 0.0_pReal, 0.0_pReal, P, 0.0_pReal], & [ qu%x/s, qu%y/s, qu%z/s, tan(acos(qu%w))], & s < thr) !ToDo: not save (PGI compiler) end if From 878331e5e9cfe59f6bcbff0a26f6040eb3fcb835 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 19:29:19 +0100 Subject: [PATCH 098/309] this code was never used and is quite old --- python/damask/orientation.py | 15 +-------------- 1 file changed, 1 insertion(+), 14 deletions(-) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 29ecaf626..0386bc714 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -575,19 +575,6 @@ class Symmetry: proper considers only vectors with z >= 0, hence uses two neighboring SSTs. Return inverse pole figure color if requested. """ -# basis = {'cubic' : np.linalg.inv(np.array([[0.,0.,1.], # direction of red -# [1.,0.,1.]/np.sqrt(2.), # direction of green -# [1.,1.,1.]/np.sqrt(3.)]).transpose()), # direction of blue -# 'hexagonal' : np.linalg.inv(np.array([[0.,0.,1.], # direction of red -# [1.,0.,0.], # direction of green -# [np.sqrt(3.),1.,0.]/np.sqrt(4.)]).transpose()), # direction of blue -# 'tetragonal' : np.linalg.inv(np.array([[0.,0.,1.], # direction of red -# [1.,0.,0.], # direction of green -# [1.,1.,0.]/np.sqrt(2.)]).transpose()), # direction of blue -# 'orthorhombic' : np.linalg.inv(np.array([[0.,0.,1.], # direction of red -# [1.,0.,0.], # direction of green -# [0.,1.,0.]]).transpose()), # direction of blue -# } if self.lattice == 'cubic': basis = {'improper':np.array([ [-1. , 0. , 1. ], @@ -854,7 +841,7 @@ class Orientation: if int(direction) == 0: return None # KS from S. Morito et al./Journal of Alloys and Compounds 5775 (2013) S587-S592 - # for KS rotation matrices also check K. Kitahara et al./Acta Materialia 54 (2006) 1279-1288 + # for KS rotation matrices also check K. Kitahara et al./Acta Materialia 54 (2006) 1279-1288 # GT from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 # GT' from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 # NW from H. Kitahara et al./Materials Characterization 54 (2005) 378-386 From 08009079ff2d49295011897d18ff1074c21accd4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 20:17:12 +0100 Subject: [PATCH 099/309] avoiding numerical errors (if quaternion norm is > 1.) use consistently "self" instead of "this" function for misorientation --- src/quaternions.f90 | 2 +- src/rotations.f90 | 96 ++++++++++++++++++++++++--------------------- 2 files changed, 53 insertions(+), 45 deletions(-) diff --git a/src/quaternions.f90 b/src/quaternions.f90 index 17f943aa6..39dc1d3cd 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -240,7 +240,7 @@ type(quaternion) elemental function mul_quat__(self,other) implicit none class(quaternion), intent(in) :: self, other - mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z + mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y) mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z) mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x) diff --git a/src/rotations.f90 b/src/rotations.f90 index 4ccea592b..59ee3512d 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -65,17 +65,9 @@ module rotations !------------------------------------------ procedure, public :: rotVector procedure, public :: rotTensor + procedure, public :: misorientation end type rotation - public :: & - asQuaternion, & - asEulerAngles, & - asAxisAnglePair, & - asRotationMatrix, & - asRodriguesFrankVector, & - asHomochoric, & - fromRotationMatrix, & - rotVector, & - rotTensor + contains @@ -83,76 +75,76 @@ contains !--------------------------------------------------------------------------------------------------- ! Return rotation in different represenations !--------------------------------------------------------------------------------------------------- -function asQuaternion(this) +function asQuaternion(self) implicit none - class(rotation), intent(in) :: this + class(rotation), intent(in) :: self real(pReal), dimension(4) :: asQuaternion - asQuaternion = [this%q%w, this%q%x, this%q%y, this%q%z] + asQuaternion = [self%q%w, self%q%x, self%q%y, self%q%z] end function asQuaternion !--------------------------------------------------------------------------------------------------- -function asEulerAngles(this) +function asEulerAngles(self) implicit none - class(rotation), intent(in) :: this + class(rotation), intent(in) :: self real(pReal), dimension(3) :: asEulerAngles - asEulerAngles = qu2eu(this%q) + asEulerAngles = qu2eu(self%q) end function asEulerAngles !--------------------------------------------------------------------------------------------------- -function asAxisAnglePair(this) +function asAxisAnglePair(self) implicit none - class(rotation), intent(in) :: this + class(rotation), intent(in) :: self real(pReal), dimension(4) :: asAxisAnglePair - asAxisAnglePair = qu2ax(this%q) + asAxisAnglePair = qu2ax(self%q) end function asAxisAnglePair !--------------------------------------------------------------------------------------------------- -function asRotationMatrix(this) +function asRotationMatrix(self) implicit none - class(rotation), intent(in) :: this + class(rotation), intent(in) :: self real(pReal), dimension(3,3) :: asRotationMatrix - asRotationMatrix = qu2om(this%q) + asRotationMatrix = qu2om(self%q) end function asRotationMatrix !--------------------------------------------------------------------------------------------------- -function asRodriguesFrankVector(this) +function asRodriguesFrankVector(self) implicit none - class(rotation), intent(in) :: this + class(rotation), intent(in) :: self real(pReal), dimension(4) :: asRodriguesFrankVector - asRodriguesFrankVector = qu2ro(this%q) + asRodriguesFrankVector = qu2ro(self%q) end function asRodriguesFrankVector !--------------------------------------------------------------------------------------------------- -function asHomochoric(this) +function asHomochoric(self) implicit none - class(rotation), intent(in) :: this + class(rotation), intent(in) :: self real(pReal), dimension(3) :: asHomochoric - asHomochoric = qu2ho(this%q) + asHomochoric = qu2ho(self%q) end function asHomochoric !--------------------------------------------------------------------------------------------------- ! Initialize rotation from different representations !--------------------------------------------------------------------------------------------------- -subroutine fromRotationMatrix(this,om) +subroutine fromRotationMatrix(self,om) implicit none - class(rotation), intent(out) :: this + class(rotation), intent(out) :: self real(pReal), dimension(3,3), intent(in) :: om - this%q = om2qu(om) + self%q = om2qu(om) end subroutine @@ -162,13 +154,13 @@ end subroutine !> @brief rotate a vector passively (default) or actively !> @details: rotation is based on unit quaternion or rotation matrix (fallback) !--------------------------------------------------------------------------------------------------- -function rotVector(this,v,active) +function rotVector(self,v,active) use prec, only: & dEq implicit none real(pReal), dimension(3) :: rotVector - class(rotation), intent(in) :: this + class(rotation), intent(in) :: self real(pReal), intent(in), dimension(3) :: v logical, intent(in), optional :: active @@ -176,16 +168,16 @@ function rotVector(this,v,active) 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) - q = this%q * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * conjg(this%q) ) + q = self%q * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * conjg(self%q) ) else passive - q = conjg(this%q) * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * this%q ) + q = conjg(self%q) * (quaternion([0.0_pReal, v(1), v(2), v(3)]) * self%q ) endif passive rotVector = [q%x,q%y,q%z] else passive2: if (merge(.not. active, .true., present(active))) then ! ToDo: not save (PGI) - rotVector = matmul(this%asRotationMatrix(),v) + rotVector = matmul(self%asRotationMatrix(),v) else passive2 - rotVector = matmul(transpose(this%asRotationMatrix()),v) + rotVector = matmul(transpose(self%asRotationMatrix()),v) endif passive2 endif @@ -197,24 +189,37 @@ end function rotVector !> @brief rotate a second rank tensor passively (default) or actively !> @details: rotation is based on rotation matrix !--------------------------------------------------------------------------------------------------- -function rotTensor(this,m,active) +function rotTensor(self,m,active) implicit none real(pReal), dimension(3,3) :: rotTensor - class(rotation), intent(in) :: this + class(rotation), intent(in) :: self real(pReal), intent(in), dimension(3,3) :: m logical, intent(in), optional :: active passive: if (merge(.not. active, .true., present(active))) then - rotTensor = matmul(matmul(this%asRotationMatrix(),m),transpose(this%asRotationMatrix())) + rotTensor = matmul(matmul(self%asRotationMatrix(),m),transpose(self%asRotationMatrix())) else passive - rotTensor = matmul(matmul(transpose(this%asRotationMatrix()),m),this%asRotationMatrix()) + rotTensor = matmul(matmul(transpose(self%asRotationMatrix()),m),self%asRotationMatrix()) endif passive end function rotTensor +!--------------------------------------------------------------------------------------------------- +!> @brief misorientation +!--------------------------------------------------------------------------------------------------- +function misorientation(self,other) + + implicit none + type(rotation) :: misorientation + class(rotation), intent(in) :: self, other + + misorientation%q = conjg(self%q) * other%q !ToDo: this is the convention used in math + +end function misorientation + !--------------------------------------------------------------------------------------------------- ! The following routines convert between different representations @@ -760,7 +765,8 @@ pure function qu2ax(qu) result(ax) dEq0, & dNeq0 use math, only: & - PI + PI, & + math_clip implicit none type(quaternion), intent(in) :: qu @@ -768,7 +774,7 @@ pure function qu2ax(qu) result(ax) real(pReal) :: omega, s - omega = 2.0 * acos(qu%w) + omega = 2.0 * acos(math_clip(qu%w,0.0_pReal,1.0_pReal)) ! if the angle equals zero, then we return the rotation axis as [001] if (dEq0(omega)) then ax = [ 0.0, 0.0, 1.0, 0.0 ] @@ -818,6 +824,8 @@ end function qu2ro pure function qu2ho(qu) result(ho) use prec, only: & dEq0 + use math, only: & + math_clip implicit none type(quaternion), intent(in) :: qu @@ -825,7 +833,7 @@ pure function qu2ho(qu) result(ho) real(pReal) :: omega, f - omega = 2.0 * acos(qu%w) + omega = 2.0 * acos(math_clip(qu%w,0.0_pReal,1.0_pReal)) if (dEq0(omega)) then ho = [ 0.0, 0.0, 0.0 ] From 9a4e9e62b66a84abe610ee17f9aaa07f081e5ee7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 20:28:07 +0100 Subject: [PATCH 100/309] using new rotation class --- python/damask/orientation.py | 1 - src/constitutive.f90 | 4 +-- src/crystallite.f90 | 48 ++++++++++++------------------------ src/plastic_nonlocal.f90 | 15 ++++++----- 4 files changed, 24 insertions(+), 44 deletions(-) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 0386bc714..a1fe1f845 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -575,7 +575,6 @@ class Symmetry: proper considers only vectors with z >= 0, hence uses two neighboring SSTs. Return inverse pole figure color if requested. """ - if self.lattice == 'cubic': basis = {'improper':np.array([ [-1. , 0. , 1. ], [ np.sqrt(2.) , -np.sqrt(2.) , 0. ], diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a0d7147a6..9483f2610 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -348,7 +348,7 @@ end function constitutive_homogenizedC !-------------------------------------------------------------------------------------------------- !> @brief calls microstructure function of the different constitutive models !-------------------------------------------------------------------------------------------------- -subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) +subroutine constitutive_microstructure(Fe, Fp, ipc, ip, el) use prec, only: & pReal use material, only: & @@ -381,8 +381,6 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) ho, & !< homogenization tme, & !< thermal member position instance, of - real(pReal), intent(in), dimension(:,:,:,:) :: & - orientations !< crystal orientations as quaternions ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index e2f05284e..013c28a38 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -46,12 +46,8 @@ module crystallite crystallite_Tstar0_v, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc ToDo: Should be called S, 3x3 crystallite_partionedTstar0_v !< 2nd Piola-Kirchhoff stress vector at start of homog inc ToDo: Should be called S, 3x3 type(rotation), dimension(:,:,:), allocatable, private :: & - crystallite_ori, & !< orientation as quaternion - crystallite_ori0 !< initial orientation as quaternion - real(pReal), dimension(:,:,:,:), allocatable, private :: & - crystallite_orientation, & !< orientation as quaternion - crystallite_orientation0, & !< initial orientation as quaternion - crystallite_rotation !< grain rotation away from initial orientation as axis-angle (in degrees) in crystal reference frame + crystallite_orientation, & !< orientation + crystallite_orientation0 !< initial orientation real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & crystallite_Fe, & !< current "elastic" def grad (end of converged time step) crystallite_P !< 1st Piola-Kirchhoff stress per grain @@ -243,11 +239,8 @@ subroutine crystallite_init allocate(crystallite_subdt(cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_subFrac(cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_subStep(cMax,iMax,eMax), source=0.0_pReal) - allocate(crystallite_orientation(4,cMax,iMax,eMax), source=0.0_pReal) - allocate(crystallite_orientation0(4,cMax,iMax,eMax), source=0.0_pReal) - allocate(crystallite_ori(cMax,iMax,eMax)) - !allocate(crystallite_ori0(cMax,iMax,eMax)) - allocate(crystallite_rotation(4,cMax,iMax,eMax), source=0.0_pReal) + allocate(crystallite_orientation(cMax,iMax,eMax)) + allocate(crystallite_orientation0(cMax,iMax,eMax)) allocate(crystallite_localPlasticity(cMax,iMax,eMax), source=.true.) allocate(crystallite_requested(cMax,iMax,eMax), source=.false.) allocate(crystallite_todo(cMax,iMax,eMax), source=.false.) @@ -296,8 +289,6 @@ subroutine crystallite_init crystallite_outputID(o,c) = orientation_ID case ('grainrotation') outputName crystallite_outputID(o,c) = grainrotation_ID - case ('eulerangles') outputName - crystallite_outputID(o,c) = eulerangles_ID case ('defgrad','f') outputName crystallite_outputID(o,c) = defgrad_ID case ('fe') outputName @@ -334,8 +325,6 @@ subroutine crystallite_init mySize = 1_pInt case(orientation_ID,grainrotation_ID) mySize = 4_pInt - case(eulerangles_ID) - mySize = 3_pInt case(defgrad_ID,fe_ID,fp_ID,fi_ID,lp_ID,li_ID,p_ID,s_ID) mySize = 9_pInt case(elasmatrix_ID) @@ -401,13 +390,12 @@ subroutine crystallite_init call crystallite_orientations() crystallite_orientation0 = crystallite_orientation ! store initial orientations for calculation of grain rotations - + !$OMP PARALLEL DO do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do c = 1_pInt,homogenization_Ngrains(mesh_element(3,e)) - call constitutive_microstructure(crystallite_orientation, & - crystallite_Fe(1:3,1:3,c,i,e), & + call constitutive_microstructure(crystallite_Fe(1:3,1:3,c,i,e), & crystallite_Fp(1:3,1:3,c,i,e), & c,i,e) ! update dependent state variables to be consistent with basic states enddo @@ -908,10 +896,7 @@ subroutine crystallite_orientations do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do c = 1_pInt,homogenization_Ngrains(mesh_element(3,e)) - call crystallite_ori(c,i,e)%fromRotationMatrix(transpose(math_rotationalPart33(crystallite_Fe(1:3,1:3,c,i,e)))) - crystallite_orientation(1:4,c,i,e) = math_RtoQ(transpose(math_rotationalPart33(crystallite_Fe(1:3,1:3,c,i,e)))) - crystallite_rotation(1:4,c,i,e) = lattice_qDisorientation(crystallite_orientation0(1:4,c,i,e), &! active rotation from initial - crystallite_orientation(1:4,c,i,e)) ! to current orientation (with no symmetry) + call crystallite_orientation(c,i,e)%fromRotationMatrix(transpose(math_rotationalPart33(crystallite_Fe(1:3,1:3,c,i,e)))) enddo; enddo; enddo !$OMP END PARALLEL DO @@ -920,7 +905,7 @@ subroutine crystallite_orientations !$OMP PARALLEL DO do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - if (plasticState(material_phase(1,i,e))%nonLocal) & ! if nonlocal model + if (plasticState(material_phase(1,i,e))%nonLocal) & ! if nonlocal model call plastic_nonlocal_updateCompatibility(crystallite_orientation,i,e) enddo; enddo !$OMP END PARALLEL DO @@ -987,6 +972,8 @@ function crystallite_postResults(ipc, ip, el) use constitutive, only: & constitutive_homogenizedC, & constitutive_postResults + use rotations, only: & + rotation implicit none integer(pInt), intent(in):: & @@ -1006,6 +993,7 @@ function crystallite_postResults(ipc, ip, el) crystID, & mySize, & n + type(rotation) :: rot crystID = microstructure_crystallite(mesh_element(4,el)) @@ -1029,15 +1017,12 @@ function crystallite_postResults(ipc, ip, el) / real(homogenization_Ngrains(mesh_element(3,el)),pReal) ! grain volume (not fraction but absolute) case (orientation_ID) mySize = 4_pInt - crystallite_postResults(c+1:c+mySize) = crystallite_ori(ipc,ip,el)%asQuaternion() - case (eulerangles_ID) - mySize = 3_pInt - crystallite_postResults(c+1:c+mySize) = inDeg & - * math_qToEuler(crystallite_orientation(1:4,ipc,ip,el)) ! grain orientation as Euler angles in degree + crystallite_postResults(c+1:c+mySize) = crystallite_orientation(ipc,ip,el)%asQuaternion() + case (grainrotation_ID) + rot = crystallite_orientation0(ipc,ip,el)%misorientation(crystallite_orientation(ipc,ip,el)) mySize = 4_pInt - crystallite_postResults(c+1:c+mySize) = & - math_qToEulerAxisAngle(crystallite_rotation(1:4,ipc,ip,el)) ! grain rotation away from initial orientation as axis-angle in sample reference coordinates + crystallite_postResults(c+1:c+mySize) = rot%asAxisAnglePair() crystallite_postResults(c+4) = inDeg * crystallite_postResults(c+4) ! angle in degree ! remark: tensor output is of the form 11,12,13, 21,22,23, 31,32,33 @@ -2222,8 +2207,7 @@ subroutine update_dependentState() do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) & - call constitutive_dependentState(crystallite_orientation, & - crystallite_Fe(1:3,1:3,g,i,e), & + call constitutive_dependentState(crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fp(1:3,1:3,g,i,e), & g, i, e) enddo; enddo; enddo diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index e1355da8f..112592a8c 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -3005,10 +3005,9 @@ end subroutine plastic_nonlocal_dotState !* that sum up to a total of 1 are considered, all others are set to * !* zero. * !********************************************************************* -subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) - -use math, only: math_mul3x3, & - math_qRot +subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) +use math, only: math_mul3x3, math_qRot +use rotations, only: rotation use material, only: material_phase, & material_texture, & phase_localPlasticity, & @@ -3030,7 +3029,7 @@ implicit none !* input variables integer(pInt), intent(in) :: i, & ! ip index e ! element index -real(pReal), dimension(4,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +type(rotation), dimension(1,mesh_maxNips,mesh_NcpElems), intent(in) :: & orientation ! crystal orientation in quaternions !* local variables @@ -3059,7 +3058,7 @@ real(pReal) my_compatibilitySum, & nThresholdValues logical, dimension(totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & belowThreshold - +type(rotation) :: rot Nneighbors = FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e)))) ph = material_phase(1,i,e) @@ -3129,8 +3128,8 @@ neighbors: do n = 1_pInt,Nneighbors !* Finally the smallest my_compatibility value is decreased until the sum is exactly equal to one. !* All values below the threshold are set to zero. else - absoluteMisorientation = lattice_qDisorientation(orientation(1:4,1,i,e), & - orientation(1:4,1,neighbor_i,neighbor_e)) ! no symmetry + rot = orientation(1,i,e)%misorientation(orientation(1,neighbor_i,neighbor_e)) + absoluteMisorientation = rot%asQuaternion() mySlipSystems: do s1 = 1_pInt,ns neighborSlipSystems: do s2 = 1_pInt,ns my_compatibility(1,s2,s1,n) = math_mul3x3(slipNormal(1:3,s1), math_qRot(absoluteMisorientation, slipNormal(1:3,s2))) & From 3d750e793339a4a6e601f44b7f5b04b6344057ea Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 21:56:38 +0100 Subject: [PATCH 101/309] overwriting of init did not work --- src/mesh_FEM.f90 | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index 7a784a27f..b9d171fc3 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -84,14 +84,13 @@ use PETScis contains - procedure :: init => tMesh_FEM_init + procedure, pass(self) :: tMesh_FEM_init + generic, public :: init => tMesh_FEM_init end type tMesh_FEM type(tMesh_FEM), public, protected :: theMesh - - public :: & mesh_init, & mesh_FEM_build_ipVolumes, & @@ -100,22 +99,24 @@ use PETScis contains -subroutine tMesh_FEM_init(self,dimen,order) +subroutine tMesh_FEM_init(self,dimen,order,nodes) implicit none - integer(pInt), intent(in) :: dimen,order + integer, intent(in) :: dimen + integer(pInt), intent(in) :: order + real(pReal), intent(in), dimension(:,:) :: nodes class(tMesh_FEM) :: self if (dimen == 2_pInt) then - if (order == 1_pInt) call self%elem%init(1_pInt) - if (order == 2_pInt) call self%elem%init(2_pInt) + if (order == 1_pInt) call self%tMesh%init('mesh',1_pInt,nodes) + if (order == 2_pInt) call self%tMesh%init('mesh',2_pInt,nodes) elseif(dimen == 3_pInt) then - if (order == 1_pInt) call self%elem%init(6_pInt) - if (order == 2_pInt) call self%elem%init(8_pInt) + if (order == 1_pInt) call self%tMesh%init('mesh',6_pInt,nodes) + if (order == 2_pInt) call self%tMesh%init('mesh',8_pInt,nodes) endif - -end subroutine tMesh_FEM_init + end subroutine tMesh_FEM_init + !-------------------------------------------------------------------------------------------------- @@ -273,7 +274,9 @@ subroutine mesh_init() mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init(dimplex,integrationOrder) + allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) + call theMesh%init(dimplex,integrationOrder,mesh_node0) + end subroutine mesh_init From d13b0f11648deb9430b61f7d57493f3b51510ce7 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 2 Feb 2019 08:54:10 +0100 Subject: [PATCH 102/309] [skip ci] updated version information after successful test of v2.0.2-1674-g683dee82 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 2479c4238..543d23432 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1667-g6b66563b +v2.0.2-1674-g683dee82 From 4a2828405862ef7567b6dec90f2fd25d5a7b28cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 09:18:01 +0100 Subject: [PATCH 103/309] only parse geom file once --- src/mesh_grid.f90 | 386 ++++++++++++++++++++-------------------------- 1 file changed, 163 insertions(+), 223 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index cff0dbc21..942611b1f 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -28,6 +28,8 @@ module mesh mesh_maxNcellnodes !< max number of cell nodes in any CP element !!!! BEGIN DEPRECATED !!!!! + integer(pInt), dimension(:), allocatable, private :: & + microGlobal integer(pInt), dimension(:), allocatable, public, protected :: & mesh_homogenizationAt, & !< homogenization ID of each element mesh_microstructureAt !< microstructure ID of each element @@ -278,8 +280,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & - mesh_spectral_getGrid, & - mesh_spectral_getSize, & mesh_build_cellnodes, & mesh_build_ipVolumes, & mesh_build_ipCoordinates @@ -354,7 +354,6 @@ subroutine mesh_init(ip,el) include 'fftw3-mpi.f03' integer(C_INTPTR_T) :: devNull, local_K, local_K_offset integer :: ierr, worldsize - integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), intent(in), optional :: el, ip integer(pInt) :: j logical :: myDebug @@ -363,7 +362,6 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - call mesh_build_FEdata ! get properties of the different types of elements mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh @@ -371,14 +369,14 @@ subroutine mesh_init(ip,el) myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) call fftw_mpi_init() - call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... - if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) - grid = mesh_spectral_getGrid(fileUnit) + call mesh_spectral_read_grid() + + call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') - geomSize = mesh_spectral_getSize(fileUnit) + devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & int(grid(2),C_INTPTR_T), & int(grid(1),C_INTPTR_T)/2+1, & @@ -395,19 +393,20 @@ subroutine mesh_init(ip,el) mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) call mesh_spectral_build_nodes() - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call theMesh%init(mesh_node) + + call theMesh%init(mesh_node) + ! For compatibility - mesh_maxNips = theMesh%elem%nIPs mesh_maxNipNeighbors = theMesh%elem%nIPneighbors mesh_maxNcellnodes = theMesh%elem%Ncellnodes - - call mesh_spectral_build_elements(FILEUNIT) + call mesh_spectral_build_elements() + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) + call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -418,7 +417,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) call mesh_build_ipAreas if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) - close (FILEUNIT) call mesh_spectral_build_ipNeighborhood @@ -683,17 +681,14 @@ pure function mesh_cellCenterCoordinates(ip,el) enddo mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) - end function mesh_cellCenterCoordinates +end function mesh_cellCenterCoordinates !-------------------------------------------------------------------------------------------------- -!> @brief Reads grid information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!> @brief Parses geometry file !-------------------------------------------------------------------------------------------------- -function mesh_spectral_getGrid(fileUnit) +subroutine mesh_spectral_read_grid() use IO, only: & - IO_checkAndRewind, & - IO_open_file, & IO_stringPos, & IO_lc, & IO_stringValue, & @@ -703,145 +698,158 @@ function mesh_spectral_getGrid(fileUnit) use DAMASK_interface, only: & geometryFile - implicit none - integer(pInt), dimension(3) :: mesh_spectral_getGrid - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos + implicit none + character(len=:), allocatable :: rawData + character(len=65536) :: line + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt), dimension(3) :: g = -1_pInt + real(pReal), dimension(3) :: s = -1_pInt + integer(pInt) :: h =- 1_pInt + integer(pInt) :: & + headerLength = -1_pInt, & + fileLength, & + fileUnit, & + startPos, endPos, & + myStat, & + l, i, j, e, c + logical :: & + gotGrid = .false., & + gotSize = .false., & + gotHomogenization = .false. - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotGrid = .false. +!-------------------------------------------------------------------------------------------------- +! read data as stream + inquire(file = trim(geometryFile), size=fileLength) + open(newunit=fileUnit, file=trim(geometryFile), access='stream',& + status='old', position='rewind', action='read',iostat=myStat) + if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(geometryFile)) + allocate(character(len=fileLength)::rawData) + read(fileUnit) rawData + close(fileUnit) + +!-------------------------------------------------------------------------------------------------- +! get header length + endPos = index(rawData,new_line('')) + if(endPos <= index(rawData,'head')) then + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid') + else + chunkPos = IO_stringPos(rawData(1:endPos)) + if (chunkPos(1) < 2_pInt) call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid') + headerLength = IO_intValue(rawData(1:endPos),chunkPos,1_pInt) + startPos = endPos + 1_pInt + endif - mesh_spectral_getGrid = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif +!-------------------------------------------------------------------------------------------------- +! read and interprete header + l = 0 + do while (l < headerLength .and. startPos < len(rawData)) + endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + line = rawData(startPos:endPos) + startPos = endPos + 1_pInt + l = l + 1_pInt - call IO_checkAndRewind(myFileUnit) + ! cycle empty lines + chunkPos = IO_stringPos(trim(line)) + select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) ) + + case ('grid') + if (chunkPos(1) > 6) gotGrid = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('a') + g(1) = IO_intValue(line,chunkPos,j+1_pInt) + case('b') + g(2) = IO_intValue(line,chunkPos,j+1_pInt) + case('c') + g(3) = IO_intValue(line,chunkPos,j+1_pInt) + end select + enddo + + case ('size') + if (chunkPos(1) > 6) gotSize = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('x') + s(1) = IO_floatValue(line,chunkPos,j+1_pInt) + case('y') + s(2) = IO_floatValue(line,chunkPos,j+1_pInt) + case('z') + s(3) = IO_floatValue(line,chunkPos,j+1_pInt) + end select + enddo + + case ('homogenization') + if (chunkPos(1) > 1) gotHomogenization = .true. + h = IO_intValue(line,chunkPos,2_pInt) - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) - case ('grid') - gotGrid = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('a') - mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) - case('b') - mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) - case('c') - mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo + end select - if(.not. present(fileUnit)) close(myFileUnit) + enddo - if (.not. gotGrid) & - call IO_error(error_ID = 845_pInt, ext_msg='grid') - if(any(mesh_spectral_getGrid < 1_pInt)) & - call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') +!-------------------------------------------------------------------------------------------------- +! global data + grid = g + geomSize = s + allocate(microGlobal(product(grid)), source = -1_pInt) + +!-------------------------------------------------------------------------------------------------- +! read and interprete content + e = 1_pInt + do while (startPos < len(rawData)) + endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + line = rawData(startPos:endPos) + startPos = endPos + 1_pInt + l = l + 1_pInt -end function mesh_spectral_getGrid + chunkPos = IO_stringPos(trim(line)) + if (chunkPos(1) == 3) then + if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then + c = IO_intValue(line,chunkPos,1) + microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))] + else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then + c = IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1) + 1_pInt + microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3))] + else + c = chunkPos(1) + do i = 0_pInt, c - 1_pInt + microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) + enddo + endif + else + c = chunkPos(1) + do i = 0_pInt, c - 1_pInt + microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) + enddo + + endif + + e = e+c + end do + + if (e-1 /= product(grid)) print*, 'mist', e + +! if (.not. gotGrid) & +! call IO_error(error_ID = 845_pInt, ext_msg='grid') +! if(any(mesh_spectral_getGrid < 1_pInt)) & +! call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') + +! if (.not. gotSize) & +! call IO_error(error_ID = 845_pInt, ext_msg='size') +! if (any(mesh_spectral_getSize<=0.0_pReal)) & +! call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') + +! if (.not. gotHomogenization ) & +! call IO_error(error_ID = 845_pInt, ext_msg='homogenization') +! if (mesh_spectral_getHomogenization<1_pInt) & +! call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') + +end subroutine mesh_spectral_read_grid !-------------------------------------------------------------------------------------------------- -!> @brief Reads size information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!> @brief Reads homogenization information from geometry file. !-------------------------------------------------------------------------------------------------- -function mesh_spectral_getSize(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - real(pReal), dimension(3) :: mesh_spectral_getSize - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotSize = .false. - - mesh_spectral_getSize = -1.0_pReal - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('size') - gotSize = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('x') - mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) - case('y') - mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) - case('z') - mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotSize) & - call IO_error(error_ID = 845_pInt, ext_msg='size') - if (any(mesh_spectral_getSize<=0.0_pReal)) & - call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') - -end function mesh_spectral_getSize - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_spectral_getHomogenization(fileUnit) +integer(pInt) function mesh_spectral_getHomogenization() use IO, only: & IO_checkAndRewind, & IO_open_file, & @@ -854,7 +862,6 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) geometryFile implicit none - integer(pInt), intent(in), optional :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: headerLength = 0_pInt character(len=1024) :: line, & @@ -862,13 +869,10 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) integer(pInt) :: i, myFileUnit logical :: gotHomogenization = .false. - mesh_spectral_getHomogenization = -1_pInt - if(.not. present(fileUnit)) then + myFileUnit = 289_pInt call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif + call IO_checkAndRewind(myFileUnit) @@ -891,7 +895,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) end select enddo - if(.not. present(fileUnit)) close(myFileUnit) + close(myFileUnit) if (.not. gotHomogenization ) & call IO_error(error_ID = 845_pInt, ext_msg='homogenization') @@ -935,85 +939,21 @@ end subroutine mesh_spectral_build_nodes !! Allocates global array 'mesh_element' !> @todo does the IO_error makes sense? !-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_elements(fileUnit) +subroutine mesh_spectral_build_elements() use IO, only: & - IO_checkAndRewind, & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_continuousIntValues, & - IO_intValue, & - IO_countContinuousIntValues - + IO_error implicit none - integer(pInt), intent(in) :: & - fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & e, i, & - headerLength = 0_pInt, & - maxDataPerLine, & + homog, & elemOffset - integer(pInt), dimension(:), allocatable :: & - microstructures, & - microGlobal - integer(pInt), dimension(1,1) :: & - dummySet = 0_pInt - character(len=65536) :: & - line, & - keyword - character(len=64), dimension(1) :: & - dummyName = '' - homog = mesh_spectral_getHomogenization(fileUnit) -!-------------------------------------------------------------------------------------------------- -! get header length - call IO_checkAndRewind(fileUnit) - read(fileUnit,'(a65536)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') - endif + homog = mesh_spectral_getHomogenization() -!-------------------------------------------------------------------------------------------------- -! get maximum microstructure index - call IO_checkAndRewind(fileUnit) - do i = 1_pInt, headerLength - read(fileUnit,'(a65536)') line - enddo - maxDataPerLine = 0_pInt - i = 1_pInt - - do while (i > 0_pInt) - i = IO_countContinuousIntValues(fileUnit) - maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? - enddo allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) - allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size - allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) - -!-------------------------------------------------------------------------------------------------- -! read in microstructures - call IO_checkAndRewind(fileUnit) - do i=1_pInt,headerLength - read(fileUnit,'(a65536)') line - enddo - - e = 0_pInt - do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) - microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements - do i = 1_pInt,microstructures(1_pInt) - e = e+1_pInt ! valid element entry - microGlobal(e) = microstructures(1_pInt+i) - enddo - enddo elemOffset = product(grid(1:2))*grid3Offset From 5810dce618685deeb027645e8caf265628b2f781 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 09:29:58 +0100 Subject: [PATCH 104/309] better avoid jump marks --- src/mesh_abaqus.f90 | 54 ++++++++++++++++----------------------------- 1 file changed, 19 insertions(+), 35 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 159f2a7f6..bf5c77642 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -540,6 +540,8 @@ subroutine mesh_init(ip,el) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) contains + + !-------------------------------------------------------------------------------------------------- !> @brief check if the input file for Abaqus contains part info !-------------------------------------------------------------------------------------------------- @@ -557,10 +559,9 @@ logical function hasNoPart(fileUnit) hasNoPart = .true. -610 FORMAT(A65536) rewind(fileUnit) do - read(fileUnit,610,END=620) line + read(fileUnit,'(a65536)',END=620) line chunkPos = IO_stringPos(line) if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then hasNoPart = .false. @@ -882,12 +883,11 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) mesh_Nnodes = 0_pInt mesh_Nelems = 0_pInt -610 FORMAT(A300) inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -942,12 +942,10 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) mesh_NelemSets = 0_pInt mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons -610 FORMAT(A300) - inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -984,12 +982,10 @@ subroutine mesh_abaqus_count_materials(fileUnit) mesh_Nmaterials = 0_pInt -610 FORMAT(A300) - inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1031,12 +1027,10 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) -610 FORMAT(A300) - rewind(fileUnit) do - read (fileUnit,610,END=640) line + read (fileUnit,'(a300)',END=640) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1083,11 +1077,10 @@ subroutine mesh_abaqus_map_materials(fileUnit) allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1145,11 +1138,10 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) mesh_NcpElems = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') @@ -1200,11 +1192,10 @@ subroutine mesh_abaqus_map_elements(fileUnit) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=660) line + read (fileUnit,'(a300)',END=660) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') @@ -1263,11 +1254,9 @@ subroutine mesh_abaqus_map_nodes(fileUnit) allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) -610 FORMAT(A300) - rewind(fileUnit) do - read (fileUnit,610,END=650) line + read (fileUnit,'(a300)',END=650) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1326,12 +1315,10 @@ subroutine mesh_abaqus_build_nodes(fileUnit) allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) -610 FORMAT(A300) - inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=670) line + read (fileUnit,'(a300)',END=670) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1349,7 +1336,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) backspace(fileUnit) ! rewind to first entry enddo do i = 1_pInt,c - read (fileUnit,610,END=670) line + read (fileUnit,'(a300)',END=670) line chunkPos = IO_stringPos(line) m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) do j=1_pInt, 3_pInt @@ -1393,12 +1380,11 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt -610 FORMAT(A300) inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1451,12 +1437,10 @@ subroutine mesh_abaqus_build_elements(fileUnit) allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) mesh_elemType = -1_pInt -610 FORMAT(A300) - inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1474,8 +1458,8 @@ subroutine mesh_abaqus_build_elements(fileUnit) backspace(fileUnit) enddo do i = 1_pInt,c - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) ! limit to 64 nodes max + read (fileUnit,'(a300)',END=620) line + chunkPos = IO_stringPos(line) ! limit to 64 nodes max e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then ! disregard non CP elems mesh_element(1,e) = -1_pInt ! DEPRECATED @@ -1507,7 +1491,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) materialFound = .false. do - read (fileUnit,610,END=630) line + read (fileUnit,'(a300)',END=630) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) case('*material') @@ -1516,7 +1500,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) case('*user') if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & materialFound ) then - read (fileUnit,610,END=630) line ! read homogenization and microstructure + read (fileUnit,'(a300)',END=630) line ! read homogenization and microstructure chunkPos = IO_stringPos(line) homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) From 9975048f2946eb7f474683b121689ac7cee92fa0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 09:56:11 +0100 Subject: [PATCH 105/309] better avoid jump marks: Abaqus, Part 2 --- src/mesh_abaqus.f90 | 168 +++++++++++++++++++++++++------------------- 1 file changed, 96 insertions(+), 72 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index bf5c77642..5c761ad7e 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -878,16 +878,17 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line + integer :: myStat logical :: inPart mesh_Nnodes = 0_pInt mesh_Nelems = 0_pInt - - + inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -915,7 +916,7 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) endif enddo -620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) + if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) end subroutine mesh_abaqus_count_nodesAndElements @@ -937,15 +938,17 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line + integer :: myStat logical :: inPart mesh_NelemSets = 0_pInt mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -955,7 +958,6 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) mesh_NelemSets = mesh_NelemSets + 1_pInt enddo -620 continue if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) end subroutine mesh_abaqus_count_elementSets @@ -978,14 +980,16 @@ subroutine mesh_abaqus_count_materials(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - logical inPart + integer :: myStat + logical :: inPart mesh_Nmaterials = 0_pInt inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -997,7 +1001,7 @@ subroutine mesh_abaqus_count_materials(fileUnit) mesh_Nmaterials = mesh_Nmaterials + 1_pInt enddo -620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) + if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) end subroutine mesh_abaqus_count_materials @@ -1021,16 +1025,20 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt,i - logical :: inPart = .false. + integer :: myStat + logical :: inPart + integer(pInt) :: elemSet,i allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + elemSet = 0_pInt + inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=640) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1044,7 +1052,7 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) endif enddo -640 do i = 1_pInt,elemSet + do i = 1_pInt,elemSet if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) enddo @@ -1068,19 +1076,21 @@ subroutine mesh_abaqus_map_materials(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c = 0_pInt - logical :: inPart = .false. + character(len=300) :: line + integer :: myStat + logical :: inPart + integer(pInt) :: i,c character(len=64) :: elemSetName,materialName allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' - + c = 0_pInt + inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1108,7 +1118,7 @@ subroutine mesh_abaqus_map_materials(fileUnit) endif enddo -620 if (c==0_pInt) call IO_error(error_ID=905_pInt) + if (c==0_pInt) call IO_error(error_ID=905_pInt) do i=1_pInt,c if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905_pInt) enddo @@ -1131,17 +1141,18 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line + character(len=300) :: line + integer :: myStat + logical :: materialFound integer(pInt) :: i,k - logical :: materialFound = .false. character(len=64) ::materialName,elemSetName mesh_NcpElems = 0_pInt - - + materialFound = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') @@ -1163,7 +1174,7 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) endselect enddo -620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) + if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) end subroutine mesh_abaqus_count_cpElements @@ -1186,16 +1197,19 @@ subroutine mesh_abaqus_map_elements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) ::i,j,k,cpElem = 0_pInt - logical :: materialFound = .false. + integer :: myStat + logical :: materialFound + integer(pInt) ::i,j,k,cpElem character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - + cpElem = 0_pInt + materialFound = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=660) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') @@ -1222,7 +1236,7 @@ subroutine mesh_abaqus_map_elements(fileUnit) endselect enddo -660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) @@ -1247,16 +1261,19 @@ subroutine mesh_abaqus_map_nodes(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c,cpNode = 0_pInt - logical :: inPart = .false. + character(len=300) :: line + integer :: myStat + logical :: inPart + integer(pInt) :: i,c,cpNode allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) - + + cpNode = 0_pInt + inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=650) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1283,7 +1300,7 @@ subroutine mesh_abaqus_map_nodes(fileUnit) endif enddo -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) @@ -1309,16 +1326,18 @@ subroutine mesh_abaqus_build_nodes(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: i,j,m,c + integer :: myStat logical :: inPart + integer(pInt) :: i,j,m,c allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=670) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1346,7 +1365,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) endif enddo -670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) + if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) mesh_node = mesh_node0 end subroutine mesh_abaqus_build_nodes @@ -1372,8 +1391,9 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: i,c,t,g + integer :: myStat logical :: inPart + integer(pInt) :: i,c,t,g mesh_maxNnodes = 0_pInt mesh_maxNips = 0_pInt @@ -1382,9 +1402,10 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1406,7 +1427,7 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) endif enddo -620 end subroutine mesh_abaqus_count_cpSizes +end subroutine mesh_abaqus_count_cpSizes !-------------------------------------------------------------------------------------------------- @@ -1428,19 +1449,21 @@ subroutine mesh_abaqus_build_elements(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - + character(len=300) :: line + integer :: myStat + logical :: inPart integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead logical inPart,materialFound character (len=64) :: materialName,elemSetName - character(len=300) :: line allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) mesh_elemType = -1_pInt inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & @@ -1487,11 +1510,13 @@ subroutine mesh_abaqus_build_elements(fileUnit) enddo -620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" + rewind(fileUnit) ! just in case "*material" definitions apear before "*element" materialFound = .false. - do - read (fileUnit,'(a300)',END=630) line + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) case('*material') @@ -1525,7 +1550,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) endselect enddo -630 end subroutine mesh_abaqus_build_elements +end subroutine mesh_abaqus_build_elements @@ -1543,17 +1568,18 @@ use IO, only: & integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword + character(len=300) :: damaskOption, v + character(len=*), parameter :: keyword = '**damask' mesh_periodicSurface = .false. - keyword = '**damask' - - + myStat = 0 rewind(fileUnit) - do - read (fileUnit,610,END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read @@ -1570,9 +1596,7 @@ use IO, only: & endif enddo -610 FORMAT(A300) - -620 end subroutine mesh_get_damaskOptions +end subroutine mesh_get_damaskOptions From e17278a926de759ba65207fa007d913a7164599b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:11:18 +0100 Subject: [PATCH 106/309] using new mesh structure (initial test) --- src/constitutive.f90 | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 43d57a493..ac8ee0484 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -59,8 +59,6 @@ subroutine constitutive_init() IO_timeStamp use config, only: & config_phase - use mesh, only: & - FE_geomtype use config, only: & material_Nphase, & material_localFileExt, & @@ -789,8 +787,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac math_sym33to6, & math_mul33x33 use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & phasememberAt, & phase_plasticityInstance, & @@ -841,9 +838,9 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac el !< element real(pReal), intent(in) :: & subdt !< timestep - real(pReal), intent(in), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + real(pReal), intent(in), dimension(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & subfracArray !< subfraction of timestep - real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & FeArray, & !< elastic deformation gradient FpArray !< plastic deformation gradient real(pReal), intent(in), dimension(3,3) :: & @@ -1003,8 +1000,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) math_6toSym33, & math_mul33x33 use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & phasememberAt, & phase_plasticityInstance, & @@ -1060,7 +1056,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) constitutive_postResults real(pReal), intent(in), dimension(3,3) :: & Fi !< intermediate deformation gradient - real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & FeArray !< elastic deformation gradient real(pReal), intent(in), dimension(6) :: & S6 !< 2nd Piola Kirchhoff stress (vector notation) From f0b5b9fd593d672a9ab2cb97fcdb4bd71a7408e9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:34:16 +0100 Subject: [PATCH 107/309] unused variable --- src/homogenization.f90 | 3 +-- src/material.f90 | 6 ++---- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 20ce008fd..1c02d1088 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -73,8 +73,7 @@ subroutine homogenization_init use mesh, only: & mesh_maxNips, & mesh_NcpElems, & - mesh_element, & - FE_geomtype + mesh_element use constitutive, only: & constitutive_plasticity_maxSizePostResults, & constitutive_source_maxSizePostResults diff --git a/src/material.f90 b/src/material.f90 index 3ae6c16a4..dbf5433c6 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -306,8 +306,7 @@ subroutine material_init() use mesh, only: & mesh_homogenizationAt, & mesh_NipsPerElem, & - mesh_NcpElems, & - FE_geomtype + mesh_NcpElems implicit none integer(pInt), parameter :: FILEUNIT = 210_pInt @@ -989,8 +988,7 @@ subroutine material_populateGrains mesh_homogenizationAt, & mesh_microstructureAt, & mesh_NcpElems, & - mesh_ipVolume, & - FE_geomtype + mesh_ipVolume use config, only: & config_homogenization, & config_microstructure, & From 7a8d98d135ccd685198433bbb1d611dfe20cbb8a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:35:10 +0100 Subject: [PATCH 108/309] using theMesh (object oriented mesh description) --- src/crystallite.f90 | 62 +++++++++++++++++++++++---------------------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 45aca46d1..db00d3ac2 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -12,8 +12,6 @@ module crystallite use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP - use mesh, only: & - mesh_element use material, only: & homogenization_Ngrains use prec, only: & @@ -155,10 +153,8 @@ subroutine crystallite_init math_inv33, & math_mul33x33 use mesh, only: & - mesh_element, & - mesh_NcpElems, & - mesh_maxNips, & - mesh_maxNipNeighbors + theMesh, & + mesh_element use IO, only: & IO_timeStamp, & IO_stringValue, & @@ -196,8 +192,8 @@ subroutine crystallite_init #include "compilation_info.f90" cMax = homogenization_maxNgrains - iMax = mesh_maxNips - eMax = mesh_NcpElems + iMax = theMesh%elem%nIPs + eMax = theMesh%nElems ! --------------------------------------------------------------------------- ! ToDo (when working on homogenization): should be 3x3 tensor called S @@ -333,7 +329,7 @@ subroutine crystallite_init case(elasmatrix_ID) mySize = 36_pInt case(neighboringip_ID,neighboringelement_ID) - mySize = mesh_maxNipNeighbors + mySize = theMesh%elem%nIPneighbors case default mySize = 0_pInt end select @@ -415,7 +411,7 @@ subroutine crystallite_init write(6,'(a42,1x,i10)') ' # of elements: ', eMax write(6,'(a42,1x,i10)') 'max # of integration points/element: ', iMax write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax - write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', mesh_maxNipNeighbors + write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', theMesh%elem%nIPneighbors write(6,'(a42,1x,i10)') ' # of nonlocal constituents: ',count(.not. crystallite_localPlasticity) flush(6) endif @@ -458,10 +454,8 @@ function crystallite_stress() math_6toSym33, & math_sym33to6 use mesh, only: & - mesh_NcpElems, & - mesh_element, & - mesh_maxNips, & - FE_geomtype + theMesh, & + mesh_element use material, only: & homogenization_Ngrains, & plasticState, & @@ -474,7 +468,7 @@ function crystallite_stress() constitutive_LiAndItsTangents implicit none - logical, dimension(mesh_maxNips,mesh_NcpElems) :: crystallite_stress + logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress real(pReal) :: & formerSubStep integer(pInt) :: & @@ -541,7 +535,7 @@ function crystallite_stress() endIP = startIP else singleRun startIP = 1_pInt - endIP = mesh_maxNips + endIP = theMesh%elem%nIPs endif singleRun NiterationCrystallite = 0_pInt @@ -727,8 +721,7 @@ subroutine crystallite_stressTangent() math_invert2, & math_det33 use mesh, only: & - mesh_element, & - FE_geomtype + mesh_element use material, only: & homogenization_Ngrains use constitutive, only: & @@ -929,7 +922,7 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33) math_inv33, & math_EulerToR use material, only: & - material_EulerAngles + material_EulerAngles ! ToDo: Why stored? We also have crystallite_orientation0 implicit none real(pReal), dimension(3,3) :: crystallite_push33ToRef @@ -960,13 +953,10 @@ function crystallite_postResults(ipc, ip, el) inDeg, & math_6toSym33 use mesh, only: & + theMesh, & mesh_element, & mesh_ipVolume, & - mesh_maxNipNeighbors, & - mesh_ipNeighborhood, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype + mesh_ipNeighborhood use material, only: & plasticState, & sourceState, & @@ -1070,14 +1060,14 @@ function crystallite_postResults(ipc, ip, el) mySize = 36_pInt crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize]) case(neighboringelement_ID) - mySize = mesh_maxNipNeighbors + mySize = theMesh%elem%nIPneighbors crystallite_postResults(c+1:c+mySize) = 0.0_pReal - forall (n = 1_pInt:FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) & + forall (n = 1_pInt:mySize) & crystallite_postResults(c+n) = real(mesh_ipNeighborhood(1,n,ip,el),pReal) case(neighboringip_ID) - mySize = mesh_maxNipNeighbors + mySize = theMesh%elem%nIPneighbors crystallite_postResults(c+1:c+mySize) = 0.0_pReal - forall (n = 1_pInt:FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) & + forall (n = 1_pInt:mySize) & crystallite_postResults(c+n) = real(mesh_ipNeighborhood(2,n,ip,el),pReal) end select c = c + mySize @@ -2128,7 +2118,8 @@ end subroutine nonlocalConvergenceCheck !> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria !-------------------------------------------------------------------------------------------------- subroutine setConvergenceFlag() - + use mesh, only: & + mesh_element implicit none integer(pInt) :: & e, & !< element index in element loop @@ -2168,7 +2159,8 @@ end subroutine setConvergenceFlag !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- subroutine update_stress(timeFraction) - + use mesh, only: & + mesh_element implicit none real(pReal), intent(in) :: & timeFraction @@ -2200,6 +2192,8 @@ end subroutine update_stress !> @brief tbd !-------------------------------------------------------------------------------------------------- subroutine update_dependentState() + use mesh, only: & + mesh_element use constitutive, only: & constitutive_dependentState => constitutive_microstructure @@ -2232,6 +2226,8 @@ subroutine update_state(timeFraction) sourceState, & phase_Nsources, & phaseAt, phasememberAt + use mesh, only: & + mesh_element implicit none real(pReal), intent(in) :: & @@ -2281,6 +2277,8 @@ subroutine update_dotState(timeFraction) sourceState, & phaseAt, phasememberAt, & phase_Nsources + use mesh, only: & + mesh_element use constitutive, only: & constitutive_collectDotState @@ -2334,6 +2332,8 @@ subroutine update_deltaState IEEE_arithmetic use prec, only: & dNeq0 + use mesh, only: & + mesh_element use material, only: & plasticState, & sourceState, & @@ -2429,6 +2429,8 @@ logical function stateJump(ipc,ip,el) sourceState, & phase_Nsources, & phaseAt, phasememberAt + use mesh, only: & + mesh_element use constitutive, only: & constitutive_collectDeltaState use math, only: & From 3a5a50cb03c7bd20a0caa5403c7d881d2d29e6e8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:53:55 +0100 Subject: [PATCH 109/309] use variables from theMesh --- src/crystallite.f90 | 3 ++- src/homogenization.f90 | 36 ++++++++++++++++++------------------ 2 files changed, 20 insertions(+), 19 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index db00d3ac2..1eb2dff28 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -426,7 +426,7 @@ end subroutine crystallite_init !-------------------------------------------------------------------------------------------------- !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- -function crystallite_stress() +function crystallite_stress(a) use prec, only: & tol_math_check, & dNeq0 @@ -469,6 +469,7 @@ function crystallite_stress() implicit none logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress + real(pReal), intent(in), optional :: a !ToDo: for some reason this prevents an internal compiler error in GNU. Very strange real(pReal) :: & formerSubStep integer(pInt) :: & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 1c02d1088..8edecbc88 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -71,8 +71,7 @@ subroutine homogenization_init debug_e, & debug_g use mesh, only: & - mesh_maxNips, & - mesh_NcpElems, & + theMesh, & mesh_element use constitutive, only: & constitutive_plasticity_maxSizePostResults, & @@ -242,20 +241,20 @@ subroutine homogenization_init !-------------------------------------------------------------------------------------------------- ! allocate and initialize global variables - allocate(materialpoint_dPdF(3,3,3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_F0(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - materialpoint_F0 = spread(spread(math_I3,3,mesh_maxNips),4,mesh_NcpElems) ! initialize to identity - allocate(materialpoint_F(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(materialpoint_dPdF(3,3,3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_F0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + materialpoint_F0 = spread(spread(math_I3,3,theMesh%elem%nIPs),4,theMesh%nElems) ! initialize to identity + allocate(materialpoint_F(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) materialpoint_F = materialpoint_F0 ! initialize to identity - allocate(materialpoint_subF0(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subF(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_P(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subFrac(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subStep(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subdt(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_requested(mesh_maxNips,mesh_NcpElems), source=.false.) - allocate(materialpoint_converged(mesh_maxNips,mesh_NcpElems), source=.true.) - allocate(materialpoint_doneAndHappy(2,mesh_maxNips,mesh_NcpElems), source=.true.) + allocate(materialpoint_subF0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subF(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_P(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subFrac(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subStep(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subdt(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_requested(theMesh%elem%nIPs,theMesh%nElems), source=.false.) + allocate(materialpoint_converged(theMesh%elem%nIPs,theMesh%nElems), source=.true.) + allocate(materialpoint_doneAndHappy(2,theMesh%elem%nIPs,theMesh%nElems), source=.true.) !-------------------------------------------------------------------------------------------------- ! allocate and initialize global state and postresutls variables @@ -275,7 +274,7 @@ subroutine homogenization_init + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + constitutive_source_maxSizePostResults) - allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems)) + allocate(materialpoint_results(materialpoint_sizeResults,theMesh%elem%nIPs,theMesh%nElems)) write(6,'(/,a)') ' <<<+- homogenization init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -597,7 +596,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) if ( materialpoint_requested(i,e) .and. & ! process requested but... .not. materialpoint_doneAndHappy(1,i,e)) then ! ...not yet done material points - call partitionDeformation(i,e) ! partition deformation onto constituents + call partitionDeformation(i,e) ! partition deformation onto constituents crystallite_dt(1:myNgrains,i,e) = materialpoint_subdt(i,e) ! propagate materialpoint dt to grains crystallite_requested(1:myNgrains,i,e) = .true. ! request calculation for constituents else @@ -611,7 +610,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) ! crystallite integration ! based on crystallite_partionedF0,.._partionedF ! incrementing by crystallite_dt - materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic + + materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic !-------------------------------------------------------------------------------------------------- ! state update From 94a24e45eeaca801c7c1e7dd0404d165865a646c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 11:46:38 +0100 Subject: [PATCH 110/309] bugfixes: theMesh%Nelems need to be set (using an intermediate function until a routine does that) spectral.geom file can have "N+n to N" (backwards counting) --- src/mesh_FEM.f90 | 1 + src/mesh_abaqus.f90 | 1 + src/mesh_base.f90 | 12 ++++++++++++ src/mesh_grid.f90 | 20 +++++++++++++------- src/mesh_marc.f90 | 2 +- 5 files changed, 28 insertions(+), 8 deletions(-) diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index b9d171fc3..e2b08db4c 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -276,6 +276,7 @@ subroutine mesh_init() !!!!!!!!!!!!!!!!!!!!!!!! allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) call theMesh%init(dimplex,integrationOrder,mesh_node0) + call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 5c761ad7e..05e1d7c7d 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -421,6 +421,7 @@ subroutine tMesh_abaqus_init(self,elemType,nodes) integer(pInt), intent(in) :: elemType call self%tMesh%init('mesh',elemType,nodes) + call theMesh%setNelems(mesh_NcpElems) end subroutine tMesh_abaqus_init diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index e0ca78c03..c0f012256 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -45,6 +45,7 @@ module mesh_base connectivity contains procedure, pass(self) :: tMesh_base_init + procedure :: setNelems => tMesh_base_setNelems ! not needed once we compute the cells from the connectivity generic, public :: init => tMesh_base_init end type tMesh @@ -68,4 +69,15 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes) end subroutine tMesh_base_init + +subroutine tMesh_base_setNelems(self,Nelems) + + implicit none + class(tMesh) :: self + integer(pInt), intent(in) :: Nelems + + self%Nelems = Nelems + +end subroutine tMesh_base_setNelems + end module mesh_base diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 942611b1f..88484a693 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -442,7 +442,7 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init !-------------------------------------------------------------------------------------------------- @@ -686,6 +686,8 @@ end function mesh_cellCenterCoordinates !-------------------------------------------------------------------------------------------------- !> @brief Parses geometry file +!> @details important variables have an implicit "save" attribute. Therefore, this function is +! supposed to be called only once! !-------------------------------------------------------------------------------------------------- subroutine mesh_spectral_read_grid() use IO, only: & @@ -706,12 +708,16 @@ subroutine mesh_spectral_read_grid() real(pReal), dimension(3) :: s = -1_pInt integer(pInt) :: h =- 1_pInt integer(pInt) :: & - headerLength = -1_pInt, & - fileLength, & + headerLength = -1_pInt, & !< length of header (in lines) + fileLength, & !< lenght of the geom file (in characters) fileUnit, & startPos, endPos, & myStat, & - l, i, j, e, c + l, & !< line counter + c, & !< counter for # microstructures in line + o, & !< order of "to" packing + e, & !< "element", i.e. spectral collocation point + i, j logical :: & gotGrid = .false., & gotSize = .false., & @@ -807,8 +813,9 @@ subroutine mesh_spectral_read_grid() c = IO_intValue(line,chunkPos,1) microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))] else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then - c = IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1) + 1_pInt - microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3))] + c = abs(IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1)) + 1_pInt + o = merge(+1_pInt, -1_pInt, IO_intValue(line,chunkPos,3) > IO_intValue(line,chunkPos,1)) + microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)] else c = chunkPos(1) do i = 0_pInt, c - 1_pInt @@ -822,7 +829,6 @@ subroutine mesh_spectral_read_grid() enddo endif - e = e+c end do diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 5607791fb..dd4098879 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -560,7 +560,7 @@ subroutine mesh_init(ip,el) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) - + call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init From 8962635136b26af41bca45ba290df5c1ffb4f5cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 11:50:07 +0100 Subject: [PATCH 111/309] use new elem/mesh variables --- src/plastic_nonlocal.f90 | 96 ++++++++++++++++------------------------ 1 file changed, 39 insertions(+), 57 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index e1355da8f..32cde9768 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -281,8 +281,7 @@ use IO, only: IO_read, & use debug, only: debug_level, & debug_constitutive, & debug_levelBasic -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & +use mesh, only: theMesh, & mesh_maxNipNeighbors use material, only: phase_plasticity, & homogenization_maxNgrains, & @@ -1091,23 +1090,23 @@ allocate(forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstances), allocate(forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(lattice2slip(1:3, 1:3, maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=2.0_pReal) -allocate(rhoDotFluxOutput(maxTotalNslip,8,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotFluxOutput(maxTotalNslip,8,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotMultiplicationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotMultiplicationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotSingle2DipoleGlideOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotSingle2DipoleGlideOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotAthermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotAthermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(compatibility(2,maxTotalNslip,maxTotalNslip,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), & +allocate(compatibility(2,maxTotalNslip,maxTotalNslip,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) allocate(peierlsStress(maxTotalNslip,2,maxNinstances), source=0.0_pReal) allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) @@ -1404,10 +1403,8 @@ use IO, only: IO_error use lattice, only: lattice_maxNslipFamily use math, only: math_sampleGaussVar use mesh, only: mesh_ipVolume, & - mesh_NcpElems, & - mesh_element, & - FE_Nips, & - FE_geomtype + theMesh, & + mesh_element use material, only: material_phase, & phase_plasticityInstance, & plasticState, & @@ -1446,8 +1443,8 @@ do instance = 1_pInt,maxNinstances minimumIpVolume = huge(1.0_pReal) totalVolume = 0.0_pReal - do e = 1_pInt,mesh_NcpElems - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + do e = 1_pInt,theMesh%nElems + do i = 1_pInt,theMesh%elem%nIPs if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then totalVolume = totalVolume + mesh_ipVolume(i,e) @@ -1462,8 +1459,8 @@ do instance = 1_pInt,maxNinstances meanDensity = 0.0_pReal do while(meanDensity < rhoSglRandom(instance)) call random_number(rnd) - e = nint(rnd(1)*real(mesh_NcpElems,pReal)+0.5_pReal,pInt) - i = nint(rnd(2)*real(FE_Nips(FE_geomtype(mesh_element(2,e))),pReal)+0.5_pReal,pInt) + e = nint(rnd(1)*real(theMesh%nElems,pReal)+0.5_pReal,pInt) + i = nint(rnd(2)*real(theMesh%elem%nIPs,pReal)+0.5_pReal,pInt) if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then s = nint(rnd(3)*real(ns,pReal)+0.5_pReal,pInt) @@ -1476,8 +1473,8 @@ do instance = 1_pInt,maxNinstances enddo ! homogeneous distribution of density with some noise else - do e = 1_pInt,mesh_NcpElems - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + do e = 1_pInt,theMesh%nElems + do i = 1_pInt,theMesh%elem%nIPs if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then do f = 1_pInt,lattice_maxNslipFamily @@ -1559,16 +1556,13 @@ use debug, only: & debug_i, & debug_e use mesh, only: & + theMesh, & mesh_element, & mesh_ipNeighborhood, & mesh_ipCoordinates, & mesh_ipVolume, & mesh_ipAreaNormal, & - mesh_ipArea, & - FE_NipNeighbors, & - mesh_maxNipNeighbors, & - FE_geomtype, & - FE_celltype + mesh_ipArea use material, only: & material_phase, & phase_localPlasticity, & @@ -1628,7 +1622,7 @@ real(pReal), dimension(3,3) :: invFe, & ! inverse of elast invFp, & ! inverse of plastic deformation gradient connections, & invConnections -real(pReal), dimension(3,mesh_maxNipNeighbors) :: & +real(pReal), dimension(3,theMesh%elem%nIPneighbors) :: & connection_latticeConf real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & rhoExcess @@ -1639,7 +1633,7 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))), & totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & myInteractionMatrix ! corrected slip interaction matrix -real(pReal), dimension(2,maxval(totalNslip),mesh_maxNipNeighbors) :: & +real(pReal), dimension(2,maxval(totalNslip),theMesh%elem%nIPneighbors) :: & neighbor_rhoExcess, & ! excess density at neighboring material point neighbor_rhoTotal ! total density at neighboring material point real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & @@ -1714,7 +1708,7 @@ if (.not. phase_localPlasticity(ph) .and. shortRangeStressCorrection(instance)) nRealNeighbors = 0_pInt neighbor_rhoTotal = 0.0_pReal - do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) + do n = 1_pInt,theMesh%elem%nIPneighbors neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) np = phaseAt(1,neighbor_ip,neighbor_el) @@ -2400,16 +2394,12 @@ use math, only: math_mul6x6, & math_det33, & math_transpose33, & pi -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & +use mesh, only: theMesh, & mesh_element, & mesh_ipNeighborhood, & mesh_ipVolume, & mesh_ipArea, & - mesh_ipAreaNormal, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype + mesh_ipAreaNormal use material, only: homogenization_maxNgrains, & material_phase, & phase_plasticityInstance, & @@ -2435,9 +2425,9 @@ integer(pInt), intent(in) :: ip, & real(pReal), intent(in) :: Temperature, & !< temperature timestep !< substepped crystallite time increment real(pReal), dimension(6), intent(in) :: Tstar_v !< current 2nd Piola-Kirchhoff stress in Mandel notation -real(pReal), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & subfrac !< fraction of timestep at the beginning of the substepped crystallite time increment -real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & Fe, & !< elastic deformation gradient Fp !< plastic deformation gradient @@ -2716,8 +2706,8 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then my_Fe = Fe(1:3,1:3,1_pInt,ip,el) my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,1_pInt,ip,el)) - do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) ! loop through my neighbors -! write(6,*) 'c' + do n = 1_pInt,theMesh%elem%nIPneighbors + neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) neighbor_n = mesh_ipNeighborhood(3,n,ip,el) @@ -3016,11 +3006,7 @@ use material, only: material_phase, & homogenization_maxNgrains use mesh, only: mesh_element, & mesh_ipNeighborhood, & - mesh_maxNips, & - mesh_NcpElems, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype + theMesh use lattice, only: lattice_sn, & lattice_sd, & lattice_qDisorientation @@ -3030,7 +3016,7 @@ implicit none !* input variables integer(pInt), intent(in) :: i, & ! ip index e ! element index -real(pReal), dimension(4,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(4,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & orientation ! crystal orientation in quaternions !* local variables @@ -3049,7 +3035,7 @@ integer(pInt) Nneighbors, & real(pReal), dimension(4) :: absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& - FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e))))) :: & + theMesh%elem%nIPneighbors) :: & my_compatibility ! my_compatibility for current element and ip real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & slipNormal, & @@ -3061,7 +3047,7 @@ logical, dimension(totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) belowThreshold -Nneighbors = FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e)))) +Nneighbors = theMesh%elem%nIPneighbors ph = material_phase(1,i,e) textureID = material_texture(1,i,e) instance = phase_plasticityInstance(ph) @@ -3174,15 +3160,12 @@ use math, only: math_mul33x33, & math_inv33, & math_transpose33, & pi -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & +use mesh, only: theMesh, & mesh_element, & mesh_node0, & mesh_cellCenterCoordinates, & mesh_ipVolume, & - mesh_periodicSurface, & - FE_Nips, & - FE_geomtype + mesh_periodicSurface use material, only: homogenization_maxNgrains, & material_phase, & plasticState, & @@ -3197,7 +3180,7 @@ implicit none !*** input variables integer(pInt), intent(in) :: ip, & !< current integration point el !< current element -real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & Fe !< elastic deformation gradient !*** output variables @@ -3295,8 +3278,8 @@ if (.not. phase_localPlasticity(ph)) then !* loop through all material points (also through their periodic images if present), !* but only consider nonlocal neighbors within a certain cutoff radius R - do neighbor_el = 1_pInt,mesh_NcpElems - ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))) + do neighbor_el = 1_pInt,theMesh%nElems + ipLoop: do neighbor_ip = 1_pInt,theMesh%elem%nIPs neighbor_phase = material_phase(1_pInt,neighbor_ip,neighbor_el) np = phaseAt(1,neighbor_ip,neighbor_el) no = phasememberAt(1,neighbor_ip,neighbor_el) @@ -3523,8 +3506,7 @@ function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) math_mul33x33, & pi use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & homogenization_maxNgrains, & material_phase, & @@ -3542,7 +3524,7 @@ function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) implicit none real(pReal), dimension(6), intent(in) :: & Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & + real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & Fe !< elastic deformation gradient integer(pInt), intent(in) :: & ip, & !< integration point From dcd16dda70b2e5ff94610fbafb1417bd95cdb115 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 12:15:05 +0100 Subject: [PATCH 112/309] variables from mesh object --- src/CPFEM.f90 | 15 +++++------- src/crystallite.f90 | 16 ++++++------- src/material.f90 | 56 ++++++++++++++++++++------------------------- 3 files changed, 38 insertions(+), 49 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index b0f1641e6..ba18f7d52 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -140,8 +140,7 @@ subroutine CPFEM_init restartRead, & modelName use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & material_phase, & homogState, & @@ -168,10 +167,9 @@ subroutine CPFEM_init flush(6) endif mainProcess - ! initialize stress and jacobian to zero - allocate(CPFEM_cs(6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_cs = 0.0_pReal - allocate(CPFEM_dcsdE(6,6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_dcsdE = 0.0_pReal - allocate(CPFEM_dcsdE_knownGood(6,6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_dcsdE_knownGood = 0.0_pReal + allocate(CPFEM_cs( 6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) + allocate(CPFEM_dcsdE( 6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) + allocate(CPFEM_dcsdE_knownGood(6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) ! *** restore the last converged values of each essential variable from the binary file if (restartRead) then @@ -289,8 +287,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt math_6toSym33 use mesh, only: & mesh_FEasCP, & - mesh_NcpElems, & - mesh_maxNips, & + theMesh, & mesh_element use material, only: & microstructure_elemhomo, & @@ -401,7 +398,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt enddo; enddo if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then write(6,'(a)') '<< CPFEM >> aging states' - if (debug_e <= mesh_NcpElems .and. debug_i <= mesh_maxNips) then + if (debug_e <= theMesh%Nelems .and. debug_i <= theMesh%elem%nIPs) then write(6,'(a,1x,i8,1x,i2,1x,i4,/,(12x,6(e20.8,1x)),/)') & '<< CPFEM >> aged state of elFE ip grain',debug_e, debug_i, 1, & plasticState(phaseAt(1,debug_i,debug_e))%state(:,phasememberAt(1,debug_i,debug_e)) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 1eb2dff28..c272abd07 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1745,9 +1745,8 @@ end subroutine integrateStateEuler !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler() use mesh, only: & - mesh_element, & - mesh_NcpElems, & - mesh_maxNips + theMesh, & + mesh_element use material, only: & homogenization_Ngrains, & plasticState, & @@ -1771,11 +1770,11 @@ subroutine integrateStateAdaptiveEuler() ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_plastic real(pReal), dimension(constitutive_source_maxSizeDotState,& maxval(phase_Nsources), & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_source !-------------------------------------------------------------------------------------------------- @@ -1922,8 +1921,7 @@ end subroutine integrateStateRK4 subroutine integrateStateRKCK45() use mesh, only: & mesh_element, & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & homogenization_Ngrains, & plasticState, & @@ -1970,11 +1968,11 @@ subroutine integrateStateRKCK45() ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of RKCK45 real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_plastic ! relative residuum from evolution in microstructure real(pReal), dimension(constitutive_source_maxSizeDotState, & maxval(phase_Nsources), & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_source ! relative residuum from evolution in microstructure diff --git a/src/material.f90 b/src/material.f90 index dbf5433c6..4160c906e 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -305,8 +305,7 @@ subroutine material_init() texture_name use mesh, only: & mesh_homogenizationAt, & - mesh_NipsPerElem, & - mesh_NcpElems + theMesh implicit none integer(pInt), parameter :: FILEUNIT = 210_pInt @@ -398,10 +397,10 @@ subroutine material_init() call material_populateGrains ! BEGIN DEPRECATED - allocate(phaseAt ( homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt) - allocate(phasememberAt ( homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt) - allocate(mappingHomogenization (2, mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt) - allocate(mappingHomogenizationConst( mesh_nIPsPerElem,mesh_NcpElems),source=1_pInt) + allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) + allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) + allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) + allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1_pInt) ! END DEPRECATED allocate(material_homogenizationAt,source=mesh_homogenizationAt) @@ -409,9 +408,9 @@ subroutine material_init() allocate(CounterHomogenization(size(config_homogenization)),source=0_pInt) ! BEGIN DEPRECATED - do e = 1_pInt,mesh_NcpElems + do e = 1_pInt,theMesh%Nelems myHomog = mesh_homogenizationAt(e) - do i = 1_pInt, mesh_NipsPerElem + do i = 1_pInt, theMesh%elem%nIPs CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),myHomog] do g = 1_pInt,homogenization_Ngrains(myHomog) @@ -552,7 +551,7 @@ subroutine material_parseMicrostructure microstructure_name use mesh, only: & mesh_microstructureAt, & - mesh_NcpElems + theMesh implicit none character(len=65536), dimension(:), allocatable :: & @@ -570,7 +569,7 @@ subroutine material_parseMicrostructure if(any(mesh_microstructureAt > size(config_microstructure))) & call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') - forall (e = 1_pInt:mesh_NcpElems) & + forall (e = 1_pInt:theMesh%Nelems) & microstructure_active(mesh_microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements do m=1_pInt, size(config_microstructure) @@ -983,11 +982,9 @@ subroutine material_populateGrains math_sampleFiberOri, & math_symmetricEulers use mesh, only: & - mesh_NipsPerElem, & - mesh_elemType, & mesh_homogenizationAt, & mesh_microstructureAt, & - mesh_NcpElems, & + theMesh, & mesh_ipVolume use config, only: & config_homogenization, & @@ -1024,24 +1021,24 @@ subroutine material_populateGrains myDebug = debug_level(debug_material) - allocate(material_volume(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0.0_pReal) - allocate(material_phase(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt) - allocate(material_homog(mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt) - allocate(material_texture(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt) - allocate(material_EulerAngles(3,homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0.0_pReal) + allocate(material_volume(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0.0_pReal) + allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_homog(theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal) allocate(Ngrains(size(config_homogenization),size(config_microstructure)), source=0_pInt) allocate(Nelems (size(config_homogenization),size(config_microstructure)), source=0_pInt) ! populating homogenization schemes in each !-------------------------------------------------------------------------------------------------- - do e = 1_pInt, mesh_NcpElems - material_homog(1_pInt:mesh_NipsPerElem,e) = mesh_homogenizationAt(e) + do e = 1_pInt, theMesh%Nelems + material_homog(1_pInt:theMesh%elem%nIPs,e) = mesh_homogenizationAt(e) enddo !-------------------------------------------------------------------------------------------------- ! precounting of elements for each homog/micro pair - do e = 1_pInt, mesh_NcpElems + do e = 1_pInt, theMesh%Nelems homog = mesh_homogenizationAt(e) micro = mesh_microstructureAt(e) Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt @@ -1059,8 +1056,7 @@ subroutine material_populateGrains !-------------------------------------------------------------------------------------------------- ! identify maximum grain count per IP (from element) and find grains per homog/micro pair Nelems = 0_pInt ! reuse as counter - elementLooping: do e = 1_pInt,mesh_NcpElems - t = mesh_elemType + elementLooping: do e = 1_pInt,theMesh%Nelems homog = mesh_homogenizationAt(e) micro = mesh_microstructureAt(e) if (homog < 1_pInt .or. homog > size(config_homogenization)) & ! out of bounds @@ -1070,7 +1066,7 @@ subroutine material_populateGrains if (microstructure_elemhomo(micro)) then ! how many grains are needed at this element? dGrains = homogenization_Ngrains(homog) ! only one set of Ngrains (other IPs are plain copies) else - dGrains = homogenization_Ngrains(homog) * mesh_NipsPerElem ! each IP has Ngrains + dGrains = homogenization_Ngrains(homog) * theMesh%elem%nIPs ! each IP has Ngrains endif Ngrains(homog,micro) = Ngrains(homog,micro) + dGrains ! total grain count Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt ! total element count @@ -1104,16 +1100,15 @@ subroutine material_populateGrains do hme = 1_pInt, Nelems(homog,micro) e = elemsOfHomogMicro(homog,micro)%p(hme) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex - t = mesh_elemType if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs - volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:mesh_NipsPerElem,e))/& + volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:theMesh%elem%nIPs,e))/& real(dGrains,pReal) ! each grain combines size of all IPs in that element grain = grain + dGrains ! wind forward by Ngrains@IP else - forall (i = 1_pInt:mesh_NipsPerElem) & ! loop over IPs + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over IPs volumeOfGrain(grain+(i-1)*dGrains+1_pInt:grain+i*dGrains) = & mesh_ipVolume(i,e)/real(dGrains,pReal) ! assign IPvolume/Ngrains@IP to all grains of IP - grain = grain + mesh_NipsPerElem * dGrains ! wind forward by Nips*Ngrains@IP + grain = grain + theMesh%elem%nIPs * dGrains ! wind forward by Nips*Ngrains@IP endif enddo @@ -1259,11 +1254,10 @@ subroutine material_populateGrains do hme = 1_pInt, Nelems(homog,micro) e = elemsOfHomogMicro(homog,micro)%p(hme) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex - t = mesh_elemType if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs m = 1_pInt ! process only first IP else - m = mesh_NipsPerElem + m = theMesh%elem%nIPs endif do i = 1_pInt, m ! loop over necessary IPs @@ -1301,7 +1295,7 @@ subroutine material_populateGrains enddo - do i = i, mesh_NipsPerElem ! loop over IPs to (possibly) distribute copies from first IP + do i = i, theMesh%elem%nIPs ! loop over IPs to (possibly) distribute copies from first IP material_volume (1_pInt:dGrains,i,e) = material_volume (1_pInt:dGrains,1,e) material_phase (1_pInt:dGrains,i,e) = material_phase (1_pInt:dGrains,1,e) material_texture(1_pInt:dGrains,i,e) = material_texture(1_pInt:dGrains,1,e) From 4f2a3d7f5505469e379c310fcd242d90afca890f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 12:23:53 +0100 Subject: [PATCH 113/309] unused variables --- src/mesh_FEM.f90 | 2 -- src/mesh_abaqus.f90 | 4 ---- src/mesh_grid.f90 | 9 +-------- src/mesh_marc.f90 | 4 ---- 4 files changed, 1 insertion(+), 18 deletions(-) diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index e2b08db4c..ed80cbcba 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -27,7 +27,6 @@ use PETScis mesh_NcpElems, & !< total number of CP elements in mesh mesh_NcpElemsGlobal, & mesh_Nnodes, & !< total number of nodes in mesh - mesh_NipsPerElem, & !< number of IPs in per element mesh_maxNipNeighbors !!!! BEGIN DEPRECATED !!!!! integer(pInt), public, protected :: & @@ -269,7 +268,6 @@ subroutine mesh_init() !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NipsPerElem = mesh_maxNips ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 05e1d7c7d..74401e5e5 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -18,7 +18,6 @@ module mesh mesh_Nnodes, & !< total number of nodes in mesh mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh - mesh_NipsPerElem, & !< number of IPs in per element mesh_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node @@ -33,7 +32,6 @@ module mesh mesh_microstructureAt !< microstructure ID of each element integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_CPnodeID, & !< nodes forming an element mesh_element, & !DEPRECATED mesh_sharedElem, & !< entryCount and list of elements containing node mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) @@ -532,12 +530,10 @@ subroutine mesh_init(ip,el) !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NipsPerElem = mesh_maxNips mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) - mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) contains diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 88484a693..3d3680935 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -14,11 +14,9 @@ module mesh private integer(pInt), public, protected :: & mesh_NcpElems, & !< total number of CP elements in local mesh - mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes) mesh_Nnodes, & !< total number of nodes in mesh mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh - mesh_NipsPerElem, & !< number of IPs in per element mesh_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node @@ -35,10 +33,7 @@ module mesh mesh_microstructureAt !< microstructure ID of each element integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_CPnodeID, & !< nodes forming an element - mesh_element, & !DEPRECATED - mesh_sharedElem, & !< entryCount and list of elements containing node - mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) + mesh_element !< entryCount and list of elements containing node integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] @@ -435,12 +430,10 @@ subroutine mesh_init(ip,el) !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NipsPerElem = mesh_maxNips mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) - mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index dd4098879..c20bf84d7 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -18,7 +18,6 @@ module mesh mesh_Nnodes, & !< total number of nodes in mesh mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh - mesh_NipsPerElem, & !< number of IPs in per element mesh_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node @@ -33,7 +32,6 @@ module mesh mesh_microstructureAt !< microstructure ID of each element integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_CPnodeID, & !< nodes forming an element mesh_element, & !DEPRECATED mesh_sharedElem, & !< entryCount and list of elements containing node mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) @@ -552,12 +550,10 @@ subroutine mesh_init(ip,el) !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NipsPerElem = mesh_maxNips mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) - mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) call theMesh%setNelems(mesh_NcpElems) From b514bf78a5f225aa0b5216978d67407678bc4aac Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 12:31:07 +0100 Subject: [PATCH 114/309] avoiding duplicated variables --- src/mesh_grid.f90 | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 3d3680935..875993290 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -22,7 +22,6 @@ module mesh mesh_maxNsharedElems !< max number of CP elements sharing a node !!!! BEGIN DEPRECATED !!!!! integer(pInt), public, protected :: & - mesh_maxNips, & !< max number of IPs in any CP element mesh_maxNcellnodes !< max number of cell nodes in any CP element !!!! BEGIN DEPRECATED !!!!! @@ -393,10 +392,9 @@ subroutine mesh_init(ip,el) call theMesh%init(mesh_node) ! For compatibility - mesh_maxNips = theMesh%elem%nIPs mesh_maxNipNeighbors = theMesh%elem%nIPneighbors mesh_maxNcellnodes = theMesh%elem%Ncellnodes - +call theMesh%setNelems(mesh_NcpElems) call mesh_spectral_build_elements() @@ -435,7 +433,7 @@ subroutine mesh_init(ip,el) mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%setNelems(mesh_NcpElems) + end subroutine mesh_init !-------------------------------------------------------------------------------------------------- @@ -459,7 +457,7 @@ subroutine mesh_build_cellconnectivity matchingNodeID, & localCellnodeID - allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) + allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,mesh_NcpElems), source=0_pInt) allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) @@ -563,7 +561,7 @@ subroutine mesh_build_ipVolumes real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + allocate(mesh_ipVolume(theMesh%elem%nIPs,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) @@ -634,7 +632,7 @@ subroutine mesh_build_ipCoordinates real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & - allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) do e = 1_pInt,mesh_NcpElems ! loop over cpElems @@ -989,7 +987,7 @@ subroutine mesh_spectral_build_ipNeighborhood integer(pInt) :: & x,y,z, & e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems),source=0_pInt) e = 0_pInt do z = 0_pInt,grid3-1_pInt @@ -1136,8 +1134,8 @@ subroutine mesh_build_ipAreas real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal - allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) do e = 1_pInt,mesh_NcpElems ! loop over cpElems From 933136ec1e3486765f6373476e50ede8010380b5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 13:10:21 +0100 Subject: [PATCH 115/309] nNodes form element is used already --- src/mesh_base.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index c0f012256..5afdbc3ad 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -1,3 +1,4 @@ + !-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH @@ -66,6 +67,7 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes) self%type = meshType call self%elem%init(elemType) self%node0 = nodes + self%nNodes = size(nodes,2) end subroutine tMesh_base_init From 3edbfc1cb5759474bac68feca7de299f374b5de3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 15:10:35 +0100 Subject: [PATCH 116/309] bugfix: infinite loop for geom file without new line at end also, a lot of cleaning --- src/IO.f90 | 12 +- src/mesh_grid.f90 | 1483 ++++++++++----------------------------------- 2 files changed, 339 insertions(+), 1156 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 5c86ee966..bef14ea1e 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -1329,11 +1329,9 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) ! DAMASK_marc errors case (700_pInt) msg = 'invalid materialpoint result requested' - case (701_pInt) - msg = 'not supported input file format, use Marc 2016 or earlier' !------------------------------------------------------------------------------------------------- -! errors related to spectral solver +! errors related to the grid solver case (809_pInt) msg = 'initializing FFTW' case (810_pInt) @@ -1355,13 +1353,9 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) case (841_pInt) msg = 'missing header length info in spectral mesh' case (842_pInt) - msg = 'homogenization in spectral mesh' - case (843_pInt) - msg = 'grid in spectral mesh' - case (844_pInt) - msg = 'size in spectral mesh' - case (845_pInt) msg = 'incomplete information in spectral mesh header' + case (843_pInt) + msg = 'microstructure count mismatch' case (846_pInt) msg = 'rotation for load case rotation ill-defined (R:RT != I)' case (847_pInt) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 875993290..d3741b766 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -13,17 +13,12 @@ module mesh implicit none private integer(pInt), public, protected :: & - mesh_NcpElems, & !< total number of CP elements in local mesh mesh_Nnodes, & !< total number of nodes in mesh mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh - mesh_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node -!!!! BEGIN DEPRECATED !!!!! - integer(pInt), public, protected :: & - mesh_maxNcellnodes !< max number of cell nodes in any CP element -!!!! BEGIN DEPRECATED !!!!! + integer(pInt), dimension(:), allocatable, private :: & microGlobal @@ -66,135 +61,22 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell integer(pInt), dimension(:,:,:), allocatable, private :: & - FE_nodesAtIP, & !< map IP index to node indices in a specific type of element - FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element - FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell - real(pReal), dimension(:,:,:), allocatable, private :: & - FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! Hence, I suggest to prefix with "FE_" - integer(pInt), parameter, public :: & - FE_Nelemtypes = 13_pInt, & + integer(pInt), parameter, private :: & FE_Ngeomtypes = 10_pInt, & FE_Ncelltypes = 4_pInt, & - FE_maxNnodes = 20_pInt, & - FE_maxNips = 27_pInt, & - FE_maxNipNeighbors = 6_pInt, & - FE_maxmaxNnodesAtIP = 8_pInt, & !< max number of (equivalent) nodes attached to an IP FE_maxNmatchingNodesPerFace = 4_pInt, & FE_maxNfaces = 6_pInt, & - FE_maxNcellnodes = 64_pInt, & FE_maxNcellnodesPerCell = 8_pInt, & FE_maxNcellfaces = 6_pInt, & FE_maxNcellnodesPerCellface = 4_pInt - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type - int([ & - 1, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 3, & ! element 11 (2D 4node 4ip) - 4, & ! element 27 (2D 8node 9ip) - 3, & ! element 54 (2D 8node 4ip) - 5, & ! element 134 (3D 4node 1ip) - 6, & ! element 157 (3D 5node 4ip) - 6, & ! element 127 (3D 10node 4ip) - 7, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 9, & ! element 7 (3D 8node 8ip) - 9, & ! element 57 (3D 20node 8ip) - 10 & ! element 21 (3D 20node 27ip) - ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type - int([ & - 1, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 4, & ! element 136 (3D 6node 6ip) - 4, & ! element 117 (3D 8node 1ip) - 4, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type - int([ & - 2, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 3, & ! element 127 (3D 10node 4ip) - 3, & ! element 136 (3D 6node 6ip) - 3, & ! element 117 (3D 8node 1ip) - 3, & ! element 7 (3D 8node 8ip) - 3 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element - int([ & - 3, & ! element 6 (2D 3node 1ip) - 6, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 8, & ! element 27 (2D 8node 9ip) - 8, & ! element 54 (2D 8node 4ip) - 4, & ! element 134 (3D 4node 1ip) - 5, & ! element 157 (3D 5node 4ip) - 10, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 20, & ! element 57 (3D 20node 8ip) - 20 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nfaces = & !< number of faces of a specific type of element geometry - int([ & - 3, & ! element 6 (2D 3node 1ip) - 3, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 4, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 5, & ! element 136 (3D 6node 6ip) - 6, & ! element 117 (3D 8node 1ip) - 6, & ! element 7 (3D 8node 8ip) - 6 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry - int([ & - 3, & ! element 6 (2D 3node 1ip) - 3, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 4, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 8 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type - int([ & - 3, & ! element 6 (2D 3node 1ip) - 7, & ! element 125 (2D 6node 3ip) - 9, & ! element 11 (2D 4node 4ip) - 16, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 15, & ! element 127 (3D 10node 4ip) - 21, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 27, & ! element 7 (3D 8node 8ip) - 64 & ! element 21 (3D 20node 27ip) - ],pInt) integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCell = & !< number of cell nodes in a specific cell type int([ & @@ -212,21 +94,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element - int([ & - 1, & ! element 6 (2D 3node 1ip) - 3, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 9, & ! element 27 (2D 8node 9ip) - 1, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 1, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 27 & ! element 21 (3D 20node 27ip) - ],pInt) - integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type int([& 3, & ! (2D 3node) 4, & ! (2D 4node) @@ -235,21 +104,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_maxNnodesAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element - int([ & - 3, & ! element 6 (2D 3node 1ip) - 1, & ! element 125 (2D 6node 3ip) - 1, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 1, & ! element 127 (3D 10node 4ip) - 1, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 1, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(3), public, protected :: & grid !< (global) grid integer(pInt), public, protected :: & @@ -356,8 +210,7 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - - call mesh_build_FEdata ! get properties of the different types of elements + mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) @@ -381,7 +234,7 @@ subroutine mesh_init(ip,el) grid3Offset = int(local_K_offset,pInt) size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) - mesh_NcpElems= product(grid(1:2))*grid3 + mesh_NcpElemsGlobal = product(grid) mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) @@ -393,13 +246,14 @@ subroutine mesh_init(ip,el) ! For compatibility mesh_maxNipNeighbors = theMesh%elem%nIPneighbors - mesh_maxNcellnodes = theMesh%elem%Ncellnodes -call theMesh%setNelems(mesh_NcpElems) +call theMesh%setNelems(product(grid(1:2))*grid3) call mesh_spectral_build_elements() if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - + + + call mesh_build_FEdata ! get properties of the different types of elements call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -415,265 +269,26 @@ call theMesh%setNelems(mesh_NcpElems) if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (debug_e < 1 .or. debug_e > mesh_NcpElems) & + if (debug_e < 1 .or. debug_e > theMesh%nElems) & call IO_error(602_pInt,ext_msg='element') ! selected element does not exist - if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & + if (debug_i < 1 .or. debug_i > theMesh%elem%nIPs) & call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP - FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements - allocate(FEsolving_execIP(2_pInt,mesh_NcpElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... - forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element + FEsolving_execElem = [ 1_pInt,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements + allocate(FEsolving_execIP(2_pInt,theMesh%nElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... + forall (j = 1_pInt:theMesh%nElems) FEsolving_execIP(2,j) = theMesh%elem%nIPs ! ...up to own IP count for each element !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - + deallocate(mesh_cell) end subroutine mesh_init -!-------------------------------------------------------------------------------------------------- -!> @brief Split CP elements into cells. -!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). -!> Cell nodes that are also matching nodes are unique in the list of cell nodes, -!> all others (currently) might be stored more than once. -!> Also allocates the 'mesh_node' array. -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_cellconnectivity - - implicit none - integer(pInt), dimension(:), allocatable :: & - matchingNode2cellnode - integer(pInt), dimension(:,:), allocatable :: & - cellnodeParent - integer(pInt), dimension(mesh_maxNcellnodes) :: & - localCellnode2globalCellnode - integer(pInt) :: & - e,t,g,c,n,i, & - matchingNodeID, & - localCellnodeID - - allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,mesh_NcpElems), source=0_pInt) - allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) - -!-------------------------------------------------------------------------------------------------- -! Count cell nodes (including duplicates) and generate cell connectivity list - mesh_Ncellnodes = 0_pInt - mesh_Ncells = 0_pInt - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - localCellnode2globalCellnode = 0_pInt - mesh_Ncells = mesh_Ncells + FE_Nips(g) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell - localCellnodeID = FE_cell(n,i,g) - if (localCellnodeID <= FE_NmatchingNodes(g)) then ! this cell node is a matching node - matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) - if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... - matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID - endif - mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) - else ! this cell node is no matching node - if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... - localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID - endif - mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) - endif - enddo - enddo - enddo - - allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) - allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) - forall(n = 1_pInt:mesh_Ncellnodes) - mesh_cellnodeParent(1,n) = cellnodeParent(1,n) - mesh_cellnodeParent(2,n) = cellnodeParent(2,n) - endforall - -end subroutine mesh_build_cellconnectivity - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculate position of cellnodes from the given position of nodes -!> Build list of cellnodes' coordinates. -!> Cellnode coordinates are calculated from a weighted sum of node coordinates. -!-------------------------------------------------------------------------------------------------- -function mesh_build_cellnodes(nodes,Ncellnodes) - - implicit none - integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes - real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes - real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes - - integer(pInt) :: & - e,t,n,m, & - localCellnodeID - real(pReal), dimension(3) :: & - myCoords - - mesh_build_cellnodes = 0.0_pReal -!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) - do n = 1_pInt,Ncellnodes ! loop over cell nodes - e = mesh_cellnodeParent(1,n) - localCellnodeID = mesh_cellnodeParent(2,n) - t = mesh_element(2,e) ! get element type - myCoords = 0.0_pReal - do m = 1_pInt,FE_Nnodes(t) - myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & - * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) - enddo - mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) - enddo -!$OMP END PARALLEL DO - -end function mesh_build_cellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' -!> @details The IP volume is calculated differently depending on the cell type. -!> 2D cells assume an element depth of one in order to calculate the volume. -!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal -!> shape with a cell face as basis and the central ip at the tip. This subvolume is -!> calculated as an average of four tetrahedals with three corners on the cell face -!> and one corner at the central ip. -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_ipVolumes - use math, only: & - math_volTetrahedron, & - math_areaTriangle - - implicit none - integer(pInt) :: e,t,g,c,i,m,f,n - real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - - - allocate(mesh_ipVolume(theMesh%elem%nIPs,mesh_NcpElems),source=0.0_pReal) - - - !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - select case (c) - - case (1_pInt) ! 2D 3node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element - mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & - mesh_cellnode(1:3,mesh_cell(2,i,e)), & - mesh_cellnode(1:3,mesh_cell(3,i,e))) - - case (2_pInt) ! 2D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element - mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices - mesh_cellnode(1:3,mesh_cell(2,i,e)), & - mesh_cellnode(1:3,mesh_cell(3,i,e))) & - + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & - mesh_cellnode(1:3,mesh_cell(4,i,e)), & - mesh_cellnode(1:3,mesh_cell(1,i,e))) - - case (3_pInt) ! 3D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element - mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & - mesh_cellnode(1:3,mesh_cell(2,i,e)), & - mesh_cellnode(1:3,mesh_cell(3,i,e)), & - mesh_cellnode(1:3,mesh_cell(4,i,e))) - - case (4_pInt) ! 3D 8node - m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - subvolume = 0.0_pReal - forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & - subvolume(n,f) = math_volTetrahedron(& - mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & - mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & - mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & - mesh_ipCoordinates(1:3,i,e)) - mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two - enddo - - end select - enddo - !$OMP END PARALLEL DO - -end subroutine mesh_build_ipVolumes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' -! Called by all solvers in mesh_init in order to initialize the ip coordinates. -! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, -! so no need to use this subroutine anymore; Marc however only provides nodal displacements, -! so in this case the ip coordinates are always calculated on the basis of this subroutine. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, -! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. -! HAS TO BE CHANGED IN A LATER VERSION. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_ipCoordinates - - implicit none - integer(pInt) :: e,t,g,c,i,n - real(pReal), dimension(3) :: myCoords - - if (.not. allocated(mesh_ipCoordinates)) & - allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,mesh_NcpElems),source=0.0_pReal) - - !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - myCoords = 0.0_pReal - 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 / real(FE_NcellnodesPerCell(c),pReal) - enddo - enddo - !$OMP END PARALLEL DO - -end subroutine mesh_build_ipCoordinates - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates cell center coordinates. -!-------------------------------------------------------------------------------------------------- -pure function mesh_cellCenterCoordinates(ip,el) - - implicit none - integer(pInt), intent(in) :: el, & !< element number - ip !< integration point number - real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell - integer(pInt) :: t,g,c,n - - t = mesh_element(2_pInt,el) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - mesh_cellCenterCoordinates = 0.0_pReal - 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 / real(FE_NcellnodesPerCell(c),pReal) - -end function mesh_cellCenterCoordinates - !-------------------------------------------------------------------------------------------------- !> @brief Parses geometry file @@ -695,12 +310,10 @@ subroutine mesh_spectral_read_grid() character(len=:), allocatable :: rawData character(len=65536) :: line integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt), dimension(3) :: g = -1_pInt - real(pReal), dimension(3) :: s = -1_pInt integer(pInt) :: h =- 1_pInt integer(pInt) :: & headerLength = -1_pInt, & !< length of header (in lines) - fileLength, & !< lenght of the geom file (in characters) + fileLength, & !< length of the geom file (in characters) fileUnit, & startPos, endPos, & myStat, & @@ -709,10 +322,9 @@ subroutine mesh_spectral_read_grid() o, & !< order of "to" packing e, & !< "element", i.e. spectral collocation point i, j - logical :: & - gotGrid = .false., & - gotSize = .false., & - gotHomogenization = .false. + + grid = -1_pInt + geomSize = -1.0_pReal !-------------------------------------------------------------------------------------------------- ! read data as stream @@ -728,6 +340,7 @@ subroutine mesh_spectral_read_grid() ! get header length endPos = index(rawData,new_line('')) if(endPos <= index(rawData,'head')) then + startPos = len(rawData) call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid') else chunkPos = IO_stringPos(rawData(1:endPos)) @@ -741,52 +354,58 @@ subroutine mesh_spectral_read_grid() l = 0 do while (l < headerLength .and. startPos < len(rawData)) endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + if (endPos < startPos) endPos = len(rawData) ! end of file without new line line = rawData(startPos:endPos) startPos = endPos + 1_pInt l = l + 1_pInt - ! cycle empty lines chunkPos = IO_stringPos(trim(line)) - select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) ) + if (chunkPos(1) < 2) cycle ! need at least one keyword value pair + select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) ) case ('grid') - if (chunkPos(1) > 6) gotGrid = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('a') - g(1) = IO_intValue(line,chunkPos,j+1_pInt) - case('b') - g(2) = IO_intValue(line,chunkPos,j+1_pInt) - case('c') - g(3) = IO_intValue(line,chunkPos,j+1_pInt) - end select - enddo + if (chunkPos(1) > 6) then + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('a') + grid(1) = IO_intValue(line,chunkPos,j+1_pInt) + case('b') + grid(2) = IO_intValue(line,chunkPos,j+1_pInt) + case('c') + grid(3) = IO_intValue(line,chunkPos,j+1_pInt) + end select + enddo + endif case ('size') - if (chunkPos(1) > 6) gotSize = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('x') - s(1) = IO_floatValue(line,chunkPos,j+1_pInt) - case('y') - s(2) = IO_floatValue(line,chunkPos,j+1_pInt) - case('z') - s(3) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo + if (chunkPos(1) > 6) then + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('x') + geomSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) + case('y') + geomSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) + case('z') + geomSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) + end select + enddo + endif case ('homogenization') - if (chunkPos(1) > 1) gotHomogenization = .true. - h = IO_intValue(line,chunkPos,2_pInt) - + if (chunkPos(1) > 1) h = IO_intValue(line,chunkPos,2_pInt) end select enddo !-------------------------------------------------------------------------------------------------- -! global data - grid = g - geomSize = s +! sanity checks + if(h < 1_pInt) & + call IO_error(error_ID = 842_pInt, ext_msg='homogenization (mesh_spectral_read_grid)') + if(any(grid < 1_pInt)) & + call IO_error(error_ID = 842_pInt, ext_msg='grid (mesh_spectral_read_grid)') + if(any(geomSize < 0.0_pReal)) & + call IO_error(error_ID = 842_pInt, ext_msg='size (mesh_spectral_read_grid)') + allocate(microGlobal(product(grid)), source = -1_pInt) !-------------------------------------------------------------------------------------------------- @@ -794,52 +413,34 @@ subroutine mesh_spectral_read_grid() e = 1_pInt do while (startPos < len(rawData)) endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + if (endPos < startPos) endPos = len(rawData) ! end of file without new line line = rawData(startPos:endPos) startPos = endPos + 1_pInt l = l + 1_pInt - chunkPos = IO_stringPos(trim(line)) - if (chunkPos(1) == 3) then - if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then + + possibleCompression: if (chunkPos(1) /= 3) then + c = chunkPos(1) + microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] + else possibleCompression + compression: if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then c = IO_intValue(line,chunkPos,1) microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))] - else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then + else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then compression c = abs(IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1)) + 1_pInt o = merge(+1_pInt, -1_pInt, IO_intValue(line,chunkPos,3) > IO_intValue(line,chunkPos,1)) microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)] - else + else compression c = chunkPos(1) - do i = 0_pInt, c - 1_pInt - microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) - enddo - endif - else - c = chunkPos(1) - do i = 0_pInt, c - 1_pInt - microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) - enddo + microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] + endif compression + endif possibleCompression - endif e = e+c end do - if (e-1 /= product(grid)) print*, 'mist', e + if (e-1 /= product(grid)) call IO_error(error_ID = 843_pInt, el=e) -! if (.not. gotGrid) & -! call IO_error(error_ID = 845_pInt, ext_msg='grid') -! if(any(mesh_spectral_getGrid < 1_pInt)) & -! call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') - -! if (.not. gotSize) & -! call IO_error(error_ID = 845_pInt, ext_msg='size') -! if (any(mesh_spectral_getSize<=0.0_pReal)) & -! call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') - -! if (.not. gotHomogenization ) & -! call IO_error(error_ID = 845_pInt, ext_msg='homogenization') -! if (mesh_spectral_getHomogenization<1_pInt) & -! call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') - end subroutine mesh_spectral_read_grid @@ -866,7 +467,6 @@ integer(pInt) function mesh_spectral_getHomogenization() integer(pInt) :: i, myFileUnit logical :: gotHomogenization = .false. - myFileUnit = 289_pInt call IO_open_file(myFileUnit,trim(geometryFile)) @@ -941,7 +541,7 @@ subroutine mesh_spectral_build_elements() IO_error implicit none integer(pInt) :: & - e, i, & + e, & homog, & elemOffset @@ -950,12 +550,12 @@ subroutine mesh_spectral_build_elements() homog = mesh_spectral_getHomogenization() - allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) + allocate(mesh_element (4_pInt+8_pInt,theMesh%nElems), source = 0_pInt) elemOffset = product(grid(1:2))*grid3Offset e = 0_pInt - do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) + do while (e < theMesh%nElems) ! fill expected number of elements, stop at end of data (or blank line!) e = e+1_pInt ! valid element entry mesh_element( 1,e) = -1_pInt ! DEPRECATED mesh_element( 2,e) = 10_pInt @@ -972,7 +572,7 @@ subroutine mesh_spectral_build_elements() mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt enddo - if (e /= mesh_NcpElems) call IO_error(880_pInt,e) + if (e /= theMesh%nElems) call IO_error(880_pInt,e) end subroutine mesh_spectral_build_elements @@ -987,7 +587,7 @@ subroutine mesh_spectral_build_ipNeighborhood integer(pInt) :: & x,y,z, & e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems),source=0_pInt) + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems),source=0_pInt) e = 0_pInt do z = 0_pInt,grid3-1_pInt @@ -1122,6 +722,260 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) end function mesh_nodesAroundCentres +!################################################################################################################# +!################################################################################################################# +!################################################################################################################# +! The following routines are not solver specific and should be included in mesh_base (most likely in modified form) +!################################################################################################################# +!################################################################################################################# +!################################################################################################################# + + + +!-------------------------------------------------------------------------------------------------- +!> @brief Split CP elements into cells. +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> all others (currently) might be stored more than once. +!> Also allocates the 'mesh_node' array. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_cellconnectivity + + implicit none + integer(pInt), dimension(:), allocatable :: & + matchingNode2cellnode + integer(pInt), dimension(:,:), allocatable :: & + cellnodeParent + integer(pInt), dimension(theMesh%elem%Ncellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + e,n,i, & + matchingNodeID, & + localCellnodeID + + integer(pInt), dimension(FE_Ngeomtypes), parameter :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 8 & ! element 21 (3D 20node 27ip) + ],pInt) + + allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,theMesh%nElems), source=0_pInt) + allocate(matchingNode2cellnode(theMesh%nNodes), source=0_pInt) + allocate(cellnodeParent(2_pInt,theMesh%elem%Ncellnodes*theMesh%nElems), source=0_pInt) + + mesh_Ncells = theMesh%nElems*theMesh%elem%nIPs +!-------------------------------------------------------------------------------------------------- +! Count cell nodes (including duplicates) and generate cell connectivity list + mesh_Ncellnodes = 0_pInt + + do e = 1_pInt,theMesh%nElems + localCellnode2globalCellnode = 0_pInt + do i = 1_pInt,theMesh%elem%nIPs + do n = 1_pInt,theMesh%elem%NcellnodesPerCell + localCellnodeID = theMesh%elem%cell(n,i) + if (localCellnodeID <= FE_NmatchingNodes(theMesh%elem%geomType)) then ! this cell node is a matching node + matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) + if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) + else ! this cell node is no matching node + if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) + endif + enddo + enddo + enddo + + allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + + forall(n = 1_pInt:mesh_Ncellnodes) + mesh_cellnodeParent(1,n) = cellnodeParent(1,n) + mesh_cellnodeParent(2,n) = cellnodeParent(2,n) + endforall + +end subroutine mesh_build_cellconnectivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate position of cellnodes from the given position of nodes +!> Build list of cellnodes' coordinates. +!> Cellnode coordinates are calculated from a weighted sum of node coordinates. +!-------------------------------------------------------------------------------------------------- +function mesh_build_cellnodes(nodes,Ncellnodes) + + implicit none + integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes + real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes + real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes + + integer(pInt) :: & + e,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,myCoords) + do n = 1_pInt,Ncellnodes ! loop over cell nodes + e = mesh_cellnodeParent(1,n) + localCellnodeID = mesh_cellnodeParent(2,n) + myCoords = 0.0_pReal + do m = 1_pInt,theMesh%elem%nNodes + myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + * theMesh%elem%cellNodeParentNodeWeights(m,localCellnodeID) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(theMesh%elem%cellNodeParentNodeWeights(:,localCellnodeID)) + enddo +!$OMP END PARALLEL DO + +end function mesh_build_cellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipVolumes + use math, only: & + math_volTetrahedron, & + math_areaTriangle + + implicit none + integer(pInt) :: e,t,g,c,i,m,f,n + real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume + + + allocate(mesh_ipVolume(theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) + + + !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) + do e = 1_pInt,theMesh%nElems ! loop over cpElems + select case (theMesh%elem%cellType) + + case (1_pInt) ! 2D 3node + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) + + case (2_pInt) ! 2D 4node + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) & + + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e)), & + mesh_cellnode(1:3,mesh_cell(1,i,e))) + + case (3_pInt) ! 3D 4node + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e))) + + case (4_pInt) + c = theMesh%elem%cellType ! 3D 8node + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element + subvolume = 0.0_pReal + forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & + subvolume(n,f) = math_volTetrahedron(& + mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & + mesh_ipCoordinates(1:3,i,e)) + mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipCoordinates + + implicit none + integer(pInt) :: e,c,i,n + real(pReal), dimension(3) :: myCoords + + if (.not. allocated(mesh_ipCoordinates)) & + allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(c,myCoords) + do e = 1_pInt,theMesh%nElems ! loop over cpElems + c = theMesh%elem%cellType + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element + myCoords = 0.0_pReal + 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 / real(FE_NcellnodesPerCell(c),pReal) + enddo + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), intent(in) :: el, & !< element number + ip !< integration point number + real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell + integer(pInt) :: c,n + + c = theMesh%elem%cellType + mesh_cellCenterCoordinates = 0.0_pReal + 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 / real(FE_NcellnodesPerCell(c),pReal) + +end function mesh_cellCenterCoordinates + + !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' !-------------------------------------------------------------------------------------------------- @@ -1134,18 +988,16 @@ subroutine mesh_build_ipAreas real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal - allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + do e = 1_pInt,theMesh%nElems ! loop over cpElems + c = theMesh%elem%cellType select case (c) case (1_pInt,2_pInt) ! 2D 3 or 4 node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1158,7 +1010,7 @@ subroutine mesh_build_ipAreas enddo case (3_pInt) ! 3D 4node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1175,7 +1027,7 @@ subroutine mesh_build_ipAreas ! the sum has to be divided by two; this whole prcedure tries to compensate for ! probable non-planar cell surfaces m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1198,678 +1050,15 @@ end subroutine mesh_build_ipAreas !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements -!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_subNodeOnIPFace !-------------------------------------------------------------------------------------------------- subroutine mesh_build_FEdata implicit none integer(pInt) :: me - allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_cellnodeParentnodeWeights(FE_maxNnodes,FE_maxNcellnodes,FE_Nelemtypes), source=0.0_pReal) allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) - !*** fill FE_nodesAtIP with data *** - - me = 0_pInt - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - 1,2,3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, & - 2, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, & - 2, & - 4, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 1,0, & - 1,2, & - 2,0, & - 1,4, & - 0,0, & - 2,3, & - 4,0, & - 3,4, & - 3,0 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - 1,2,3,4 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - reshape(int([& - 1, & - 2, & - 3, & - 4 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - reshape(int([& - 1, & - 2, & - 3, & - 4, & - 5, & - 6 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - 1,2,3,4,5,6,7,8 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - reshape(int([& - 1, & - 2, & - 4, & - 3, & - 5, & - 6, & - 8, & - 7 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - reshape(int([& - 1,0, 0,0, & - 1,2, 0,0, & - 2,0, 0,0, & - 1,4, 0,0, & - 1,3, 2,4, & - 2,3, 0,0, & - 4,0, 0,0, & - 3,4, 0,0, & - 3,0, 0,0, & - 1,5, 0,0, & - 1,6, 2,5, & - 2,6, 0,0, & - 1,8, 4,5, & - 0,0, 0,0, & - 2,7, 3,6, & - 4,8, 0,0, & - 3,8, 4,7, & - 3,7, 0,0, & - 5,0, 0,0, & - 5,6, 0,0, & - 6,0, 0,0, & - 5,8, 0,0, & - 5,7, 6,8, & - 6,7, 0,0, & - 8,0, 0,0, & - 7,8, 0,0, & - 7,0, 0,0 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - - ! *** FE_ipNeighbor *** - ! is a list of the neighborhood of each IP. - ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. - ! Positive integers denote an intra-FE IP identifier. - ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. - me = 0_pInt - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - -2,-3,-1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 2,-3, 3,-1, & - -2, 1, 3,-1, & - 2,-3,-2, 1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 2,-4, 3,-1, & - -2, 1, 4,-1, & - 4,-4,-3, 1, & - -2, 3,-3, 2 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 2,-4, 4,-1, & - 3, 1, 5,-1, & - -2, 2, 6,-1, & - 5,-4, 7, 1, & - 6, 4, 8, 2, & - -2, 5, 9, 3, & - 8,-4,-3, 4, & - 9, 7,-3, 5, & - -2, 8,-3, 6 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - -1,-2,-3,-4 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - reshape(int([& - 2,-4, 3,-2, 4,-1, & - -2, 1, 3,-2, 4,-1, & - 2,-4,-3, 1, 4,-1, & - 2,-4, 3,-2,-3, 1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - reshape(int([& - 2,-4, 3,-2, 4,-1, & - -3, 1, 3,-2, 5,-1, & - 2,-4,-3, 1, 6,-1, & - 5,-4, 6,-2,-5, 1, & - -3, 4, 6,-2,-5, 2, & - 5,-4,-3, 4,-5, 3 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - -3,-5,-4,-2,-6,-1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - reshape(int([& - 2,-5, 3,-2, 5,-1, & - -3, 1, 4,-2, 6,-1, & - 4,-5,-4, 1, 7,-1, & - -3, 3,-4, 2, 8,-1, & - 6,-5, 7,-2,-6, 1, & - -3, 5, 8,-2,-6, 2, & - 8,-5,-4, 5,-6, 3, & - -3, 7,-4, 6,-6, 4 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - reshape(int([& - 2,-5, 4,-2,10,-1, & - 3, 1, 5,-2,11,-1, & - -3, 2, 6,-2,12,-1, & - 5,-5, 7, 1,13,-1, & - 6, 4, 8, 2,14,-1, & - -3, 5, 9, 3,15,-1, & - 8,-5,-4, 4,16,-1, & - 9, 7,-4, 5,17,-1, & - -3, 8,-4, 6,18,-1, & - 11,-5,13,-2,19, 1, & - 12,10,14,-2,20, 2, & - -3,11,15,-2,21, 3, & - 14,-5,16,10,22, 4, & - 15,13,17,11,23, 5, & - -3,14,18,12,24, 6, & - 17,-5,-4,13,25, 7, & - 18,16,-4,14,26, 8, & - -3,17,-4,15,27, 9, & - 20,-5,22,-2,-6,10, & - 21,19,23,-2,-6,11, & - -3,20,24,-2,-6,12, & - 23,-5,25,19,-6,13, & - 24,22,26,20,-6,14, & - -3,23,27,21,-6,15, & - 26,-5,-4,22,-6,16, & - 27,25,-4,23,-6,17, & - -3,26,-4,24,-6,18 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cell *** - me = 0_pInt - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - 1,2,3 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, 4, 7, 6, & - 2, 5, 7, 4, & - 3, 6, 7, 5 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, 5, 9, 8, & - 5, 2, 6, 9, & - 8, 9, 7, 4, & - 9, 6, 3, 7 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 1, 5,13,12, & - 5, 6,14,13, & - 6, 2, 7,14, & - 12,13,16,11, & - 13,14,15,16, & - 14, 7, 8,15, & - 11,16,10, 4, & - 16,15, 9,10, & - 15, 8, 3, 9 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - 1, 2, 3, 4 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - reshape(int([& - 1, 5,11, 7, 8,12,15,14, & - 5, 2, 6,11,12, 9,13,15, & - 7,11, 6, 3,14,15,13,10, & - 8,12,15, 4, 4, 9,13,10 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - reshape(int([& - 1, 7,16, 9,10,17,21,19, & - 7, 2, 8,16,17,11,18,21, & - 9,16, 8, 3,19,21,18,12, & - 10,17,21,19, 4,13,20,15, & - 17,11,18,21,13, 5,14,20, & - 19,21,18,12,15,20,14, 6 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - 1, 2, 3, 4, 5, 6, 7, 8 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - reshape(int([& - 1, 9,21,12,13,22,27,25, & - 9, 2,10,21,22,14,23,27, & - 12,21,11, 4,25,27,24,16, & - 21,10, 3,11,27,23,15,24, & - 13,22,27,25, 5,17,26,20, & - 22,14,23,27,17, 6,18,26, & - 25,27,24,16,20,26,19, 8, & - 27,23,15,24,26,18, 7,19 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - reshape(int([& - 1, 9,33,16,17,37,57,44, & - 9,10,34,33,37,38,58,57, & - 10, 2,11,34,38,18,39,58, & - 16,33,36,15,44,57,60,43, & - 33,34,35,36,57,58,59,60, & - 34,11,12,35,58,39,40,59, & - 15,36,14, 4,43,60,42,20, & - 36,35,13,14,60,59,41,42, & - 35,12, 3,13,59,40,19,41, & - 17,37,57,44,21,45,61,52, & - 37,38,58,57,45,46,62,61, & - 38,18,39,58,46,22,47,62, & - 44,57,60,43,52,61,64,51, & - 57,58,59,60,61,62,63,64, & - 58,39,40,59,62,47,48,63, & - 43,60,42,20,51,64,50,24, & - 60,59,41,42,64,63,49,50, & - 59,40,19,41,63,48,23,49, & - 21,45,61,52, 5,25,53,32, & - 45,46,62,61,25,26,54,53, & - 46,22,47,62,26, 6,27,54, & - 52,61,64,51,32,53,56,31, & - 61,62,63,64,53,54,55,56, & - 62,47,48,63,54,27,28,55, & - 51,64,50,24,31,56,30, 8, & - 64,63,49,50,56,55,29,30, & - 63,48,23,49,55,28, 7,29 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cellnodeParentnodeWeights *** - ! center of gravity of the weighted nodes gives the position of the cell node. - ! fill with 0. - ! example: face-centered cell node with face nodes 1,2,5,6 to be used in, - ! e.g., an 8 node element, would be encoded: - ! 1, 1, 0, 0, 1, 1, 0, 0 - me = 0_pInt - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) - reshape(real([& - 1, 0, 0, & - 0, 1, 0, & - 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 2, 2, 2 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) - reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1, & - 1, 1, 0, 0, & - 0, 1, 1, 0, & - 0, 0, 1, 1, & - 1, 0, 0, 1, & - 1, 1, 1, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 27 (2D 8node 9ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 1, 0, 0, 0, 2, 0, 0, 0, & - 0, 1, 0, 0, 2, 0, 0, 0, & - 0, 1, 0, 0, 0, 2, 0, 0, & - 0, 0, 1, 0, 0, 2, 0, 0, & - 0, 0, 1, 0, 0, 0, 2, 0, & - 0, 0, 0, 1, 0, 0, 2, 0, & - 0, 0, 0, 1, 0, 0, 0, 2, & - 1, 0, 0, 0, 0, 0, 0, 2, & - 4, 1, 1, 1, 8, 2, 2, 8, & - 1, 4, 1, 1, 8, 8, 2, 2, & - 1, 1, 4, 1, 2, 8, 8, 2, & - 1, 1, 1, 4, 2, 2, 8, 8 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 54 (2D 8node 4ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 1, 2, 2, 2, 2 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) - reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) - reshape(real([& - 1, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, & - 0, 0, 1, 0, 0, & - 0, 0, 0, 1, 0, & - 1, 1, 0, 0, 0, & - 0, 1, 1, 0, 0, & - 1, 0, 1, 0, 0, & - 1, 0, 0, 1, 0, & - 0, 1, 0, 1, 0, & - 0, 0, 1, 1, 0, & - 1, 1, 1, 0, 0, & - 1, 1, 0, 1, 0, & - 0, 1, 1, 1, 0, & - 1, 0, 1, 1, 0, & - 0, 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 127 (3D 10node 4ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & - 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & - 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & - 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & - 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 136 (3D 6node 6ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 1, & - 1, 1, 0, 0, 0, 0, & - 0, 1, 1, 0, 0, 0, & - 1, 0, 1, 0, 0, 0, & - 1, 0, 0, 1, 0, 0, & - 0, 1, 0, 0, 1, 0, & - 0, 0, 1, 0, 0, 1, & - 0, 0, 0, 1, 1, 0, & - 0, 0, 0, 0, 1, 1, & - 0, 0, 0, 1, 0, 1, & - 1, 1, 1, 0, 0, 0, & - 1, 1, 0, 1, 1, 0, & - 0, 1, 1, 0, 1, 1, & - 1, 0, 1, 1, 0, 1, & - 0, 0, 0, 1, 1, 1, & - 1, 1, 1, 1, 1, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, & ! - 1, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 1, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 1, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 1, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 1, & ! - 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, & ! - 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, & ! - 1, 1, 1, 1, 1, 1, 1, 1 & ! - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! - 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! - 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 - 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! - 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 - 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! - 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! - 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! - 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 - 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! - 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 - 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! - 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! - 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 - 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! - 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! - 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! - 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! - 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 - 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! - 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! - 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! - 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - - ! *** FE_cellface *** me = 0_pInt From 07cca77fcefc109d2d9c96df42d452c9bb1d2600 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 17:19:12 +0100 Subject: [PATCH 117/309] left over jump marks --- src/mesh_abaqus.f90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 74401e5e5..8d6f950a5 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -1288,7 +1288,7 @@ subroutine mesh_abaqus_map_nodes(fileUnit) backspace(fileUnit) enddo do i = 1_pInt,c - read (fileUnit,610,END=650) line + read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) cpNode = cpNode + 1_pInt mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) @@ -1352,7 +1352,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) backspace(fileUnit) ! rewind to first entry enddo do i = 1_pInt,c - read (fileUnit,'(a300)',END=670) line + read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) do j=1_pInt, 3_pInt @@ -1448,9 +1448,8 @@ subroutine mesh_abaqus_build_elements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat - logical :: inPart + logical :: inPart, materialFound integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead - logical inPart,materialFound character (len=64) :: materialName,elemSetName allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) @@ -1478,7 +1477,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) backspace(fileUnit) enddo do i = 1_pInt,c - read (fileUnit,'(a300)',END=620) line + read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) ! limit to 64 nodes max e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then ! disregard non CP elems @@ -1493,7 +1492,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) enddo nNodesAlreadyRead = chunkPos(1) - 1_pInt do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) do j = 1_pInt,chunkPos(1) mesh_element(4_pInt+nNodesAlreadyRead+j,e) & @@ -1522,7 +1521,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) case('*user') if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & materialFound ) then - read (fileUnit,'(a300)',END=630) line ! read homogenization and microstructure + read (fileUnit,'(a300)') line ! read homogenization and microstructure chunkPos = IO_stringPos(line) homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) From 819ec40b44bacba084ceec95287a5a718ebb28e0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 15:57:05 +0100 Subject: [PATCH 118/309] clearer order: 1) parse file 2) set up element 3) set up mesh --- src/mesh_abaqus.f90 | 19 +++++++++---------- src/mesh_marc.f90 | 17 +++++++++-------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 8d6f950a5..909ab1e0e 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -18,7 +18,6 @@ module mesh mesh_Nnodes, & !< total number of nodes in mesh mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh - mesh_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node !!!! BEGIN DEPRECATED !!!!! @@ -419,7 +418,6 @@ subroutine tMesh_abaqus_init(self,elemType,nodes) integer(pInt), intent(in) :: elemType call self%tMesh%init('mesh',elemType,nodes) - call theMesh%setNelems(mesh_NcpElems) end subroutine tMesh_abaqus_init @@ -464,7 +462,6 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - call mesh_build_FEdata ! get properties of the different types of elements mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) @@ -496,6 +493,12 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + close (FILEUNIT) + + call theMesh%init(mesh_element(2,1),mesh_node0) + call theMesh%setNelems(mesh_NcpElems) + call mesh_build_FEdata ! get properties of the different types of elements + call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -506,7 +509,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) call mesh_build_ipAreas if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) - close (FILEUNIT) call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems @@ -527,15 +529,12 @@ subroutine mesh_init(ip,el) calcMode = .false. ! pretend to have collected what first call is asking (F = I) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" -!!!! COMPATIBILITY HACK !!!! -! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. -! hence, xxPerElem instead of maxXX - mesh_NcellnodesPerElem = mesh_maxNcellnodes + ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) -!!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init(mesh_element(2,1),mesh_node0) + + contains diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index c20bf84d7..601939c53 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -18,7 +18,6 @@ module mesh mesh_Nnodes, & !< total number of nodes in mesh mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh - mesh_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node !!!! BEGIN DEPRECATED !!!!! @@ -478,7 +477,7 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - call mesh_build_FEdata ! get properties of the different types of elements + mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) @@ -513,6 +512,12 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + close (FILEUNIT) + + call theMesh%init(mesh_element(2,1),mesh_node0) + call theMesh%setNelems(mesh_NcpElems) + call mesh_build_FEdata ! get properties of the different types of elements + call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -523,7 +528,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) call mesh_build_ipAreas if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) - close (FILEUNIT) + call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) @@ -548,15 +553,11 @@ subroutine mesh_init(ip,el) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" !!!! COMPATIBILITY HACK !!!! -! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. -! hence, xxPerElem instead of maxXX - mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init(mesh_element(2,1),mesh_node0) - call theMesh%setNelems(mesh_NcpElems) + end subroutine mesh_init From d51a379376a6b2ed4fd9370b144a9c8766f82a8d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 16:17:52 +0100 Subject: [PATCH 119/309] avoid jump labels --- src/mesh_marc.f90 | 82 ++++++++++++++++++++--------------------------- 1 file changed, 35 insertions(+), 47 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 601939c53..d39f4efdb 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -863,11 +863,10 @@ subroutine mesh_marc_get_fileFormat(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then MarcVersion = IO_intValue(line,chunkPos,2_pInt) @@ -898,11 +897,10 @@ subroutine mesh_marc_get_tableStyles(fileUnit) initialcondTableStyle = 0_pInt hypoelasticTableStyle = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then @@ -931,13 +929,12 @@ subroutine mesh_marc_get_matNumber(fileUnit) integer(pInt) :: i, j, data_blocks character(len=300) line -610 FORMAT(A300) rewind(fileUnit) data_blocks = 1_pInt do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then read (fileUnit,610,END=620) line @@ -981,11 +978,10 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) mesh_Nnodes = 0_pInt mesh_Nelems = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & @@ -1021,11 +1017,10 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) mesh_NelemSets = 0_pInt mesh_maxNelemInSet = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & @@ -1061,11 +1056,10 @@ subroutine mesh_marc_map_elementSets(fileUnit) allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=640) line + read (fileUnit,'(A300)',END=640) line chunkPos = IO_stringPos(line) if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then @@ -1101,16 +1095,15 @@ subroutine mesh_marc_count_cpElements(fileUnit) mesh_NcpElems = 0_pInt -610 FORMAT(A300) rewind(fileUnit) if (MarcVersion < 13) then ! Marc 2016 or earlier do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line enddo mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update exit @@ -1118,10 +1111,10 @@ subroutine mesh_marc_count_cpElements(fileUnit) enddo else ! Marc2017 and later do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) @@ -1158,12 +1151,11 @@ subroutine mesh_marc_map_elements(fileUnit) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) -610 FORMAT(A300) contInts = 0_pInt rewind(fileUnit) do - read (fileUnit,610,END=660) line + read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) if (MarcVersion < 13) then ! Marc 2016 or earlier if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then @@ -1176,11 +1168,11 @@ subroutine mesh_marc_map_elements(fileUnit) endif else ! Marc2017 and later if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=660) line + read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then do - read (fileUnit,610,END=660) line + read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) if (verify(trim(tmp),"0123456789")/=0) then ! found keyword @@ -1228,18 +1220,17 @@ subroutine mesh_marc_map_nodes(fileUnit) allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) -610 FORMAT(A300) node_count = 0_pInt rewind(fileUnit) do - read (fileUnit,610,END=650) line + read (fileUnit,'(A300)',END=650) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=650) line ! skip crap line + read (fileUnit,'(A300)',END=650) line ! skip crap line do i = 1_pInt,mesh_Nnodes - read (fileUnit,610,END=650) line + read (fileUnit,'(A300)',END=650) line mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) mesh_mapFEtoCPnode(2_pInt,i) = i enddo @@ -1276,16 +1267,15 @@ subroutine mesh_marc_build_nodes(fileUnit) allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=670) line + read (fileUnit,'(A300)',END=670) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=670) line ! skip crap line + read (fileUnit,'(A300)',END=670) line ! skip crap line do i=1_pInt,mesh_Nnodes - read (fileUnit,610,END=670) line + read (fileUnit,'(A300)',END=670) line m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) do j = 1_pInt,3_pInt mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) @@ -1325,15 +1315,15 @@ subroutine mesh_marc_count_cpSizes(fileUnit) mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt -610 FORMAT(A300) + rewind(fileUnit) do - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=630) line ! Garbage line + read (fileUnit,'(A300)',END=630) line ! Garbage line do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) ! limit to id and type e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then @@ -1381,16 +1371,15 @@ subroutine mesh_marc_build_elements(fileUnit) allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) mesh_elemType = -1_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=620) line ! garbage line + read (fileUnit,'(A300)',END=620) line ! garbage line do i = 1_pInt,mesh_Nelems - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then ! disregard non CP elems @@ -1406,7 +1395,7 @@ subroutine mesh_marc_build_elements(fileUnit) enddo nNodesAlreadyRead = chunkPos(1) - 2_pInt do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) do j = 1_pInt,chunkPos(1) mesh_element(4_pInt+nNodesAlreadyRead+j,e) & @@ -1421,23 +1410,23 @@ subroutine mesh_marc_build_elements(fileUnit) enddo 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line do chunkPos = IO_stringPos(line) if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style - read (fileUnit,610,END=630) line ! read line with index of state var + read (fileUnit,'(A300)',END=630) line ! read line with index of state var chunkPos = IO_stringPos(line) sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest - read (fileUnit,610,END=620) line ! read line with value of state var + read (fileUnit,'(A300)',END=620) line ! read line with value of state var chunkPos = IO_stringPos(line) do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value if (initialcondTableStyle == 2_pInt) then - read (fileUnit,610,END=630) line ! read extra line - read (fileUnit,610,END=630) line ! read extra line + read (fileUnit,'(A300)',END=630) line ! read extra line + read (fileUnit,'(A300)',END=630) line ! read extra line endif contInts = IO_continuousIntValues& ! get affected elements (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) @@ -1446,12 +1435,12 @@ subroutine mesh_marc_build_elements(fileUnit) mesh_element(1_pInt+sv,e) = myVal enddo if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) enddo endif else - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',END=630) line endif enddo @@ -1482,7 +1471,7 @@ use IO, only: & rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read @@ -1499,7 +1488,6 @@ use IO, only: & endif enddo -610 FORMAT(A300) 620 end subroutine mesh_get_damaskOptions From 16cb9ebed9037f1f0d7751fb8e208fce3d0d04d1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 16:49:12 +0100 Subject: [PATCH 120/309] no need to read homogenization info extra but currently, it is not very elegant --- src/mesh_grid.f90 | 89 ++++++----------------------------------------- 1 file changed, 11 insertions(+), 78 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index d3741b766..ec45b8def 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -124,7 +124,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & mesh_build_FEdata, & - mesh_spectral_getHomogenization, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & @@ -243,13 +242,11 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) call theMesh%init(mesh_node) - - ! For compatibility + call theMesh%setNelems(product(grid(1:2))*grid3) + mesh_homogenizationAt = mesh_homogenizationAt(product(grid(1:2))*grid3) ! reallocate/shrink in case of MPI mesh_maxNipNeighbors = theMesh%elem%nIPneighbors -call theMesh%setNelems(product(grid(1:2))*grid3) call mesh_spectral_build_elements() - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) @@ -283,7 +280,6 @@ call theMesh%setNelems(product(grid(1:2))*grid3) ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX ! better name - mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! deallocate(mesh_cell) @@ -407,6 +403,7 @@ subroutine mesh_spectral_read_grid() call IO_error(error_ID = 842_pInt, ext_msg='size (mesh_spectral_read_grid)') allocate(microGlobal(product(grid)), source = -1_pInt) + allocate(mesh_homogenizationAt(product(grid)), source = h) ! too large in case of MPI (shrink later, not very elegant) !-------------------------------------------------------------------------------------------------- ! read and interprete content @@ -419,10 +416,10 @@ subroutine mesh_spectral_read_grid() l = l + 1_pInt chunkPos = IO_stringPos(trim(line)) - possibleCompression: if (chunkPos(1) /= 3) then + noCompression: if (chunkPos(1) /= 3) then c = chunkPos(1) microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] - else possibleCompression + else noCompression compression: if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then c = IO_intValue(line,chunkPos,1) microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))] @@ -434,7 +431,7 @@ subroutine mesh_spectral_read_grid() c = chunkPos(1) microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] endif compression - endif possibleCompression + endif noCompression e = e+c end do @@ -444,64 +441,6 @@ subroutine mesh_spectral_read_grid() end subroutine mesh_spectral_read_grid -!-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_spectral_getHomogenization() - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, myFileUnit - logical :: gotHomogenization = .false. - - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('homogenization') - gotHomogenization = .true. - mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) - end select - enddo - - close(myFileUnit) - - if (.not. gotHomogenization ) & - call IO_error(error_ID = 845_pInt, ext_msg='homogenization') - if (mesh_spectral_getHomogenization<1_pInt) & - call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') - -end function mesh_spectral_getHomogenization - - !-------------------------------------------------------------------------------------------------- !> @brief Store x,y,z coordinates of all nodes in mesh. !! Allocates global arrays 'mesh_node0' and 'mesh_node' @@ -542,24 +481,18 @@ subroutine mesh_spectral_build_elements() implicit none integer(pInt) :: & e, & - - homog, & elemOffset - homog = mesh_spectral_getHomogenization() - - allocate(mesh_element (4_pInt+8_pInt,theMesh%nElems), source = 0_pInt) - elemOffset = product(grid(1:2))*grid3Offset e = 0_pInt - do while (e < theMesh%nElems) ! fill expected number of elements, stop at end of data (or blank line!) + do while (e < theMesh%nElems) ! fill expected number of elements, stop at end of data e = e+1_pInt ! valid element entry mesh_element( 1,e) = -1_pInt ! DEPRECATED mesh_element( 2,e) = 10_pInt - mesh_element( 3,e) = homog ! homogenization + mesh_element( 3,e) = mesh_homogenizationAt(e) mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node @@ -587,7 +520,7 @@ subroutine mesh_spectral_build_ipNeighborhood integer(pInt) :: & x,y,z, & e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems),source=0_pInt) + allocate(mesh_ipNeighborhood(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems),source=0_pInt) e = 0_pInt do z = 0_pInt,grid3-1_pInt @@ -988,8 +921,8 @@ subroutine mesh_build_ipAreas real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal - allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(mesh_ipArea(theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) do e = 1_pInt,theMesh%nElems ! loop over cpElems From abedb5c3db5bcb909d1f36ade2e7566cfa27f80a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 17:24:00 +0100 Subject: [PATCH 121/309] ordered according to calling sequence --- src/mesh_grid.f90 | 2 +- src/mesh_marc.f90 | 1468 +++++++++++++++++++++++---------------------- 2 files changed, 738 insertions(+), 732 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index ec45b8def..d55c1cded 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -27,7 +27,7 @@ module mesh mesh_microstructureAt !< microstructure ID of each element integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_element !< entryCount and list of elements containing node + mesh_element !< entryCount and list of elements containing node integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index d39f4efdb..da62a3e73 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -373,7 +373,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & FE_mapElemtype, & - mesh_faceMatch, & mesh_build_FEdata, & mesh_build_nodeTwins, & mesh_build_sharedElems, & @@ -562,53 +561,651 @@ end subroutine mesh_init !-------------------------------------------------------------------------------------------------- -!> @brief Gives the FE to CP ID mapping by binary search through lookup array -!! valid questions (what) are 'elem', 'node' +!> @brief Figures out version of Marc input file format and stores ist as MarcVersion !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) +subroutine mesh_marc_get_fileFormat(fileUnit) use IO, only: & - IO_lc + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos implicit none - character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID + integer(pInt), intent(in) :: fileUnit - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line - mesh_FEasCP = 0_pInt - select case(IO_lc(what(1:4))) - case('elem') - lookupMap => mesh_mapFEtoCPelem - case('node') - lookupMap => mesh_mapFEtoCPnode - case default - return - endselect - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),pInt) - - if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2_pInt,lower) - return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) - return - endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then - lower = center - elseif (lookupMap(1_pInt,center) > myID) then - upper = center - else - mesh_FEasCP = lookupMap(2_pInt,center) + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then + MarcVersion = IO_intValue(line,chunkPos,2_pInt) exit endif - enddo binarySearch + enddo + +620 end subroutine mesh_marc_get_fileFormat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and +!! 'hypoelasticTableStyle' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_tableStyles(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + initialcondTableStyle = 0_pInt + hypoelasticTableStyle = 0_pInt + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then + initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) + hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_tableStyles + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_matNumber(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i, j, data_blocks + character(len=300) line + + + rewind(fileUnit) + + data_blocks = 1_pInt + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + read (fileUnit,'(A300)',END=620) line + if (len(trim(line))/=0_pInt) then + chunkPos = IO_stringPos(line) + data_blocks = IO_intValue(line,chunkPos,1_pInt) + endif + allocate(Marc_matNumber(data_blocks)) + do i=1_pInt,data_blocks ! read all data blocks + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) + do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block + read (fileUnit,'(A300)') line + enddo + enddo + exit + endif + enddo + +620 end subroutine mesh_marc_get_matNumber + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements in mesh and stores the numbers in +!! 'mesh_Nelems' and 'mesh_Nnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_nodesAndElements(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_IntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & + mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then + read (fileUnit,'(A300)') line + chunkPos = IO_stringPos(line) + mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) + exit ! assumes that "coordinates" comes later in file + endif + enddo + +620 end subroutine mesh_marc_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- + subroutine mesh_marc_count_elementSets(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = 0_pInt + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then + mesh_NelemSets = mesh_NelemSets + 1_pInt + mesh_maxNelemInSet = max(mesh_maxNelemInSet, & + IO_countContinuousIntValues(fileUnit)) + endif + enddo + +620 end subroutine mesh_marc_count_elementSets + + +!******************************************************************** +! map element sets +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!******************************************************************** +subroutine mesh_marc_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet = 0_pInt + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=640) line + chunkPos = IO_stringPos(line) + if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & + (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then + elemSet = elemSet+1_pInt + mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + mesh_mapElemSet(:,elemSet) = & + IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + endif + enddo + +640 end subroutine mesh_marc_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues, & + IO_error, & + IO_intValue, & + IO_countNumericalDataLines + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i + character(len=300):: line + + mesh_NcpElems = 0_pInt + + + rewind(fileUnit) + if (MarcVersion < 13) then ! Marc 2016 or earlier + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines + read (fileUnit,'(A300)') line + enddo + mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update + exit + endif + enddo + else ! Marc2017 and later + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,'(A300)') line + chunkPos = IO_stringPos(line) + if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) + endif + endif + enddo + end if + +620 end subroutine mesh_marc_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line, & + tmp + + integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,cpElem = 0_pInt + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + + + contInts = 0_pInt + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=660) line + chunkPos = IO_stringPos(line) + if (MarcVersion < 13) then ! Marc 2016 or earlier + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines + read (fileUnit,'(A300)') line + enddo + contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& + mesh_mapElemSet,mesh_NelemSets) + exit + endif + else ! Marc2017 and later + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,'(A300)',END=660) line + chunkPos = IO_stringPos(line) + if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + do + read (fileUnit,'(A300)',END=660) line + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword + exit + else + contInts(1) = contInts(1) + 1_pInt + read (tmp,*) contInts(contInts(1)+1) + endif + enddo + endif + endif + endif + enddo +660 do i = 1_pInt,contInts(1) + cpElem = cpElem+1_pInt + mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) + mesh_mapFEtoCPelem(2,cpElem) = cpElem + enddo + +call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + +end subroutine mesh_marc_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt) :: i + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + + + node_count = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=650) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,'(A300)') line ! skip crap line + do i = 1_pInt,mesh_Nnodes + read (fileUnit,'(A300)') line + mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) + mesh_mapFEtoCPnode(2_pInt,i) = i + enddo + exit + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + +end subroutine mesh_marc_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_nodes(fileUnit) + + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue, & + IO_fixedNoEFloatValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=670) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,'(A300)') line ! skip crap line + do i=1_pInt,mesh_Nnodes + read (fileUnit,'(A300)') line + m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) + do j = 1_pInt,3_pInt + mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) + enddo + enddo + exit + endif + enddo + +670 mesh_node = mesh_node0 + +end subroutine mesh_marc_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_intValue, & + IO_skipChunks + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,t,g,e,c + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=630) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,'(A300)') line ! Garbage line + do i=1_pInt,mesh_Nelems ! read all elements + read (fileUnit,'(A300)') line + chunkPos = IO_stringPos(line) ! limit to id and type + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line + endif + enddo + exit + endif + enddo + +630 end subroutine mesh_marc_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per element. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_fixedNoEFloatValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts + integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead + + allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,'(A300)',END=620) line ! garbage line + do i = 1_pInt,mesh_Nelems + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then ! disregard non CP elems + mesh_element(1,e) = -1_pInt ! DEPRECATED + t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type + if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + call IO_error(191,el=t,ip=mesh_elemType) + mesh_elemType = t + mesh_element(2,e) = t + nNodesAlreadyRead = 0_pInt + do j = 1_pInt,chunkPos(1)-2_pInt + mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes + enddo + nNodesAlreadyRead = chunkPos(1) - 2_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + exit + endif + enddo + +620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" + read (fileUnit,'(A300)',END=620) line + do + chunkPos = IO_stringPos(line) + if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & + (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then + if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style + read (fileUnit,'(A300)',END=630) line ! read line with index of state var + chunkPos = IO_stringPos(line) + sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index + if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest + read (fileUnit,'(A300)',END=620) line ! read line with value of state var + chunkPos = IO_stringPos(line) + do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? + myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value + if (initialcondTableStyle == 2_pInt) then + read (fileUnit,'(A300)',END=630) line ! read extra line + read (fileUnit,'(A300)',END=630) line ! read extra line + endif + contInts = IO_continuousIntValues& ! get affected elements + (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + do i = 1_pInt,contInts(1) + e = mesh_FEasCP('elem',contInts(1_pInt+i)) + mesh_element(1_pInt+sv,e) = myVal + enddo + if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style + read (fileUnit,'(A300)',END=630) line + chunkPos = IO_stringPos(line) + enddo + endif + else + read (fileUnit,'(A300)',END=630) line + endif + enddo + +630 end subroutine mesh_marc_build_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief get any additional damask options from input file, sets mesh_periodicSurface +!-------------------------------------------------------------------------------------------------- +subroutine mesh_get_damaskOptions(fileUnit) + +use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) chunk, Nchunks + character(len=300) :: line, damaskOption, v + character(len=300) :: keyword + + mesh_periodicSurface = .false. + keyword = '$damask' + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + Nchunks = chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + select case(damaskOption) + case('periodic') ! damask Option that allows to specify periodic fluxes + do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) + v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? + mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' + mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' + mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' + enddo + endselect + endif + enddo + + +620 end subroutine mesh_get_damaskOptions -end function mesh_FEasCP !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -847,649 +1444,7 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out version of Marc input file format and stores ist as MarcVersion -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_fileFormat(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - MarcVersion = IO_intValue(line,chunkPos,2_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_fileFormat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and -!! 'hypoelasticTableStyle' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_tableStyles(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - initialcondTableStyle = 0_pInt - hypoelasticTableStyle = 0_pInt - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then - initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) - hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_tableStyles - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_matNumber(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, j, data_blocks - character(len=300) line - - - rewind(fileUnit) - - data_blocks = 1_pInt - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - read (fileUnit,610,END=620) line - if (len(trim(line))/=0_pInt) then - chunkPos = IO_stringPos(line) - data_blocks = IO_intValue(line,chunkPos,1_pInt) - endif - allocate(Marc_matNumber(data_blocks)) - do i=1_pInt,data_blocks ! read all data blocks - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block - read (fileUnit,610,END=620) line - enddo - enddo - exit - endif - enddo - -620 end subroutine mesh_marc_get_matNumber - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores the numbers in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_nodesAndElements(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_IntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) - exit ! assumes that "coordinates" comes later in file - endif - enddo - -620 end subroutine mesh_marc_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- - subroutine mesh_marc_count_elementSets(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = 0_pInt - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then - mesh_NelemSets = mesh_NelemSets + 1_pInt - mesh_maxNelemInSet = max(mesh_maxNelemInSet, & - IO_countContinuousIntValues(fileUnit)) - endif - enddo - -620 end subroutine mesh_marc_count_elementSets - - -!******************************************************************** -! map element sets -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!******************************************************************** -subroutine mesh_marc_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=640) line - chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then - elemSet = elemSet+1_pInt - mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mesh_mapElemSet(:,elemSet) = & - IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - endif - enddo - -640 end subroutine mesh_marc_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues, & - IO_error, & - IO_intValue, & - IO_countNumericalDataLines - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i - character(len=300):: line - - mesh_NcpElems = 0_pInt - - - rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines - read (fileUnit,'(A300)',END=620) line - enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update - exit - endif - enddo - else ! Marc2017 and later - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) - endif - endif - enddo - end if - -620 end subroutine mesh_marc_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line, & - tmp - - integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,cpElem = 0_pInt - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - - - contInts = 0_pInt - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=660) line - chunkPos = IO_stringPos(line) - if (MarcVersion < 13) then ! Marc 2016 or earlier - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines - read (fileUnit,610,END=660) line - enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& - mesh_mapElemSet,mesh_NelemSets) - exit - endif - else ! Marc2017 and later - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,'(A300)',END=660) line - chunkPos = IO_stringPos(line) - if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - do - read (fileUnit,'(A300)',END=660) line - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),"0123456789")/=0) then ! found keyword - exit - else - contInts(1) = contInts(1) + 1_pInt - read (tmp,*) contInts(contInts(1)+1) - endif - enddo - endif - endif - endif - enddo -660 do i = 1_pInt,contInts(1) - cpElem = cpElem+1_pInt - mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) - mesh_mapFEtoCPelem(2,cpElem) = cpElem - enddo - -call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - -end subroutine mesh_marc_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt) :: i - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - - - node_count = 0_pInt - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=650) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,'(A300)',END=650) line ! skip crap line - do i = 1_pInt,mesh_Nnodes - read (fileUnit,'(A300)',END=650) line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) - mesh_mapFEtoCPnode(2_pInt,i) = i - enddo - exit - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - -end subroutine mesh_marc_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_nodes(fileUnit) - - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue, & - IO_fixedNoEFloatValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=670) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,'(A300)',END=670) line ! skip crap line - do i=1_pInt,mesh_Nnodes - read (fileUnit,'(A300)',END=670) line - m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) - do j = 1_pInt,3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) - enddo - enddo - exit - endif - enddo - -670 mesh_node = mesh_node0 - -end subroutine mesh_marc_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_intValue, & - IO_skipChunks - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,t,g,e,c - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=630) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,'(A300)',END=630) line ! Garbage line - do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,'(A300)',END=630) line - chunkPos = IO_stringPos(line) ! limit to id and type - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line - endif - enddo - exit - endif - enddo - -630 end subroutine mesh_marc_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per element. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_fixedNoEFloatValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead - - allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,'(A300)',END=620) line ! garbage line - do i = 1_pInt,mesh_Nelems - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & - call IO_error(191,el=t,ip=mesh_elemType) - mesh_elemType = t - mesh_element(2,e) = t - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-2_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes - enddo - nNodesAlreadyRead = chunkPos(1) - 2_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - exit - endif - enddo - -620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,'(A300)',END=620) line - do - chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then - if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style - read (fileUnit,'(A300)',END=630) line ! read line with index of state var - chunkPos = IO_stringPos(line) - sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index - if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest - read (fileUnit,'(A300)',END=620) line ! read line with value of state var - chunkPos = IO_stringPos(line) - do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? - myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value - if (initialcondTableStyle == 2_pInt) then - read (fileUnit,'(A300)',END=630) line ! read extra line - read (fileUnit,'(A300)',END=630) line ! read extra line - endif - contInts = IO_continuousIntValues& ! get affected elements - (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - do i = 1_pInt,contInts(1) - e = mesh_FEasCP('elem',contInts(1_pInt+i)) - mesh_element(1_pInt+sv,e) = myVal - enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style - read (fileUnit,'(A300)',END=630) line - chunkPos = IO_stringPos(line) - enddo - endif - else - read (fileUnit,'(A300)',END=630) line - endif - enddo - -630 end subroutine mesh_marc_build_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief get any additional damask options from input file, sets mesh_periodicSurface -!-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) - -use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword - - mesh_periodicSurface = .false. - keyword = '$damask' - - rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(damaskOption) - case('periodic') ! damask Option that allows to specify periodic fluxes - do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) - v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? - mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' - mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' - mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' - enddo - endselect - endif - enddo - - -620 end subroutine mesh_get_damaskOptions !-------------------------------------------------------------------------------------------------- @@ -1865,57 +1820,10 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - -end subroutine mesh_build_ipNeighborhood - - -!-------------------------------------------------------------------------------------------------- -!> @brief mapping of FE element types to internal representation -!-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) - use IO, only: IO_lc, IO_error - - implicit none - character(len=*), intent(in) :: what - - select case (IO_lc(what)) - case ( '6') - FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle - case ( '155', & - '125', & - '128') - FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) - case ( '11') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral - case ( '54') - FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration - case ( '134') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron - case ( '157') - FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations - case ( '127') - FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron - case ( '136') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral - case ( '117', & - '123') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral - case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) - end select - -end function FE_mapElemtype - - -!-------------------------------------------------------------------------------------------------- + + contains + + !-------------------------------------------------------------------------------------------------- !> @brief find face-matching element of same type !-------------------------------------------------------------------------------------------------- subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) @@ -2001,6 +1909,54 @@ enddo checkCandidate end subroutine mesh_faceMatch +end subroutine mesh_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief mapping of FE element types to internal representation +!-------------------------------------------------------------------------------------------------- +integer(pInt) function FE_mapElemtype(what) + use IO, only: IO_lc, IO_error + + implicit none + character(len=*), intent(in) :: what + + select case (IO_lc(what)) + case ( '6') + FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle + case ( '155', & + '125', & + '128') + FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) + case ( '11') + FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + case ( '27') + FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + case ( '54') + FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration + case ( '134') + FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + case ( '157') + FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations + case ( '127') + FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron + case ( '136') + FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( '117', & + '123') + FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + case ( '7') + FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + case ( '57') + FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + case ( '21') + FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + case default + call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + end select + +end function FE_mapElemtype + !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements @@ -2719,4 +2675,54 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata + +!-------------------------------------------------------------------------------------------------- +!> @brief Gives the FE to CP ID mapping by binary search through lookup array +!! valid questions (what) are 'elem', 'node' +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_FEasCP(what,myID) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),pInt) + + if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2_pInt,lower) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP + end module mesh From 35c37ef9dcdff9b3bdfb6b25222b6f04def01135 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 17:37:25 +0100 Subject: [PATCH 122/309] forgotten format specifier --- src/mesh_marc.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index da62a3e73..bc6dbf133 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -1130,7 +1130,7 @@ subroutine mesh_marc_build_elements(fileUnit) chunkPos = IO_stringPos(line) if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then - if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style + if (initialcondTableStyle == 2_pInt) read (fileUnit,'(A300)',END=620) line ! read extra line for new style read (fileUnit,'(A300)',END=630) line ! read line with index of state var chunkPos = IO_stringPos(line) sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index @@ -1149,7 +1149,7 @@ subroutine mesh_marc_build_elements(fileUnit) e = mesh_FEasCP('elem',contInts(1_pInt+i)) mesh_element(1_pInt+sv,e) = myVal enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style + if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=620) line ! ignore IP range for old table style read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) enddo From bb135463c43a81f271325dd1388c486482159b9c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 20:45:19 +0100 Subject: [PATCH 123/309] using data from theMesh instead of local variables --- src/mesh_marc.f90 | 46 +++++++++++++++++++++------------------------- 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index bc6dbf133..a5dede809 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -515,8 +515,8 @@ subroutine mesh_init(ip,el) call theMesh%init(mesh_element(2,1),mesh_node0) call theMesh%setNelems(mesh_NcpElems) - call mesh_build_FEdata ! get properties of the different types of elements + call mesh_build_FEdata ! get properties of the different types of elements call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -1126,7 +1126,7 @@ subroutine mesh_marc_build_elements(fileUnit) 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" read (fileUnit,'(A300)',END=620) line - do + do !ToDo: the jumps to 620 in below code might result in a never ending loop chunkPos = IO_stringPos(line) if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then @@ -1206,7 +1206,6 @@ use IO, only: & 620 end subroutine mesh_get_damaskOptions - !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. !> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). @@ -1221,31 +1220,28 @@ subroutine mesh_build_cellconnectivity matchingNode2cellnode integer(pInt), dimension(:,:), allocatable :: & cellnodeParent - integer(pInt), dimension(mesh_maxNcellnodes) :: & + integer(pInt), dimension(theMesh%elem%Ncellnodes) :: & localCellnode2globalCellnode integer(pInt) :: & - e,t,g,c,n,i, & + e,n,i, & matchingNodeID, & localCellnodeID - allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) - allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) - + allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,theMesh%nElems), source=0_pInt) + allocate(matchingNode2cellnode(theMesh%nNodes), source=0_pInt) + allocate(cellnodeParent(2_pInt,theMesh%elem%Ncellnodes*theMesh%nElems), source=0_pInt) + + mesh_Ncells = theMesh%nElems*theMesh%elem%nIPs !-------------------------------------------------------------------------------------------------- ! Count cell nodes (including duplicates) and generate cell connectivity list mesh_Ncellnodes = 0_pInt - mesh_Ncells = 0_pInt - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + + do e = 1_pInt,theMesh%nElems localCellnode2globalCellnode = 0_pInt - mesh_Ncells = mesh_Ncells + FE_Nips(g) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell - localCellnodeID = FE_cell(n,i,g) - if (localCellnodeID <= FE_NmatchingNodes(g)) then ! this cell node is a matching node + do i = 1_pInt,theMesh%elem%nIPs + do n = 1_pInt,theMesh%elem%NcellnodesPerCell + localCellnodeID = theMesh%elem%cell(n,i) + if (localCellnodeID <= FE_NmatchingNodes(theMesh%elem%geomType)) then ! this cell node is a matching node matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... @@ -1269,6 +1265,7 @@ subroutine mesh_build_cellconnectivity allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + forall(n = 1_pInt:mesh_Ncellnodes) mesh_cellnodeParent(1,n) = cellnodeParent(1,n) mesh_cellnodeParent(2,n) = cellnodeParent(2,n) @@ -1290,23 +1287,22 @@ function mesh_build_cellnodes(nodes,Ncellnodes) real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes integer(pInt) :: & - e,t,n,m, & + e,n,m, & localCellnodeID real(pReal), dimension(3) :: & myCoords mesh_build_cellnodes = 0.0_pReal -!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,myCoords) do n = 1_pInt,Ncellnodes ! loop over cell nodes e = mesh_cellnodeParent(1,n) localCellnodeID = mesh_cellnodeParent(2,n) - t = mesh_element(2,e) ! get element type myCoords = 0.0_pReal - do m = 1_pInt,FE_Nnodes(t) + do m = 1_pInt,theMesh%elem%nNodes myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & - * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + * theMesh%elem%cellNodeParentNodeWeights(m,localCellnodeID) enddo - mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + mesh_build_cellnodes(1:3,n) = myCoords / sum(theMesh%elem%cellNodeParentNodeWeights(:,localCellnodeID)) enddo !$OMP END PARALLEL DO From 1eb30f3ae7506dc4a100a25ec036322e3ed1eb3b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 20:49:15 +0100 Subject: [PATCH 124/309] re-ordered according to calling sequence --- src/mesh_abaqus.f90 | 667 ++++++++++++++++++++++---------------------- 1 file changed, 339 insertions(+), 328 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 909ab1e0e..20fef4098 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -570,291 +570,10 @@ logical function hasNoPart(fileUnit) end subroutine mesh_init -!-------------------------------------------------------------------------------------------------- -!> @brief Gives the FE to CP ID mapping by binary search through lookup array -!! valid questions (what) are 'elem', 'node' -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) - use IO, only: & - IO_lc - - implicit none - character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID - - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center - - mesh_FEasCP = 0_pInt - select case(IO_lc(what(1:4))) - case('elem') - lookupMap => mesh_mapFEtoCPelem - case('node') - lookupMap => mesh_mapFEtoCPnode - case default - return - endselect - - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),pInt) - - if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2_pInt,lower) - return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) - return - endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then - lower = center - elseif (lookupMap(1_pInt,center) > myID) then - upper = center - else - mesh_FEasCP = lookupMap(2_pInt,center) - exit - endif - enddo binarySearch - -end function mesh_FEasCP -!-------------------------------------------------------------------------------------------------- -!> @brief Split CP elements into cells. -!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). -!> Cell nodes that are also matching nodes are unique in the list of cell nodes, -!> all others (currently) might be stored more than once. -!> Also allocates the 'mesh_node' array. -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_cellconnectivity - - implicit none - integer(pInt), dimension(:), allocatable :: & - matchingNode2cellnode - integer(pInt), dimension(:,:), allocatable :: & - cellnodeParent - integer(pInt), dimension(mesh_maxNcellnodes) :: & - localCellnode2globalCellnode - integer(pInt) :: & - e,t,g,c,n,i, & - matchingNodeID, & - localCellnodeID - - allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) - allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) - -!-------------------------------------------------------------------------------------------------- -! Count cell nodes (including duplicates) and generate cell connectivity list - mesh_Ncellnodes = 0_pInt - mesh_Ncells = 0_pInt - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - localCellnode2globalCellnode = 0_pInt - mesh_Ncells = mesh_Ncells + FE_Nips(g) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell - localCellnodeID = FE_cell(n,i,g) - if (localCellnodeID <= FE_NmatchingNodes(g)) then ! this cell node is a matching node - matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) - if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... - matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID - endif - mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) - else ! this cell node is no matching node - if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... - mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... - localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... - cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to - cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID - endif - mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) - endif - enddo - enddo - enddo - - allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) - allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) - forall(n = 1_pInt:mesh_Ncellnodes) - mesh_cellnodeParent(1,n) = cellnodeParent(1,n) - mesh_cellnodeParent(2,n) = cellnodeParent(2,n) - endforall - -end subroutine mesh_build_cellconnectivity -!-------------------------------------------------------------------------------------------------- -!> @brief Calculate position of cellnodes from the given position of nodes -!> Build list of cellnodes' coordinates. -!> Cellnode coordinates are calculated from a weighted sum of node coordinates. -!-------------------------------------------------------------------------------------------------- -function mesh_build_cellnodes(nodes,Ncellnodes) - - implicit none - integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes - real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes - real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes - - integer(pInt) :: & - e,t,n,m, & - localCellnodeID - real(pReal), dimension(3) :: & - myCoords - - mesh_build_cellnodes = 0.0_pReal -!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) - do n = 1_pInt,Ncellnodes ! loop over cell nodes - e = mesh_cellnodeParent(1,n) - localCellnodeID = mesh_cellnodeParent(2,n) - t = mesh_element(2,e) ! get element type - myCoords = 0.0_pReal - do m = 1_pInt,FE_Nnodes(t) - myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & - * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) - enddo - mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) - enddo -!$OMP END PARALLEL DO - -end function mesh_build_cellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' -!> @details The IP volume is calculated differently depending on the cell type. -!> 2D cells assume an element depth of one in order to calculate the volume. -!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal -!> shape with a cell face as basis and the central ip at the tip. This subvolume is -!> calculated as an average of four tetrahedals with three corners on the cell face -!> and one corner at the central ip. -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_ipVolumes - use math, only: & - math_volTetrahedron, & - math_areaTriangle - - implicit none - integer(pInt) :: e,t,g,c,i,m,f,n - real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) - - !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - select case (c) - - case (1_pInt) ! 2D 3node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element - mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & - mesh_cellnode(1:3,mesh_cell(2,i,e)), & - mesh_cellnode(1:3,mesh_cell(3,i,e))) - - case (2_pInt) ! 2D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element - mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices - mesh_cellnode(1:3,mesh_cell(2,i,e)), & - mesh_cellnode(1:3,mesh_cell(3,i,e))) & - + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & - mesh_cellnode(1:3,mesh_cell(4,i,e)), & - mesh_cellnode(1:3,mesh_cell(1,i,e))) - - case (3_pInt) ! 3D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element - mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & - mesh_cellnode(1:3,mesh_cell(2,i,e)), & - mesh_cellnode(1:3,mesh_cell(3,i,e)), & - mesh_cellnode(1:3,mesh_cell(4,i,e))) - - case (4_pInt) ! 3D 8node - m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - subvolume = 0.0_pReal - forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & - subvolume(n,f) = math_volTetrahedron(& - mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & - mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & - mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & - mesh_ipCoordinates(1:3,i,e)) - mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two - enddo - - end select - enddo - !$OMP END PARALLEL DO - -end subroutine mesh_build_ipVolumes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' -! Called by all solvers in mesh_init in order to initialize the ip coordinates. -! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, -! so no need to use this subroutine anymore; Marc however only provides nodal displacements, -! so in this case the ip coordinates are always calculated on the basis of this subroutine. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, -! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. -! HAS TO BE CHANGED IN A LATER VERSION. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!-------------------------------------------------------------------------------------------------- -subroutine mesh_build_ipCoordinates - - implicit none - integer(pInt) :: e,t,g,c,i,n - real(pReal), dimension(3) :: myCoords - - if (.not. allocated(mesh_ipCoordinates)) & - allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) - - !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - myCoords = 0.0_pReal - 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 / real(FE_NcellnodesPerCell(c),pReal) - enddo - enddo - !$OMP END PARALLEL DO - -end subroutine mesh_build_ipCoordinates - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculates cell center coordinates. -!-------------------------------------------------------------------------------------------------- -pure function mesh_cellCenterCoordinates(ip,el) - - implicit none - integer(pInt), intent(in) :: el, & !< element number - ip !< integration point number - real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell - integer(pInt) :: t,g,c,n - - t = mesh_element(2_pInt,el) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - mesh_cellCenterCoordinates = 0.0_pReal - 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 / real(FE_NcellnodesPerCell(c),pReal) - - end function mesh_cellCenterCoordinates !-------------------------------------------------------------------------------------------------- @@ -1548,7 +1267,6 @@ subroutine mesh_abaqus_build_elements(fileUnit) end subroutine mesh_abaqus_build_elements - !-------------------------------------------------------------------------------------------------- !> @brief get any additional damask options from input file, sets mesh_periodicSurface !-------------------------------------------------------------------------------------------------- @@ -1594,6 +1312,246 @@ use IO, only: & end subroutine mesh_get_damaskOptions +!-------------------------------------------------------------------------------------------------- +!> @brief Split CP elements into cells. +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> all others (currently) might be stored more than once. +!> Also allocates the 'mesh_node' array. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_cellconnectivity + + implicit none + integer(pInt), dimension(:), allocatable :: & + matchingNode2cellnode + integer(pInt), dimension(:,:), allocatable :: & + cellnodeParent + integer(pInt), dimension(mesh_maxNcellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + e,t,g,c,n,i, & + matchingNodeID, & + localCellnodeID + + allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) + allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) + allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) + +!-------------------------------------------------------------------------------------------------- +! Count cell nodes (including duplicates) and generate cell connectivity list + mesh_Ncellnodes = 0_pInt + mesh_Ncells = 0_pInt + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + localCellnode2globalCellnode = 0_pInt + mesh_Ncells = mesh_Ncells + FE_Nips(g) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + localCellnodeID = FE_cell(n,i,g) + if (localCellnodeID <= FE_NmatchingNodes(g)) then ! this cell node is a matching node + matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) + if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) + else ! this cell node is no matching node + if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) + endif + enddo + enddo + enddo + + allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + forall(n = 1_pInt:mesh_Ncellnodes) + mesh_cellnodeParent(1,n) = cellnodeParent(1,n) + mesh_cellnodeParent(2,n) = cellnodeParent(2,n) + endforall + +end subroutine mesh_build_cellconnectivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate position of cellnodes from the given position of nodes +!> Build list of cellnodes' coordinates. +!> Cellnode coordinates are calculated from a weighted sum of node coordinates. +!-------------------------------------------------------------------------------------------------- +function mesh_build_cellnodes(nodes,Ncellnodes) + + implicit none + integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes + real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes + real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes + + integer(pInt) :: & + e,t,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) + do n = 1_pInt,Ncellnodes ! loop over cell nodes + e = mesh_cellnodeParent(1,n) + localCellnodeID = mesh_cellnodeParent(2,n) + t = mesh_element(2,e) ! get element type + myCoords = 0.0_pReal + do m = 1_pInt,FE_Nnodes(t) + myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + enddo +!$OMP END PARALLEL DO + +end function mesh_build_cellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipVolumes + use math, only: & + math_volTetrahedron, & + math_areaTriangle + + implicit none + integer(pInt) :: e,t,g,c,i,m,f,n + real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume + + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + select case (c) + + case (1_pInt) ! 2D 3node + forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) + + case (2_pInt) ! 2D 4node + forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) & + + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e)), & + mesh_cellnode(1:3,mesh_cell(1,i,e))) + + case (3_pInt) ! 3D 4node + forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e))) + + case (4_pInt) ! 3D 8node + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + subvolume = 0.0_pReal + forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & + subvolume(n,f) = math_volTetrahedron(& + mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & + mesh_ipCoordinates(1:3,i,e)) + mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipCoordinates + + implicit none + integer(pInt) :: e,t,g,c,i,n + real(pReal), dimension(3) :: myCoords + + if (.not. allocated(mesh_ipCoordinates)) & + allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + myCoords = 0.0_pReal + 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 / real(FE_NcellnodesPerCell(c),pReal) + enddo + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), intent(in) :: el, & !< element number + ip !< integration point number + real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell + integer(pInt) :: t,g,c,n + + t = mesh_element(2_pInt,el) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + mesh_cellCenterCoordinates = 0.0_pReal + 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 / real(FE_NcellnodesPerCell(c),pReal) + + end function mesh_cellCenterCoordinates + + + + + !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' @@ -1968,52 +1926,9 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - -end subroutine mesh_build_ipNeighborhood - - -!-------------------------------------------------------------------------------------------------- -!> @brief mapping of FE element types to internal representation -!-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) - use IO, only: IO_lc, IO_error - - implicit none - character(len=*), intent(in) :: what - - select case (IO_lc(what)) - case ( 'cpe4', & - 'cpe4t') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( 'cpe8', & - 'cpe8t') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral - case ( 'c3d4', & - 'c3d4t') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron - case ( 'c3d6', & - 'c3d6t') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral - case ( 'c3d8r', & - 'c3d8rt') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( 'c3d8', & - 'c3d8t') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( 'c3d20r', & - 'c3d20rt') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( 'c3d20', & - 'c3d20t') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral - case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) - end select - -end function FE_mapElemtype - - -!-------------------------------------------------------------------------------------------------- + + contains + !-------------------------------------------------------------------------------------------------- !> @brief find face-matching element of same type !-------------------------------------------------------------------------------------------------- subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) @@ -2099,6 +2014,52 @@ enddo checkCandidate end subroutine mesh_faceMatch +end subroutine mesh_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief mapping of FE element types to internal representation +!-------------------------------------------------------------------------------------------------- +integer(pInt) function FE_mapElemtype(what) + use IO, only: IO_lc, IO_error + + implicit none + character(len=*), intent(in) :: what + + select case (IO_lc(what)) + case ( 'cpe4', & + 'cpe4t') + FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + case ( 'cpe8', & + 'cpe8t') + FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + case ( 'c3d4', & + 'c3d4t') + FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + case ( 'c3d6', & + 'c3d6t') + FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( 'c3d8r', & + 'c3d8rt') + FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + case ( 'c3d8', & + 'c3d8t') + FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + case ( 'c3d20r', & + 'c3d20rt') + FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + case ( 'c3d20', & + 'c3d20t') + FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + case default + call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + end select + +end function FE_mapElemtype + + + + !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements @@ -2817,4 +2778,54 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata + +!-------------------------------------------------------------------------------------------------- +!> @brief Gives the FE to CP ID mapping by binary search through lookup array +!! valid questions (what) are 'elem', 'node' +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_FEasCP(what,myID) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),pInt) + + if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2_pInt,lower) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP + end module mesh From a92937a7e35af212e19fabd662cbacc42f65e3c0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:06:53 +0100 Subject: [PATCH 125/309] grid does reading in of geometry independently --- src/IO.f90 | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index bef14ea1e..29c27c567 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -44,18 +44,22 @@ module IO IO_lc, & IO_skipChunks, & IO_extractValue, & - IO_countDataLines, & - IO_countNumericalDataLines, & - IO_countContinuousIntValues, & - IO_continuousIntValues, & IO_error, & IO_warning, & IO_intOut, & IO_timeStamp #if defined(Marc4DAMASK) || defined(Abaqus) public :: & +#ifdef Abaqus + IO_countDataLines, & +#endif +#ifdef Marc4DAMASK + IO_countNumericalDataLines, & +#endif IO_open_inputFile, & - IO_open_logFile + IO_open_logFile, & + IO_countContinuousIntValues, & + IO_continuousIntValues #endif private :: & IO_fixedFloatValue, & @@ -889,6 +893,7 @@ character(len=300) pure function IO_extractValue(pair,key) end function IO_extractValue +#ifdef Abaqus !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- @@ -919,8 +924,10 @@ integer(pInt) function IO_countDataLines(fileUnit) backspace(fileUnit) end function IO_countDataLines +#endif +#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- @@ -951,12 +958,14 @@ integer(pInt) function IO_countNumericalDataLines(fileUnit) backspace(fileUnit) end function IO_countNumericalDataLines +#endif + +#if defined(Abaqus) || defined(Marc4DAMASK) !-------------------------------------------------------------------------------------------------- !> @brief count items in consecutive lines depending on lines !> @details Marc: ints concatenated by "c" as last char or range of values a "to" b !> Abaqus: triplet of start,stop,inc -!> Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b !-------------------------------------------------------------------------------------------------- integer(pInt) function IO_countContinuousIntValues(fileUnit) @@ -972,7 +981,7 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) IO_countContinuousIntValues = 0_pInt line = '' -#ifndef Abaqus +#if defined(Marc4DAMASK) do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) @@ -983,11 +992,7 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) & - IO_intValue(line,chunkPos,1_pInt)) line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! only one single range indicator allowed - else if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'of' ) then ! found multiple entries indicator - IO_countContinuousIntValues = IO_intValue(line,chunkPos,1_pInt) - line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! only one single multiplier allowed + exit ! only one single range indicator allowed else IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c' if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value @@ -997,14 +1002,14 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) endif endif enddo -#else +#elif defined(Abaqus) c = IO_countDataLines(fileUnit) do l = 1_pInt,c - backspace(fileUnit) ! ToDo: substitute by rewind? + backspace(fileUnit) enddo l = 1_pInt - do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct + do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct? l = l + 1_pInt line = IO_read(fileUnit) chunkPos = IO_stringPos(line) @@ -1022,7 +1027,6 @@ end function IO_countContinuousIntValues !! First integer in array is counter !> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set !! Abaqus: triplet of start,stop,inc or named set -!! Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b !-------------------------------------------------------------------------------------------------- function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) @@ -1046,7 +1050,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) IO_continuousIntValues = 0_pInt rangeGeneration = .false. -#ifndef Abaqus +#if defined(Marc4DAMASK) do read(fileUnit,'(A65536)',end=100) line chunkPos = IO_stringPos(line) @@ -1068,10 +1072,6 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) IO_continuousIntValues(1+IO_continuousIntValues(1)) = i enddo exit - else if (chunkPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'of' ) then ! found multiple entries indicator - IO_continuousIntValues(1) = IO_intValue(line,chunkPos,1_pInt) - IO_continuousIntValues(2:IO_continuousIntValues(1)+1) = IO_intValue(line,chunkPos,3_pInt) - exit else do i = 1_pInt,chunkPos(1)-1_pInt ! interpret up to second to last value IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt @@ -1084,7 +1084,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) endif endif enddo -#else +#elif defined(Abaqus) c = IO_countDataLines(fileUnit) do l = 1_pInt,c backspace(fileUnit) @@ -1130,6 +1130,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) #endif 100 end function IO_continuousIntValues +#endif !-------------------------------------------------------------------------------------------------- From 40ad1aef2f12fbcad4932f3dcf205c1dd458d52f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:07:58 +0100 Subject: [PATCH 126/309] was not used --- src/IO.f90 | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 29c27c567..b4f9d1de9 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -62,7 +62,6 @@ module IO IO_continuousIntValues #endif private :: & - IO_fixedFloatValue, & IO_verifyFloatValue, & IO_verifyIntValue @@ -733,25 +732,6 @@ real(pReal) function IO_floatValue (string,chunkPos,myChunk) end function IO_floatValue -!-------------------------------------------------------------------------------------------------- -!> @brief reads float value at myChunk from fixed format string -!-------------------------------------------------------------------------------------------------- -real(pReal) function IO_fixedFloatValue (string,ends,myChunk) - - implicit none - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=20), parameter :: MYNAME = 'IO_fixedFloatValue: ' - character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' - - IO_fixedFloatValue = & - IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& - VALIDCHARACTERS,MYNAME) - -end function IO_fixedFloatValue - - !-------------------------------------------------------------------------------------------------- !> @brief reads float x.y+z value at myChunk from format string !-------------------------------------------------------------------------------------------------- From 2c7553653b6406c7d0d145ef12ba7d649a6203a4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:11:19 +0100 Subject: [PATCH 127/309] only used by MSC.Marc --- src/IO.f90 | 39 ++++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index b4f9d1de9..fa98ae4df 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -731,7 +731,7 @@ real(pReal) function IO_floatValue (string,chunkPos,myChunk) end function IO_floatValue - +#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief reads float x.y+z value at myChunk from format string !-------------------------------------------------------------------------------------------------- @@ -765,6 +765,25 @@ real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) end function IO_fixedNoEFloatValue +!-------------------------------------------------------------------------------------------------- +!> @brief reads integer value at myChunk from fixed format string +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_fixedIntValue(string,ends,myChunk) + + implicit none + character(len=*), intent(in) :: string !< raw input with known ends of each chunk + integer(pInt), intent(in) :: myChunk !< position number of desired chunk + integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string + character(len=20), parameter :: MYNAME = 'IO_fixedIntValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' + + IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& + VALIDCHARACTERS,MYNAME) + +end function IO_fixedIntValue +#endif + + !-------------------------------------------------------------------------------------------------- !> @brief reads integer value at myChunk from string !-------------------------------------------------------------------------------------------------- @@ -789,24 +808,6 @@ integer(pInt) function IO_intValue(string,chunkPos,myChunk) end function IO_intValue -!-------------------------------------------------------------------------------------------------- -!> @brief reads integer value at myChunk from fixed format string -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_fixedIntValue(string,ends,myChunk) - - implicit none - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=20), parameter :: MYNAME = 'IO_fixedIntValue: ' - character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - - IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& - VALIDCHARACTERS,MYNAME) - -end function IO_fixedIntValue - - !-------------------------------------------------------------------------------------------------- !> @brief changes characters in string to lower case !-------------------------------------------------------------------------------------------------- From f45ba0ff5b4dbe809967a9be6237d0c036793781 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:18:38 +0100 Subject: [PATCH 128/309] functions specific for MSC.Marc and/or Abaqus these functions are very specific for the input files and might be better located in the respective mesh module --- src/IO.f90 | 564 ++++++++++++++++++++++++++--------------------------- 1 file changed, 276 insertions(+), 288 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index fa98ae4df..b5868fa48 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -36,14 +36,9 @@ module IO IO_getTag, & IO_stringPos, & IO_stringValue, & - IO_fixedStringValue ,& IO_floatValue, & - IO_fixedNoEFloatValue, & IO_intValue, & - IO_fixedIntValue, & IO_lc, & - IO_skipChunks, & - IO_extractValue, & IO_error, & IO_warning, & IO_intOut, & @@ -51,9 +46,13 @@ module IO #if defined(Marc4DAMASK) || defined(Abaqus) public :: & #ifdef Abaqus + IO_extractValue, & IO_countDataLines, & #endif #ifdef Marc4DAMASK + IO_skipChunks, & + IO_fixedNoEFloatValue, & + IO_fixedIntValue, & IO_countNumericalDataLines, & #endif IO_open_inputFile, & @@ -93,7 +92,7 @@ end subroutine IO_init !> @details unstable and buggy !-------------------------------------------------------------------------------------------------- recursive function IO_read(fileUnit,reset) result(line) - +!ToDo: remove recursion once material.config handling is done fully via config module implicit none integer(pInt), intent(in) :: fileUnit !< file unit logical, intent(in), optional :: reset @@ -161,6 +160,7 @@ recursive function IO_read(fileUnit,reset) result(line) end function IO_read + !-------------------------------------------------------------------------------------------------- !> @brief recursively reads a text file. !! Recursion is triggered by "{path/to/inputfile}" in a line @@ -284,7 +284,7 @@ end subroutine IO_open_file !> @details Like IO_open_file, but error is handled via return value and not via call to IO_error !-------------------------------------------------------------------------------------------------- logical function IO_open_file_stat(fileUnit,path) - +!ToDo: DEPRECATED once material.config handling is done fully via config module implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: path !< relative path from working directory @@ -691,22 +691,6 @@ function IO_stringValue(string,chunkPos,myChunk,silent) end function IO_stringValue -!-------------------------------------------------------------------------------------------------- -!> @brief reads string value at myChunk from fixed format string -!-------------------------------------------------------------------------------------------------- -pure function IO_fixedStringValue (string,ends,myChunk) - - implicit none - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=ends(myChunk+1)-ends(myChunk)) :: IO_fixedStringValue - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - - IO_fixedStringValue = string(ends(myChunk)+1:ends(myChunk+1)) - -end function IO_fixedStringValue - - !-------------------------------------------------------------------------------------------------- !> @brief reads float value at myChunk from string !-------------------------------------------------------------------------------------------------- @@ -731,6 +715,31 @@ real(pReal) function IO_floatValue (string,chunkPos,myChunk) end function IO_floatValue + +!-------------------------------------------------------------------------------------------------- +!> @brief reads integer value at myChunk from string +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_intValue(string,chunkPos,myChunk) + + implicit none + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + integer(pInt), intent(in) :: myChunk !< position number of desired chunk + integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + character(len=13), parameter :: MYNAME = 'IO_intValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' + + IO_intValue = 0_pInt + + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then + call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) + else valuePresent + IO_intValue = IO_verifyIntValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& + VALIDCHARACTERS,MYNAME) + endif valuePresent + +end function IO_intValue + + #ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief reads float x.y+z value at myChunk from format string @@ -784,30 +793,6 @@ end function IO_fixedIntValue #endif -!-------------------------------------------------------------------------------------------------- -!> @brief reads integer value at myChunk from string -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_intValue(string,chunkPos,myChunk) - - implicit none - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - character(len=13), parameter :: MYNAME = 'IO_intValue: ' - character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - - IO_intValue = 0_pInt - - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then - call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) - else valuePresent - IO_intValue = IO_verifyIntValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& - VALIDCHARACTERS,MYNAME) - endif valuePresent - -end function IO_intValue - - !-------------------------------------------------------------------------------------------------- !> @brief changes characters in string to lower case !-------------------------------------------------------------------------------------------------- @@ -831,6 +816,7 @@ pure function IO_lc(string) end function IO_lc +#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief reads file to skip (at least) N chunks (may be over multiple lines) !-------------------------------------------------------------------------------------------------- @@ -851,8 +837,10 @@ subroutine IO_skipChunks(fileUnit,N) remainingChunks = remainingChunks - (size(IO_stringPos(line))-1_pInt)/2_pInt enddo end subroutine IO_skipChunks +#endif +#ifdef Abaqus !-------------------------------------------------------------------------------------------------- !> @brief extracts string value from key=value pair and check whether key matches !-------------------------------------------------------------------------------------------------- @@ -872,247 +860,7 @@ character(len=300) pure function IO_extractValue(pair,key) if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches end function IO_extractValue - - -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief count lines containig data up to next *keyword -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countDataLines(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line, & - tmp - - IO_countDataLines = 0_pInt - line = '' - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - else - if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt - endif - enddo - backspace(fileUnit) - -end function IO_countDataLines -#endif - - -#ifdef Marc4DAMASK -!-------------------------------------------------------------------------------------------------- -!> @brief count lines containig data up to next *keyword -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countNumericalDataLines(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line, & - tmp - - IO_countNumericalDataLines = 0_pInt - line = '' - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),'0123456789') == 0) then ! numerical values - IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt - else - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - enddo - backspace(fileUnit) - -end function IO_countNumericalDataLines -#endif - - -#if defined(Abaqus) || defined(Marc4DAMASK) -!-------------------------------------------------------------------------------------------------- -!> @brief count items in consecutive lines depending on lines -!> @details Marc: ints concatenated by "c" as last char or range of values a "to" b -!> Abaqus: triplet of start,stop,inc -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countContinuousIntValues(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit - -#ifdef Abaqus - integer(pInt) :: l,c -#endif - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line - - IO_countContinuousIntValues = 0_pInt - line = '' - -#if defined(Marc4DAMASK) - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - chunkPos = IO_stringPos(line) - if (chunkPos(1) < 1_pInt) then ! empty line - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - elseif (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator - IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) & - - IO_intValue(line,chunkPos,1_pInt)) - line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! only one single range indicator allowed - else - IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c' - if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value - IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt - line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! data ended - endif - endif - enddo -#elif defined(Abaqus) - c = IO_countDataLines(fileUnit) - do l = 1_pInt,c - backspace(fileUnit) - enddo - - l = 1_pInt - do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct? - l = l + 1_pInt - line = IO_read(fileUnit) - chunkPos = IO_stringPos(line) - IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation - (IO_intValue(line,chunkPos,2_pInt)-IO_intValue(line,chunkPos,1_pInt))/& - max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) - enddo -#endif - -end function IO_countContinuousIntValues - - -!-------------------------------------------------------------------------------------------------- -!> @brief return integer list corresponding to items in consecutive lines. -!! First integer in array is counter -!> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set -!! Abaqus: triplet of start,stop,inc or named set -!-------------------------------------------------------------------------------------------------- -function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) - - implicit none - integer(pInt), intent(in) :: maxN - integer(pInt), dimension(1+maxN) :: IO_continuousIntValues - - integer(pInt), intent(in) :: fileUnit, & - lookupMaxN - integer(pInt), dimension(:,:), intent(in) :: lookupMap - character(len=64), dimension(:), intent(in) :: lookupName - integer(pInt) :: i,first,last -#ifdef Abaqus - integer(pInt) :: j,l,c -#endif - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) line - logical rangeGeneration - - IO_continuousIntValues = 0_pInt - rangeGeneration = .false. - -#if defined(Marc4DAMASK) - do - read(fileUnit,'(A65536)',end=100) line - chunkPos = IO_stringPos(line) - if (chunkPos(1) < 1_pInt) then ! empty line - exit - elseif (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name - do i = 1_pInt, lookupMaxN ! loop over known set names - if (IO_stringValue(line,chunkPos,1_pInt) == lookupName(i)) then ! found matching name - IO_continuousIntValues = lookupMap(:,i) ! return resp. entity list - exit - endif - enddo - exit - else if (chunkPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator - first = IO_intValue(line,chunkPos,1_pInt) - last = IO_intValue(line,chunkPos,3_pInt) - do i = first, last, sign(1_pInt,last-first) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = i - enddo - exit - else - do i = 1_pInt,chunkPos(1)-1_pInt ! interpret up to second to last value - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) - enddo - if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,chunkPos(1)) - exit - endif - endif - enddo -#elif defined(Abaqus) - c = IO_countDataLines(fileUnit) - do l = 1_pInt,c - backspace(fileUnit) - enddo - -!-------------------------------------------------------------------------------------------------- -! check if the element values in the elset are auto generated - backspace(fileUnit) - read(fileUnit,'(A65536)',end=100) line - chunkPos = IO_stringPos(line) - do i = 1_pInt,chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true. - enddo - - do l = 1_pInt,c - read(fileUnit,'(A65536)',end=100) line - chunkPos = IO_stringPos(line) - if (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line - do i = 1_pInt,chunkPos(1) ! loop over set names in line - do j = 1_pInt,lookupMaxN ! look through known set names - if (IO_stringValue(line,chunkPos,i) == lookupName(j)) then ! found matching name - first = 2_pInt + IO_continuousIntValues(1) ! where to start appending data - last = first + lookupMap(1,j) - 1_pInt ! up to where to append data - IO_continuousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list - IO_continuousIntValues(1) = IO_continuousIntValues(1) + lookupMap(1,j) ! count them - endif - enddo - enddo - else if (rangeGeneration) then ! range generation - do i = IO_intValue(line,chunkPos,1_pInt),& - IO_intValue(line,chunkPos,2_pInt),& - max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = i - enddo - else ! read individual elem nums - do i = 1_pInt,chunkPos(1) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) - enddo - endif - enddo -#endif - -100 end function IO_continuousIntValues -#endif - +# endif !-------------------------------------------------------------------------------------------------- !> @brief returns format string for integer values without leading zeros @@ -1503,6 +1251,246 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) end subroutine IO_warning +#ifdef Abaqus +!-------------------------------------------------------------------------------------------------- +!> @brief count lines containig data up to next *keyword +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_countDataLines(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit !< file handle + + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp + + IO_countDataLines = 0_pInt + line = '' + + do while (trim(line) /= IO_EOF) + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + else + if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt + endif + enddo + backspace(fileUnit) + +end function IO_countDataLines +#endif + + +#ifdef Marc4DAMASK +!-------------------------------------------------------------------------------------------------- +!> @brief count lines containig data up to next *keyword +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_countNumericalDataLines(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit !< file handle + + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp + + IO_countNumericalDataLines = 0_pInt + line = '' + + do while (trim(line) /= IO_EOF) + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),'0123456789') == 0) then ! numerical values + IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt + else + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + enddo + backspace(fileUnit) + +end function IO_countNumericalDataLines +#endif + + +#if defined(Abaqus) || defined(Marc4DAMASK) +!-------------------------------------------------------------------------------------------------- +!> @brief count items in consecutive lines depending on lines +!> @details Marc: ints concatenated by "c" as last char or range of values a "to" b +!> Abaqus: triplet of start,stop,inc +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_countContinuousIntValues(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit + +#ifdef Abaqus + integer(pInt) :: l,c +#endif + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line + + IO_countContinuousIntValues = 0_pInt + line = '' + +#if defined(Marc4DAMASK) + do while (trim(line) /= IO_EOF) + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + if (chunkPos(1) < 1_pInt) then ! empty line + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + elseif (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator + IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) & + - IO_intValue(line,chunkPos,1_pInt)) + line = IO_read(fileUnit, .true.) ! reset IO_read + exit ! only one single range indicator allowed + else + IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c' + if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value + IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt + line = IO_read(fileUnit, .true.) ! reset IO_read + exit ! data ended + endif + endif + enddo +#elif defined(Abaqus) + c = IO_countDataLines(fileUnit) + do l = 1_pInt,c + backspace(fileUnit) + enddo + + l = 1_pInt + do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct? + l = l + 1_pInt + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation + (IO_intValue(line,chunkPos,2_pInt)-IO_intValue(line,chunkPos,1_pInt))/& + max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) + enddo +#endif + +end function IO_countContinuousIntValues + + +!-------------------------------------------------------------------------------------------------- +!> @brief return integer list corresponding to items in consecutive lines. +!! First integer in array is counter +!> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set +!! Abaqus: triplet of start,stop,inc or named set +!-------------------------------------------------------------------------------------------------- +function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) + + implicit none + integer(pInt), intent(in) :: maxN + integer(pInt), dimension(1+maxN) :: IO_continuousIntValues + + integer(pInt), intent(in) :: fileUnit, & + lookupMaxN + integer(pInt), dimension(:,:), intent(in) :: lookupMap + character(len=64), dimension(:), intent(in) :: lookupName + integer(pInt) :: i,first,last +#ifdef Abaqus + integer(pInt) :: j,l,c +#endif + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) line + logical rangeGeneration + + IO_continuousIntValues = 0_pInt + rangeGeneration = .false. + +#if defined(Marc4DAMASK) + do + read(fileUnit,'(A65536)',end=100) line + chunkPos = IO_stringPos(line) + if (chunkPos(1) < 1_pInt) then ! empty line + exit + elseif (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name + do i = 1_pInt, lookupMaxN ! loop over known set names + if (IO_stringValue(line,chunkPos,1_pInt) == lookupName(i)) then ! found matching name + IO_continuousIntValues = lookupMap(:,i) ! return resp. entity list + exit + endif + enddo + exit + else if (chunkPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator + first = IO_intValue(line,chunkPos,1_pInt) + last = IO_intValue(line,chunkPos,3_pInt) + do i = first, last, sign(1_pInt,last-first) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1+IO_continuousIntValues(1)) = i + enddo + exit + else + do i = 1_pInt,chunkPos(1)-1_pInt ! interpret up to second to last value + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) + enddo + if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,chunkPos(1)) + exit + endif + endif + enddo +#elif defined(Abaqus) + c = IO_countDataLines(fileUnit) + do l = 1_pInt,c + backspace(fileUnit) + enddo + +!-------------------------------------------------------------------------------------------------- +! check if the element values in the elset are auto generated + backspace(fileUnit) + read(fileUnit,'(A65536)',end=100) line + chunkPos = IO_stringPos(line) + do i = 1_pInt,chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true. + enddo + + do l = 1_pInt,c + read(fileUnit,'(A65536)',end=100) line + chunkPos = IO_stringPos(line) + if (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line + do i = 1_pInt,chunkPos(1) ! loop over set names in line + do j = 1_pInt,lookupMaxN ! look through known set names + if (IO_stringValue(line,chunkPos,i) == lookupName(j)) then ! found matching name + first = 2_pInt + IO_continuousIntValues(1) ! where to start appending data + last = first + lookupMap(1,j) - 1_pInt ! up to where to append data + IO_continuousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list + IO_continuousIntValues(1) = IO_continuousIntValues(1) + lookupMap(1,j) ! count them + endif + enddo + enddo + else if (rangeGeneration) then ! range generation + do i = IO_intValue(line,chunkPos,1_pInt),& + IO_intValue(line,chunkPos,2_pInt),& + max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1+IO_continuousIntValues(1)) = i + enddo + else ! read individual elem nums + do i = 1_pInt,chunkPos(1) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) + enddo + endif + enddo +#endif + +100 end function IO_continuousIntValues +#endif + + !-------------------------------------------------------------------------------------------------- ! internal helper functions From d605adc92e222ec33c5ab02a11e4a386e3eb8943 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 11:12:23 +0100 Subject: [PATCH 129/309] avoid the use of global variables to make dependencies clear --- src/mesh_marc.f90 | 240 ++++++++++++++++++++++------------------------ 1 file changed, 117 insertions(+), 123 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index a5dede809..0421a9452 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -392,27 +392,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & type, public, extends(tMesh) :: tMesh_marc - integer(pInt), public :: & - nElemsAll, & - maxNelemInSet, & - NelemSets,& - MarcVersion, & !< Version of input file format ToDo: Better Name? - hypoelasticTableStyle, & !< Table style - initialcondTableStyle - character(len=64), dimension(:), allocatable :: & - nameElemSet,& !< names of elementSet - mesh_nameElemSet, & !< names of elementSet - mapMaterial !< name of elementSet for material - integer(pInt), dimension(:), allocatable :: & - Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) - integer(pInt) :: & - mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) - mesh_maxNnodes, & !< max number of nodes in any CP element - mesh_NelemSets, & - mesh_maxNelemInSet - integer(pInt), dimension(:,:), allocatable :: & - mesh_mapElemSet !< list of elements in elementSet - contains procedure, pass(self) :: tMesh_marc_init generic, public :: init => tMesh_marc_init @@ -467,9 +446,10 @@ subroutine mesh_init(ip,el) FEsolving_execIP implicit none - integer(pInt), parameter :: FILEUNIT = 222_pInt - integer(pInt), intent(in), optional :: el, ip - integer(pInt) :: j + integer(pInt), intent(in) :: el, ip + + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt) :: j, fileFormatVersion, elemType logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' @@ -483,38 +463,57 @@ subroutine mesh_init(ip,el) call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - call mesh_marc_get_fileFormat(FILEUNIT) + + MarcVersion = mesh_marc_get_fileFormat(FILEUNIT) + fileFormatVersion = MarcVersion if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) - call mesh_marc_get_tableStyles(FILEUNIT) + + call mesh_marc_get_tableStyles(initialcondTableStyle,hypoelasticTableStyle,FILEUNIT) if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) - if (MarcVersion > 12) then - call mesh_marc_get_matNumber(FILEUNIT) + + if (fileFormatVersion > 12) then + Marc_matNumber = mesh_marc_get_matNumber(FILEUNIT,hypoelasticTableStyle) if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) endif - call mesh_marc_count_nodesAndElements(FILEUNIT) + + call mesh_marc_count_nodesAndElements(mesh_nNodes, mesh_nElems, FILEUNIT) if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_marc_count_elementSets(FILEUNIT) + + call mesh_marc_count_elementSets(mesh_NelemSets,mesh_maxNelemInSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_marc_map_elementSets(FILEUNIT) + + allocate(mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = 'n/a' + allocate(mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,& + mesh_NelemSets,mesh_maxNelemInSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_marc_count_cpElements(FILEUNIT) + + mesh_NcpElems = mesh_marc_count_cpElements(hypoelasticTableStyle,Marc_matNumber,fileFormatVersion,FILEUNIT) if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_marc_map_elements(FILEUNIT) + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + call mesh_marc_map_elements(FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_marc_map_nodes(FILEUNIT) + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + call mesh_marc_map_nodes(FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_marc_build_nodes(FILEUNIT) + + call mesh_marc_build_nodes(FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_marc_count_cpSizes(FILEUNIT) + + elemType = mesh_marc_count_cpSizes(FILEUNIT) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + + call theMesh%init(elemType,mesh_node0) + call theMesh%setNelems(mesh_NcpElems) + call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) - call theMesh%init(mesh_element(2,1),mesh_node0) - call theMesh%setNelems(mesh_NcpElems) call mesh_build_FEdata ! get properties of the different types of elements call mesh_build_cellconnectivity @@ -561,9 +560,9 @@ end subroutine mesh_init !-------------------------------------------------------------------------------------------------- -!> @brief Figures out version of Marc input file format and stores ist as MarcVersion +!> @brief Figures out version of Marc input file format !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_fileFormat(fileUnit) +integer(pInt) function mesh_marc_get_fileFormat(fileUnit) use IO, only: & IO_lc, & IO_intValue, & @@ -583,19 +582,18 @@ subroutine mesh_marc_get_fileFormat(fileUnit) chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - MarcVersion = IO_intValue(line,chunkPos,2_pInt) + mesh_marc_get_fileFormat = IO_intValue(line,chunkPos,2_pInt) exit endif enddo -620 end subroutine mesh_marc_get_fileFormat +620 end function mesh_marc_get_fileFormat !-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and -!! 'hypoelasticTableStyle' +!> @brief Figures out table styles for initial cond and hypoelastic !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_tableStyles(fileUnit) +subroutine mesh_marc_get_tableStyles(initialcond, hypoelastic,fileUnit) use IO, only: & IO_lc, & IO_intValue, & @@ -603,14 +601,14 @@ subroutine mesh_marc_get_tableStyles(fileUnit) IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: initialcond, hypoelastic + integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - initialcondTableStyle = 0_pInt - hypoelasticTableStyle = 0_pInt - + initialcond = 0_pInt + hypoelastic = 0_pInt rewind(fileUnit) do @@ -618,18 +616,19 @@ subroutine mesh_marc_get_tableStyles(fileUnit) chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then - initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) - hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) + initialcond = IO_intValue(line,chunkPos,4_pInt) + hypoelastic = IO_intValue(line,chunkPos,5_pInt) exit endif enddo 620 end subroutine mesh_marc_get_tableStyles + !-------------------------------------------------------------------------------------------------- !> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_matNumber(fileUnit) +function mesh_marc_get_matNumber(fileUnit,tableStyle) use IO, only: & IO_lc, & IO_intValue, & @@ -637,7 +636,8 @@ subroutine mesh_marc_get_matNumber(fileUnit) IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit, tableStyle + integer(pInt), dimension(:), allocatable :: mesh_marc_get_matNumber integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: i, j, data_blocks @@ -657,12 +657,12 @@ subroutine mesh_marc_get_matNumber(fileUnit) chunkPos = IO_stringPos(line) data_blocks = IO_intValue(line,chunkPos,1_pInt) endif - allocate(Marc_matNumber(data_blocks)) - do i=1_pInt,data_blocks ! read all data blocks + allocate(mesh_marc_get_matNumber(data_blocks), source = 0_pInt) + do i=1_pInt,data_blocks ! read all data blocks read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) - Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block + mesh_marc_get_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) + do j=1_pint,2_pInt + tableStyle ! read 2 or 3 remaining lines of data block read (fileUnit,'(A300)') line enddo enddo @@ -670,14 +670,14 @@ subroutine mesh_marc_get_matNumber(fileUnit) endif enddo -620 end subroutine mesh_marc_get_matNumber +620 end function mesh_marc_get_matNumber !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of nodes and elements in mesh and stores the numbers in !! 'mesh_Nelems' and 'mesh_Nnodes' !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_nodesAndElements(fileUnit) +subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) use IO, only: & IO_lc, & IO_stringValue, & @@ -685,14 +685,14 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) IO_IntValue implicit none - integer(pInt), intent(in) :: fileUnit - + integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: nNodes, nElems + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - + nNodes = 0_pInt + nElems = 0_pInt rewind(fileUnit) do @@ -700,12 +700,12 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) chunkPos = IO_stringPos(line) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) + nElems = IO_IntValue (line,chunkPos,3_pInt) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) - mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) - exit ! assumes that "coordinates" comes later in file + nNodes = IO_IntValue (line,chunkPos,2_pInt) + exit ! assumes that "coordinates" comes later in file endif enddo @@ -713,10 +713,9 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) !-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and -!! 'mesh_maxNelemInSet' +!> @brief Count overall number of element sets in mesh. !-------------------------------------------------------------------------------------------------- - subroutine mesh_marc_count_elementSets(fileUnit) + subroutine mesh_marc_count_elementSets(nElemSets,maxNelemInSet,fileUnit) use IO, only: & IO_lc, & IO_stringValue, & @@ -725,13 +724,13 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: nElemSets, maxNelemInSet integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = 0_pInt + character(len=300) :: line + nElemSets = 0_pInt + maxNelemInSet = 0_pInt rewind(fileUnit) do @@ -740,21 +739,19 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then - mesh_NelemSets = mesh_NelemSets + 1_pInt - mesh_maxNelemInSet = max(mesh_maxNelemInSet, & - IO_countContinuousIntValues(fileUnit)) + nElemSets = nElemSets + 1_pInt + maxNelemInSet = max(maxNelemInSet, IO_countContinuousIntValues(fileUnit)) endif enddo 620 end subroutine mesh_marc_count_elementSets -!******************************************************************** -! map element sets -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!******************************************************************** -subroutine mesh_marc_map_elementSets(fileUnit) +!-------------------------------------------------------------------------------------------------- +!> @brief map element sets +!! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemInSet,fileUnit) use IO, only: IO_lc, & IO_stringValue, & @@ -762,15 +759,17 @@ subroutine mesh_marc_map_elementSets(fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit,NelemSets,maxNelemInSet + character(len=64), dimension(mesh_NelemSets), intent(out) :: & + nameElemSet + integer(pInt), dimension(1_pInt+maxNelemInSet,NelemSets), intent(out) :: & + mapElemSet integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) - + integer(pInt) :: elemSet + + elemSet = 0_pInt rewind(fileUnit) do @@ -779,9 +778,8 @@ subroutine mesh_marc_map_elementSets(fileUnit) if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then elemSet = elemSet+1_pInt - mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mesh_mapElemSet(:,elemSet) = & - IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,maxNelemInSet,nameElemSet,mapElemSet,NelemSets) endif enddo @@ -791,7 +789,7 @@ subroutine mesh_marc_map_elementSets(fileUnit) !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpElements(fileUnit) +integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileFormatVersion,fileUnit) use IO, only: IO_lc, & IO_stringValue, & @@ -802,48 +800,48 @@ subroutine mesh_marc_count_cpElements(fileUnit) IO_countNumericalDataLines implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit, tableStyle,fileFormatVersion + integer(pInt), dimension(:), intent(in) :: matNumber integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: i character(len=300):: line - mesh_NcpElems = 0_pInt + mesh_marc_count_cpElements = 0_pInt rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier + if (fileFormatVersion < 13) then ! Marc 2016 or earlier do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines + do i=1_pInt,3_pInt+tableStyle ! Skip 3 or 4 lines read (fileUnit,'(A300)') line enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update + mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countContinuousIntValues(fileUnit) exit endif enddo - else ! Marc2017 and later + else ! Marc2017 and later do read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) - if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) + if (any(matNumber==IO_intValue(line,chunkPos,6_pInt))) then + mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countNumericalDataLines(fileUnit) endif endif enddo end if -620 end subroutine mesh_marc_count_cpElements +620 end function mesh_marc_count_cpElements !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_map_elements(fileUnit) @@ -864,24 +862,21 @@ subroutine mesh_marc_map_elements(fileUnit) integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts integer(pInt) :: i,cpElem = 0_pInt - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - - contInts = 0_pInt rewind(fileUnit) do read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) - if (MarcVersion < 13) then ! Marc 2016 or earlier + if (MarcVersion < 13) then ! Marc 2016 or earlier if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines + do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines read (fileUnit,'(A300)') line enddo contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& mesh_mapElemSet,mesh_NelemSets) exit endif - else ! Marc2017 and later + else ! Marc2017 and later if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) @@ -890,7 +885,7 @@ subroutine mesh_marc_map_elements(fileUnit) read (fileUnit,'(A300)',END=660) line chunkPos = IO_stringPos(line) tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),"0123456789")/=0) then ! found keyword + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword exit else contInts(1) = contInts(1) + 1_pInt @@ -907,14 +902,13 @@ subroutine mesh_marc_map_elements(fileUnit) mesh_mapFEtoCPelem(2,cpElem) = cpElem enddo -call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems +call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems end subroutine mesh_marc_map_elements !-------------------------------------------------------------------------------------------------- !> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_map_nodes(fileUnit) @@ -933,9 +927,6 @@ subroutine mesh_marc_map_nodes(fileUnit) integer(pInt), dimension (mesh_Nnodes) :: node_count integer(pInt) :: i - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - - node_count = 0_pInt rewind(fileUnit) @@ -943,10 +934,10 @@ subroutine mesh_marc_map_nodes(fileUnit) read (fileUnit,'(A300)',END=650) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,'(A300)') line ! skip crap line + read (fileUnit,'(A300)') line ! skip crap line do i = 1_pInt,mesh_Nnodes read (fileUnit,'(A300)') line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) + mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[0_pInt,10_pInt],1_pInt) mesh_mapFEtoCPnode(2_pInt,i) = i enddo exit @@ -988,7 +979,7 @@ subroutine mesh_marc_build_nodes(fileUnit) read (fileUnit,'(A300)',END=670) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,'(A300)') line ! skip crap line + read (fileUnit,'(A300)') line ! skip crap line do i=1_pInt,mesh_Nnodes read (fileUnit,'(A300)') line m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) @@ -1010,9 +1001,10 @@ end subroutine mesh_marc_build_nodes !! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', !! and 'mesh_maxNcellnodes' !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpSizes(fileUnit) +integer(pInt) function mesh_marc_count_cpSizes(fileUnit) use IO, only: IO_lc, & + IO_error, & IO_stringValue, & IO_stringPos, & IO_intValue, & @@ -1029,20 +1021,22 @@ subroutine mesh_marc_count_cpSizes(fileUnit) mesh_maxNips = 0_pInt mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt - + t = -1_pInt rewind(fileUnit) do read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,'(A300)') line ! Garbage line + read (fileUnit,'(A300)') line ! Garbage line do i=1_pInt,mesh_Nelems ! read all elements read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) ! limit to id and type e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + if (t == -1_pInt) t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message + mesh_marc_count_cpSizes = t g = FE_geomtype(t) c = FE_celltype(g) mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) @@ -1056,7 +1050,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit) endif enddo -630 end subroutine mesh_marc_count_cpSizes +630 end function mesh_marc_count_cpSizes !-------------------------------------------------------------------------------------------------- From b9f93d5460d74c564f42f39d54f11cd1091a41cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 11:22:23 +0100 Subject: [PATCH 130/309] is now a subfunction --- src/mesh_abaqus.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 20fef4098..05a4a71af 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -367,7 +367,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & FE_mapElemtype, & - mesh_faceMatch, & mesh_build_FEdata, & mesh_build_nodeTwins, & mesh_build_sharedElems, & From 91992debf292233c1a36080ca76e8aba7b216ee1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 13:30:04 +0100 Subject: [PATCH 131/309] Marc now works also with the module reason, why it did NOT work earlier still not clear --- src/numerics.f90 | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/numerics.f90 b/src/numerics.f90 index 9e585dda7..1678d0c48 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -177,13 +177,8 @@ subroutine numerics_init #include use petscsys #endif -#if !defined(Marc4DAMASK) -!$ use OMP_LIB, only: omp_set_num_threads ! Standard conforming module +!$ use OMP_LIB, only: omp_set_num_threads implicit none -#else - implicit none -!$ include "omp_lib.h" ! MSC.Marc includes this file on !its own, avoid conflict with the OMP_LIB module -#endif integer(pInt), parameter :: FILEUNIT = 300_pInt !$ integer :: gotDAMASK_NUM_THREADS = 1 integer :: i, ierr ! no pInt From 2aba6faf4086a4c9b9c7558149ef8d135ed25d3a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 12:28:04 +0100 Subject: [PATCH 132/309] cleaning and making dependencies clear --- src/mesh_abaqus.f90 | 21 ++++++++++----------- src/mesh_marc.f90 | 21 ++++++++++----------- 2 files changed, 20 insertions(+), 22 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 05a4a71af..89f0eed06 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -490,7 +490,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_abaqus_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - call mesh_get_damaskOptions(FILEUNIT) + call mesh_get_damaskOptions(mesh_periodic_surface,FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) @@ -1269,7 +1269,7 @@ end subroutine mesh_abaqus_build_elements !-------------------------------------------------------------------------------------------------- !> @brief get any additional damask options from input file, sets mesh_periodicSurface !-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) +subroutine mesh_get_damaskOptions(periodic_surface,fileUnit) use IO, only: & IO_lc, & @@ -1282,24 +1282,23 @@ use IO, only: & integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat - logical :: inPart - integer(pInt) chunk, Nchunks - character(len=300) :: damaskOption, v - character(len=*), parameter :: keyword = '**damask' + integer(pInt) :: chunk, Nchunks + character(len=300) :: v + logical, dimension(3) :: periodic_surface + - mesh_periodicSurface = .false. + periodic_surface = .false. myStat = 0 rewind(fileUnit) do while(myStat == 0) read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(damaskOption) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '**damask' .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case('periodic') ! damask Option that allows to specify periodic fluxes do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) - v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? + v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 0421a9452..506f6a107 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -484,8 +484,7 @@ subroutine mesh_init(ip,el) allocate(mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = 'n/a' allocate(mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) - call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,& - mesh_NelemSets,mesh_maxNelemInSet,FILEUNIT) + call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) mesh_NcpElems = mesh_marc_count_cpElements(hypoelasticTableStyle,Marc_matNumber,fileFormatVersion,FILEUNIT) @@ -500,6 +499,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) call mesh_marc_build_nodes(FILEUNIT) !ToDo: don't work on global variables + mesh_node = mesh_node0 if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) elemType = mesh_marc_count_cpSizes(FILEUNIT) @@ -626,7 +626,7 @@ subroutine mesh_marc_get_tableStyles(initialcond, hypoelastic,fileUnit) !-------------------------------------------------------------------------------------------------- -!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array +!> @brief Figures out material number of hypoelastic material !-------------------------------------------------------------------------------------------------- function mesh_marc_get_matNumber(fileUnit,tableStyle) use IO, only: & @@ -751,7 +751,7 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) !> @brief map element sets !! allocate globals: mesh_nameElemSet, mesh_mapElemSet !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemInSet,fileUnit) +subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) use IO, only: IO_lc, & IO_stringValue, & @@ -759,10 +759,10 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemIn IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,NelemSets,maxNelemInSet - character(len=64), dimension(mesh_NelemSets), intent(out) :: & + integer(pInt), intent(in) :: fileUnit,NelemSets + character(len=64), dimension(:), intent(out) :: & nameElemSet - integer(pInt), dimension(1_pInt+maxNelemInSet,NelemSets), intent(out) :: & + integer(pInt), dimension(:,:), intent(out) :: & mapElemSet integer(pInt), allocatable, dimension(:) :: chunkPos @@ -779,7 +779,7 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemIn (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then elemSet = elemSet+1_pInt nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,maxNelemInSet,nameElemSet,mapElemSet,NelemSets) + mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,size(mapElemSet,1)-1,nameElemSet,mapElemSet,size(nameElemSet)) endif enddo @@ -860,8 +860,9 @@ subroutine mesh_marc_map_elements(fileUnit) tmp integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,cpElem = 0_pInt + integer(pInt) :: i,cpElem + cpElem = 0_pInt contInts = 0_pInt rewind(fileUnit) do @@ -971,8 +972,6 @@ subroutine mesh_marc_build_nodes(fileUnit) integer(pInt) :: i,j,m allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - rewind(fileUnit) do From 2d0c74d7d9257d80ba4c4976bbfbecd312dbe4fd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 12:54:10 +0100 Subject: [PATCH 133/309] implicit dependencies made explicit --- src/mesh_marc.f90 | 58 +++++++++++++++++++++++------------------------ 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 506f6a107..4e4adbc36 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -61,7 +61,6 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) integer(pInt), private :: & - mesh_maxNelemInSet, & mesh_Nmaterials integer(pInt), dimension(:,:), allocatable, private :: & @@ -342,9 +341,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_maxNnodes, & !< max number of nodes in any CP element mesh_NelemSets character(len=64), dimension(:), allocatable, private :: & - mesh_nameElemSet, & !< names of elementSet - mesh_nameMaterial, & !< names of material in solid section - mesh_mapMaterial !< name of elementSet for material + mesh_nameElemSet + integer(pInt), dimension(:,:), allocatable, private :: & mesh_mapElemSet !< list of elements in elementSet integer(pInt), dimension(:,:), allocatable, target, private :: & @@ -450,6 +448,8 @@ subroutine mesh_init(ip,el) integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt) :: j, fileFormatVersion, elemType + integer(pInt) :: & + mesh_maxNelemInSet logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' @@ -491,7 +491,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - call mesh_marc_map_elements(FILEUNIT) !ToDo: don't work on global variables + call mesh_marc_map_elements(hypoelasticTableStyle,mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) @@ -510,7 +510,7 @@ subroutine mesh_init(ip,el) call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - call mesh_get_damaskOptions(FILEUNIT) + call mesh_get_damaskOptions(mesh_periodicSurface,FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) @@ -674,8 +674,7 @@ function mesh_marc_get_matNumber(fileUnit,tableStyle) !-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores the numbers in -!! 'mesh_Nelems' and 'mesh_Nnodes' +!> @brief Count overall number of nodes and elements !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) use IO, only: & @@ -749,7 +748,6 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) !-------------------------------------------------------------------------------------------------- !> @brief map element sets -!! allocate globals: mesh_nameElemSet, mesh_mapElemSet !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) @@ -843,7 +841,7 @@ integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileForma !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(fileUnit) +subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) use math, only: math_qsort use IO, only: IO_lc, & @@ -853,7 +851,10 @@ subroutine mesh_marc_map_elements(fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit,tableStyle + character(len=64), intent(in), dimension(:) :: nameElemSet + integer(pInt), dimension(:,:), intent(in) :: & + mapElemSet integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line, & @@ -870,11 +871,11 @@ subroutine mesh_marc_map_elements(fileUnit) chunkPos = IO_stringPos(line) if (MarcVersion < 13) then ! Marc 2016 or earlier if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines + do i=1_pInt,3_pInt+TableStyle ! skip three (or four if new table style!) lines read (fileUnit,'(A300)') line enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& - mesh_mapElemSet,mesh_NelemSets) + contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,nameElemSet,& + mapElemSet,size(nameElemSet)) exit endif else ! Marc2017 and later @@ -1158,7 +1159,7 @@ subroutine mesh_marc_build_elements(fileUnit) !-------------------------------------------------------------------------------------------------- !> @brief get any additional damask options from input file, sets mesh_periodicSurface !-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) +subroutine mesh_get_damaskOptions(periodic_surface,fileUnit) use IO, only: & IO_lc, & @@ -1168,23 +1169,23 @@ use IO, only: & implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword - - mesh_periodicSurface = .false. - keyword = '$damask' + character(len=300) :: line + integer :: myStat + integer(pInt) :: chunk, Nchunks + character(len=300) :: v + logical, dimension(3) :: periodic_surface + + periodic_surface = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(A300)',END=620) line + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(damaskOption) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '$damask' .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case('periodic') ! damask Option that allows to specify periodic fluxes do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? @@ -1196,8 +1197,7 @@ use IO, only: & endif enddo - -620 end subroutine mesh_get_damaskOptions +end subroutine mesh_get_damaskOptions !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. From ec23fca05779f07b7e286baa74c873d66d79d270 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 14:21:42 +0100 Subject: [PATCH 134/309] it's a property of the element, not of the mesh --- src/plastic_nonlocal.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index e8562e55e..ef1dac3d9 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -234,8 +234,7 @@ use IO, only: IO_read, & use debug, only: debug_level, & debug_constitutive, & debug_levelBasic -use mesh, only: theMesh, & - mesh_maxNipNeighbors +use mesh, only: theMesh use material, only: phase_plasticity, & homogenization_maxNgrains, & phase_plasticityInstance, & @@ -829,7 +828,7 @@ allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrai allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(compatibility(2,maxTotalNslip,maxTotalNslip,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), & +allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) allocate(peierlsStress(maxTotalNslip,2,maxNinstances), source=0.0_pReal) allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) From b0b1ea3b842dc7736ea2f9aa54699f61fd049d98 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 14:23:32 +0100 Subject: [PATCH 135/309] input argument not needed any more --- src/mesh_marc.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 4e4adbc36..8c53c5a2d 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -757,7 +757,7 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,NelemSets + integer(pInt), intent(in) :: fileUnit character(len=64), dimension(:), intent(out) :: & nameElemSet integer(pInt), dimension(:,:), intent(out) :: & From 59dd9b16e1915841417ad00378ffc7086a4feb43 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 16:40:15 +0100 Subject: [PATCH 136/309] cleaning --- src/DAMASK_marc.f90 | 6 +- src/mesh_marc.f90 | 967 ++++---------------------------------------- 2 files changed, 85 insertions(+), 888 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0c7d1adeb..d33cdd4cc 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -134,6 +134,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & debug_info, & debug_reset use mesh, only: & + theMesh, & mesh_FEasCP, & mesh_element, & mesh_node0, & @@ -141,8 +142,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & mesh_Ncellnodes, & mesh_cellnode, & mesh_build_cellnodes, & - mesh_build_ipCoordinates, & - FE_Nnodes + mesh_build_ipCoordinates use CPFEM, only: & CPFEM_general, & CPFEM_init_done, & @@ -314,7 +314,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! collect and backup Jacobian after convergence lastIncConverged = .false. ! reset flag endif - do node = 1,FE_Nnodes(mesh_element(2,cp_en)) + do node = 1,theMesh%elem%nNodes CPnodeID = mesh_element(4_pInt+node,cp_en) mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node) enddo diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 8c53c5a2d..a269b60e4 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -13,18 +13,11 @@ module mesh implicit none private integer(pInt), public, protected :: & - mesh_NcpElems, & !< total number of CP elements in local mesh mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes) mesh_Nnodes, & !< total number of nodes in mesh mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh - mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node -!!!! BEGIN DEPRECATED !!!!! - integer(pInt), public, protected :: & - mesh_maxNips, & !< max number of IPs in any CP element - mesh_maxNcellnodes !< max number of cell nodes in any CP element -!!!! BEGIN DEPRECATED !!!!! integer(pInt), dimension(:), allocatable, public, protected :: & mesh_homogenizationAt, & !< homogenization ID of each element @@ -70,16 +63,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell integer(pInt), dimension(:,:,:), allocatable, private :: & - FE_nodesAtIP, & !< map IP index to node indices in a specific type of element - FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element - FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell - real(pReal), dimension(:,:,:), allocatable, private :: & - FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes - - integer(pInt), dimension(:,:,:,:), allocatable, private :: & - FE_subNodeOnIPFace ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! Hence, I suggest to prefix with "FE_" @@ -88,8 +73,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & FE_Nelemtypes = 13_pInt, & FE_Ngeomtypes = 10_pInt, & FE_Ncelltypes = 4_pInt, & - FE_maxNnodes = 20_pInt, & - FE_maxNips = 27_pInt, & FE_maxNipNeighbors = 6_pInt, & FE_maxmaxNnodesAtIP = 8_pInt, & !< max number of (equivalent) nodes attached to an IP FE_maxNmatchingNodesPerFace = 4_pInt, & @@ -99,69 +82,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & FE_maxNcellfaces = 6_pInt, & FE_maxNcellnodesPerCellface = 4_pInt - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type - int([ & - 1, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 3, & ! element 11 (2D 4node 4ip) - 4, & ! element 27 (2D 8node 9ip) - 3, & ! element 54 (2D 8node 4ip) - 5, & ! element 134 (3D 4node 1ip) - 6, & ! element 157 (3D 5node 4ip) - 6, & ! element 127 (3D 10node 4ip) - 7, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 9, & ! element 7 (3D 8node 8ip) - 9, & ! element 57 (3D 20node 8ip) - 10 & ! element 21 (3D 20node 27ip) - ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type - int([ & - 1, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 4, & ! element 136 (3D 6node 6ip) - 4, & ! element 117 (3D 8node 1ip) - 4, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type - int([ & - 2, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 3, & ! element 127 (3D 10node 4ip) - 3, & ! element 136 (3D 6node 6ip) - 3, & ! element 117 (3D 8node 1ip) - 3, & ! element 7 (3D 8node 8ip) - 3 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element - int([ & - 3, & ! element 6 (2D 3node 1ip) - 6, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 8, & ! element 27 (2D 8node 9ip) - 8, & ! element 54 (2D 8node 4ip) - 4, & ! element 134 (3D 4node 1ip) - 5, & ! element 157 (3D 5node 4ip) - 10, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 20, & ! element 57 (3D 20node 8ip) - 20 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nfaces = & !< number of faces of a specific type of element geometry + integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Nfaces = & !< number of faces of a specific type of element geometry int([ & 3, & ! element 6 (2D 3node 1ip) 3, & ! element 125 (2D 6node 3ip) @@ -269,27 +191,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8,7,6,5 & ],pInt),[FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes]) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type - int([ & - 3, & ! element 6 (2D 3node 1ip) - 7, & ! element 125 (2D 6node 3ip) - 9, & ! element 11 (2D 4node 4ip) - 16, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 15, & ! element 127 (3D 10node 4ip) - 21, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 27, & ! element 7 (3D 8node 8ip) - 64 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCell = & !< number of cell nodes in a specific cell type - int([ & - 3, & ! (2D 3node) - 4, & ! (2D 4node) - 4, & ! (3D 4node) - 8 & ! (3D 8node) - ],pInt) integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type int([& @@ -299,21 +200,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element - int([ & - 1, & ! element 6 (2D 3node 1ip) - 3, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 9, & ! element 27 (2D 8node 9ip) - 1, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 1, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 27 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type int([& 3, & ! (2D 3node) 4, & ! (2D 4node) @@ -322,23 +209,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_maxNnodesAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element - int([ & - 3, & ! element 6 (2D 3node 1ip) - 1, & ! element 125 (2D 6node 3ip) - 1, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 1, & ! element 127 (3D 10node 4ip) - 1, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 1, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - integer(pInt), private :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) - mesh_maxNnodes, & !< max number of nodes in any CP element mesh_NelemSets character(len=64), dimension(:), allocatable, private :: & mesh_nameElemSet @@ -385,7 +257,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_marc_map_Elements, & mesh_marc_map_nodes, & mesh_marc_build_nodes, & - mesh_marc_count_cpSizes, & mesh_marc_build_elements type, public, extends(tMesh) :: tMesh_marc @@ -449,7 +320,8 @@ subroutine mesh_init(ip,el) integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt) :: j, fileFormatVersion, elemType integer(pInt) :: & - mesh_maxNelemInSet + mesh_maxNelemInSet, & + mesh_NcpElems logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' @@ -491,14 +363,14 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - call mesh_marc_map_elements(hypoelasticTableStyle,mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) !ToDo: don't work on global variables + call mesh_marc_map_elements(hypoelasticTableStyle,mesh_nameElemSet,mesh_mapElemSet,mesh_NcpElems,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - call mesh_marc_map_nodes(FILEUNIT) !ToDo: don't work on global variables + call mesh_marc_map_nodes(mesh_Nnodes,FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_marc_build_nodes(FILEUNIT) !ToDo: don't work on global variables + call mesh_marc_build_nodes(FILEUNIT) !ToDo: don't work on global variables mesh_node = mesh_node0 if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) @@ -535,18 +407,18 @@ subroutine mesh_init(ip,el) call mesh_build_ipNeighborhood if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & + if (usePingPong .and. (mesh_Nelems /= theMesh%nElems)) & call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements - if (debug_e < 1 .or. debug_e > mesh_NcpElems) & + if (debug_e < 1 .or. debug_e > theMesh%nElems) & call IO_error(602_pInt,ext_msg='element') ! selected element does not exist - if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & + if (debug_i < 1 .or. debug_i > theMesh%elem%nIPs) & call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP - FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements - allocate(FEsolving_execIP(2_pInt,mesh_NcpElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... - forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element + FEsolving_execElem = [ 1_pInt,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements + allocate(FEsolving_execIP(2_pInt,theMesh%nElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... + FEsolving_execIP(2,:) = theMesh%elem%nIPs - allocate(calcMode(mesh_maxNips,mesh_NcpElems)) + allocate(calcMode(theMesh%elem%nIPs,theMesh%nElems)) calcMode = .false. ! pretend to have collected what first call is asking (F = I) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" @@ -785,7 +657,7 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) !-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!> @brief Count overall number of CP elements in mesh !-------------------------------------------------------------------------------------------------- integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileFormatVersion,fileUnit) @@ -841,7 +713,7 @@ integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileForma !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) +subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileUnit) use math, only: math_qsort use IO, only: IO_lc, & @@ -851,7 +723,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,tableStyle + integer(pInt), intent(in) :: fileUnit,tableStyle,nElems character(len=64), intent(in), dimension(:) :: nameElemSet integer(pInt), dimension(:,:), intent(in) :: & mapElemSet @@ -860,7 +732,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) character(len=300) :: line, & tmp - integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts + integer(pInt), dimension (1_pInt+nElems) :: contInts integer(pInt) :: i,cpElem cpElem = 0_pInt @@ -874,7 +746,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) do i=1_pInt,3_pInt+TableStyle ! skip three (or four if new table style!) lines read (fileUnit,'(A300)') line enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,nameElemSet,& + contInts = IO_continuousIntValues(fileUnit,nElems,nameElemSet,& mapElemSet,size(nameElemSet)) exit endif @@ -912,7 +784,7 @@ end subroutine mesh_marc_map_elements !-------------------------------------------------------------------------------------------------- !> @brief Maps node from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_nodes(fileUnit) +subroutine mesh_marc_map_nodes(nNodes,fileUnit) use math, only: math_qsort use IO, only: IO_lc, & @@ -921,12 +793,12 @@ subroutine mesh_marc_map_nodes(fileUnit) IO_fixedIntValue implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit, nNodes integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt), dimension (nNodes) :: node_count integer(pInt) :: i node_count = 0_pInt @@ -937,7 +809,7 @@ subroutine mesh_marc_map_nodes(fileUnit) chunkPos = IO_stringPos(line) if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then read (fileUnit,'(A300)') line ! skip crap line - do i = 1_pInt,mesh_Nnodes + do i = 1_pInt,nNodes read (fileUnit,'(A300)') line mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[0_pInt,10_pInt],1_pInt) mesh_mapFEtoCPnode(2_pInt,i) = i @@ -953,7 +825,6 @@ end subroutine mesh_marc_map_nodes !-------------------------------------------------------------------------------------------------- !> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_build_nodes(fileUnit) @@ -1017,10 +888,6 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) character(len=300) :: line integer(pInt) :: i,t,g,e,c - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt t = -1_pInt rewind(fileUnit) @@ -1037,13 +904,7 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) if (t == -1_pInt) t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message mesh_marc_count_cpSizes = t - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line + !call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line !ToDo: this is dangerous in case of a non-CP element, everything is mixed up endif enddo exit @@ -1074,10 +935,10 @@ subroutine mesh_marc_build_elements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts + integer(pInt), dimension(1_pInt+theMesh%nElems) :: contInts integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead - allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + allocate(mesh_element(4_pInt+theMesh%elem%nNodes,theMesh%nElems), source=0_pInt) mesh_elemType = -1_pInt @@ -1103,7 +964,7 @@ subroutine mesh_marc_build_elements(fileUnit) mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes enddo nNodesAlreadyRead = chunkPos(1) - 2_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + do while(nNodesAlreadyRead < theMesh%elem%nNodes) ! read on if not all nodes in one line read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) do j = 1_pInt,chunkPos(1) @@ -1138,7 +999,7 @@ subroutine mesh_marc_build_elements(fileUnit) read (fileUnit,'(A300)',END=630) line ! read extra line endif contInts = IO_continuousIntValues& ! get affected elements - (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + (fileUnit,theMesh%nElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) do i = 1_pInt,contInts(1) e = mesh_FEasCP('elem',contInts(1_pInt+i)) mesh_element(1_pInt+sv,e) = myVal @@ -1320,23 +1181,23 @@ subroutine mesh_build_ipVolumes integer(pInt) :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + allocate(mesh_ipVolume(theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems + do e = 1_pInt,theMesh%nElems ! loop over cpElems t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + g = theMesh%elem%geomType + c = theMesh%elem%cellType select case (c) case (1_pInt) ! 2D 3node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) case (2_pInt) ! 2D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) & @@ -1345,7 +1206,7 @@ subroutine mesh_build_ipVolumes mesh_cellnode(1:3,mesh_cell(1,i,e))) case (3_pInt) ! 3D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e)), & @@ -1353,7 +1214,7 @@ subroutine mesh_build_ipVolumes case (4_pInt) ! 3D 8node m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element subvolume = 0.0_pReal forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & subvolume(n,f) = math_volTetrahedron(& @@ -1390,19 +1251,19 @@ subroutine mesh_build_ipCoordinates real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & - allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems + do e = 1_pInt,theMesh%nElems ! loop over cpElems t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + g = theMesh%elem%geomType + c = theMesh%elem%cellType + do i = 1_pInt,theMesh%elem%nIPs myCoords = 0.0_pReal - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + do n = 1_pInt,theMesh%elem%nCellnodesPerCell myCoords = myCoords + mesh_cellnode(1:3,mesh_cell(n,i,e)) enddo - mesh_ipCoordinates(1:3,i,e) = myCoords / real(FE_NcellnodesPerCell(c),pReal) + mesh_ipCoordinates(1:3,i,e) = myCoords / real(theMesh%elem%nCellnodesPerCell,pReal) enddo enddo !$OMP END PARALLEL DO @@ -1422,13 +1283,13 @@ pure function mesh_cellCenterCoordinates(ip,el) integer(pInt) :: t,g,c,n t = mesh_element(2_pInt,el) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + g = theMesh%elem%geomType + c = theMesh%elem%cellType mesh_cellCenterCoordinates = 0.0_pReal - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + do n = 1_pInt,theMesh%elem%nCellnodesPerCell mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) enddo - mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(theMesh%elem%nCellnodesPerCell,pReal) end function mesh_cellCenterCoordinates @@ -1448,18 +1309,18 @@ subroutine mesh_build_ipAreas real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal - allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipArea(theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems + do e = 1_pInt,theMesh%nElems ! loop over cpElems t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + g = theMesh%elem%geomType + c = theMesh%elem%cellType select case (c) case (1_pInt,2_pInt) ! 2D 3 or 4 node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1_pInt,theMesh%elem%nIPs do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1472,7 +1333,7 @@ subroutine mesh_build_ipAreas enddo case (3_pInt) ! 3D 4node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1_pInt,theMesh%elem%nIPs do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1489,7 +1350,7 @@ subroutine mesh_build_ipAreas ! the sum has to be divided by two; this whole prcedure tries to compensate for ! probable non-planar cell surfaces m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do i = 1_pInt,theMesh%elem%nIPs do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) @@ -1600,8 +1461,8 @@ subroutine mesh_build_sharedElems node_count = 0_pInt - do e = 1_pInt,mesh_NcpElems - g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + do e = 1_pInt,theMesh%nElems + g = theMesh%elem%geomType node_seen = 0_pInt ! reset node duplicates do n = 1_pInt,FE_NmatchingNodes(g) ! check each node of element node = mesh_element(4+n,e) @@ -1621,8 +1482,8 @@ subroutine mesh_build_sharedElems allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) - do e = 1_pInt,mesh_NcpElems - g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + do e = 1_pInt,theMesh%nElems + g = theMesh%elem%geomType node_seen = 0_pInt do n = 1_pInt,FE_NmatchingNodes(g) node = mesh_element(4_pInt+n,e) @@ -1675,16 +1536,16 @@ subroutine mesh_build_ipNeighborhood matchingNodes logical checkTwins - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) + allocate(mesh_ipNeighborhood(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems)) mesh_ipNeighborhood = 0_pInt - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems - myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + do myElem = 1_pInt,theMesh%nElems ! loop over cpElems + myType = theMesh%elem%geomType + do myIP = 1_pInt,theMesh%elem%nIPs - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP - neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) + do neighbor = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP + neighboringIPkey = theMesh%elem%IPneighbor(neighbor,myIP) !*** if the key is positive, the neighbor is inside the element !*** that means, we have already found our neighboring IP @@ -1701,11 +1562,11 @@ subroutine mesh_build_ipNeighborhood myFace = -neighboringIPkey call mesh_faceMatch(myElem, myFace, matchingElem, matchingFace) ! get face and CP elem id of face match if (matchingElem > 0_pInt) then ! found match? - neighboringType = FE_geomtype(mesh_element(2,matchingElem)) + neighboringType = theMesh%elem%geomType !*** trivial solution if neighbor has only one IP - if (FE_Nips(neighboringType) == 1_pInt) then + if (theMesh%elem%nIPs == 1_pInt) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt cycle @@ -1715,8 +1576,8 @@ subroutine mesh_build_ipNeighborhood NlinkedNodes = 0_pInt linkedNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face - anchor = FE_nodesAtIP(a,myIP,myType) + do a = 1_pInt,theMesh%elem%maxNnodeAtIP + anchor = theMesh%elem%NnodeAtIP(a,myIP) if (anchor /= 0_pInt) then ! valid anchor node if (any(FE_face(:,myFace,myType) == anchor)) then ! ip anchor sits on face? NlinkedNodes = NlinkedNodes + 1_pInt @@ -1733,11 +1594,11 @@ subroutine mesh_build_ipNeighborhood !*** and try to find an ip with matching nodes !*** also try to match with node twins - checkCandidateIP: do candidateIP = 1_pInt,FE_Nips(neighboringType) + checkCandidateIP: do candidateIP = 1_pInt,theMesh%elem%nIPs NmatchingNodes = 0_pInt matchingNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip - anchor = FE_nodesAtIP(a,candidateIP,neighboringType) + do a = 1_pInt,theMesh%elem%maxNnodeAtIP + anchor = theMesh%elem%NnodeAtIP(a,candidateIP) if (anchor /= 0_pInt) then ! valid anchor node if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? NmatchingNodes = NmatchingNodes + 1_pInt @@ -1787,15 +1648,15 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems - myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + do myElem = 1_pInt,theMesh%nElems ! loop over cpElems + myType = theMesh%elem%geomType + do myIP = 1_pInt,theMesh%elem%nIPs + do neighbor = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP neighboringElem = mesh_ipNeighborhood(1,neighbor,myIP,myElem) neighboringIP = mesh_ipNeighborhood(2,neighbor,myIP,myElem) if (neighboringElem > 0_pInt .and. neighboringIP > 0_pInt) then ! if neighbor exists ... - neighboringType = FE_geomtype(mesh_element(2,neighboringElem)) - do pointingToMe = 1_pInt,FE_NipNeighbors(FE_celltype(neighboringType)) ! find neighboring index that points from my neighbor to myself + neighboringType = theMesh%elem%geomType + do pointingToMe = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! find neighboring index that points from my neighbor to myself if ( myElem == mesh_ipNeighborhood(1,pointingToMe,neighboringIP,neighboringElem) & .and. myIP == mesh_ipNeighborhood(2,pointingToMe,neighboringIP,neighboringElem)) then ! possible candidate if (math_mul3x3(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem),& @@ -1822,7 +1683,7 @@ integer(pInt), intent(out) :: matchingElem, & matchingFace ! matching face ID integer(pInt), intent(in) :: face, & ! face ID elem ! CP elem ID -integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & +integer(pInt), dimension(FE_NmatchingNodesPerFace(face,theMesh%elem%geomType)) :: & myFaceNodes ! global node ids on my face integer(pInt) :: myType, & candidateType, & @@ -1841,7 +1702,7 @@ logical checkTwins matchingElem = 0_pInt matchingFace = 0_pInt minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case -myType = FE_geomtype(mesh_element(2_pInt,elem)) ! figure elemGeomType +myType =theMesh%elem%geomType do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face myFaceNodes(n) = mesh_element(4_pInt+FE_face(n,face,myType),elem) ! CP id of face node @@ -1859,7 +1720,7 @@ checkCandidate: do i = 1_pInt,minNsharedElems candidateElem = mesh_sharedElem(1_pInt+i,myFaceNodes(lonelyNode)) ! present candidate elem if (all(element_seen /= candidateElem)) then ! element seen for the first time? element_seen(i) = candidateElem - candidateType = FE_geomtype(mesh_element(2_pInt,candidateElem)) ! figure elemGeomType of candidate + candidateType = theMesh%elem%geomType checkCandidateFace: do candidateFace = 1_pInt,FE_maxNipNeighbors ! check each face of candidate if (FE_NmatchingNodesPerFace(candidateFace,candidateType) & /= FE_NmatchingNodesPerFace(face,myType) & ! incompatible face @@ -1949,678 +1810,14 @@ end function FE_mapElemtype !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements -!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!> @details assign globals FE_cellface !-------------------------------------------------------------------------------------------------- subroutine mesh_build_FEdata implicit none integer(pInt) :: me - allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_cellnodeParentnodeWeights(FE_maxNnodes,FE_maxNcellnodes,FE_Nelemtypes), source=0.0_pReal) allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) - - !*** fill FE_nodesAtIP with data *** - - me = 0_pInt - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - 1,2,3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, & - 2, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, & - 2, & - 4, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 1,0, & - 1,2, & - 2,0, & - 1,4, & - 0,0, & - 2,3, & - 4,0, & - 3,4, & - 3,0 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - 1,2,3,4 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - reshape(int([& - 1, & - 2, & - 3, & - 4 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - reshape(int([& - 1, & - 2, & - 3, & - 4, & - 5, & - 6 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - 1,2,3,4,5,6,7,8 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - reshape(int([& - 1, & - 2, & - 4, & - 3, & - 5, & - 6, & - 8, & - 7 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - reshape(int([& - 1,0, 0,0, & - 1,2, 0,0, & - 2,0, 0,0, & - 1,4, 0,0, & - 1,3, 2,4, & - 2,3, 0,0, & - 4,0, 0,0, & - 3,4, 0,0, & - 3,0, 0,0, & - 1,5, 0,0, & - 1,6, 2,5, & - 2,6, 0,0, & - 1,8, 4,5, & - 0,0, 0,0, & - 2,7, 3,6, & - 4,8, 0,0, & - 3,8, 4,7, & - 3,7, 0,0, & - 5,0, 0,0, & - 5,6, 0,0, & - 6,0, 0,0, & - 5,8, 0,0, & - 5,7, 6,8, & - 6,7, 0,0, & - 8,0, 0,0, & - 7,8, 0,0, & - 7,0, 0,0 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - - ! *** FE_ipNeighbor *** - ! is a list of the neighborhood of each IP. - ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. - ! Positive integers denote an intra-FE IP identifier. - ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. - me = 0_pInt - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - -2,-3,-1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 2,-3, 3,-1, & - -2, 1, 3,-1, & - 2,-3,-2, 1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 2,-4, 3,-1, & - -2, 1, 4,-1, & - 4,-4,-3, 1, & - -2, 3,-3, 2 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 2,-4, 4,-1, & - 3, 1, 5,-1, & - -2, 2, 6,-1, & - 5,-4, 7, 1, & - 6, 4, 8, 2, & - -2, 5, 9, 3, & - 8,-4,-3, 4, & - 9, 7,-3, 5, & - -2, 8,-3, 6 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - -1,-2,-3,-4 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - reshape(int([& - 2,-4, 3,-2, 4,-1, & - -2, 1, 3,-2, 4,-1, & - 2,-4,-3, 1, 4,-1, & - 2,-4, 3,-2,-3, 1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - reshape(int([& - 2,-4, 3,-2, 4,-1, & - -3, 1, 3,-2, 5,-1, & - 2,-4,-3, 1, 6,-1, & - 5,-4, 6,-2,-5, 1, & - -3, 4, 6,-2,-5, 2, & - 5,-4,-3, 4,-5, 3 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - -3,-5,-4,-2,-6,-1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - reshape(int([& - 2,-5, 3,-2, 5,-1, & - -3, 1, 4,-2, 6,-1, & - 4,-5,-4, 1, 7,-1, & - -3, 3,-4, 2, 8,-1, & - 6,-5, 7,-2,-6, 1, & - -3, 5, 8,-2,-6, 2, & - 8,-5,-4, 5,-6, 3, & - -3, 7,-4, 6,-6, 4 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - reshape(int([& - 2,-5, 4,-2,10,-1, & - 3, 1, 5,-2,11,-1, & - -3, 2, 6,-2,12,-1, & - 5,-5, 7, 1,13,-1, & - 6, 4, 8, 2,14,-1, & - -3, 5, 9, 3,15,-1, & - 8,-5,-4, 4,16,-1, & - 9, 7,-4, 5,17,-1, & - -3, 8,-4, 6,18,-1, & - 11,-5,13,-2,19, 1, & - 12,10,14,-2,20, 2, & - -3,11,15,-2,21, 3, & - 14,-5,16,10,22, 4, & - 15,13,17,11,23, 5, & - -3,14,18,12,24, 6, & - 17,-5,-4,13,25, 7, & - 18,16,-4,14,26, 8, & - -3,17,-4,15,27, 9, & - 20,-5,22,-2,-6,10, & - 21,19,23,-2,-6,11, & - -3,20,24,-2,-6,12, & - 23,-5,25,19,-6,13, & - 24,22,26,20,-6,14, & - -3,23,27,21,-6,15, & - 26,-5,-4,22,-6,16, & - 27,25,-4,23,-6,17, & - -3,26,-4,24,-6,18 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cell *** - me = 0_pInt - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - 1,2,3 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, 4, 7, 6, & - 2, 5, 7, 4, & - 3, 6, 7, 5 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, 5, 9, 8, & - 5, 2, 6, 9, & - 8, 9, 7, 4, & - 9, 6, 3, 7 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 1, 5,13,12, & - 5, 6,14,13, & - 6, 2, 7,14, & - 12,13,16,11, & - 13,14,15,16, & - 14, 7, 8,15, & - 11,16,10, 4, & - 16,15, 9,10, & - 15, 8, 3, 9 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - 1, 2, 3, 4 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - reshape(int([& - 1, 5,11, 7, 8,12,15,14, & - 5, 2, 6,11,12, 9,13,15, & - 7,11, 6, 3,14,15,13,10, & - 8,12,15, 4, 4, 9,13,10 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - reshape(int([& - 1, 7,16, 9,10,17,21,19, & - 7, 2, 8,16,17,11,18,21, & - 9,16, 8, 3,19,21,18,12, & - 10,17,21,19, 4,13,20,15, & - 17,11,18,21,13, 5,14,20, & - 19,21,18,12,15,20,14, 6 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - 1, 2, 3, 4, 5, 6, 7, 8 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - reshape(int([& - 1, 9,21,12,13,22,27,25, & - 9, 2,10,21,22,14,23,27, & - 12,21,11, 4,25,27,24,16, & - 21,10, 3,11,27,23,15,24, & - 13,22,27,25, 5,17,26,20, & - 22,14,23,27,17, 6,18,26, & - 25,27,24,16,20,26,19, 8, & - 27,23,15,24,26,18, 7,19 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - reshape(int([& - 1, 9,33,16,17,37,57,44, & - 9,10,34,33,37,38,58,57, & - 10, 2,11,34,38,18,39,58, & - 16,33,36,15,44,57,60,43, & - 33,34,35,36,57,58,59,60, & - 34,11,12,35,58,39,40,59, & - 15,36,14, 4,43,60,42,20, & - 36,35,13,14,60,59,41,42, & - 35,12, 3,13,59,40,19,41, & - 17,37,57,44,21,45,61,52, & - 37,38,58,57,45,46,62,61, & - 38,18,39,58,46,22,47,62, & - 44,57,60,43,52,61,64,51, & - 57,58,59,60,61,62,63,64, & - 58,39,40,59,62,47,48,63, & - 43,60,42,20,51,64,50,24, & - 60,59,41,42,64,63,49,50, & - 59,40,19,41,63,48,23,49, & - 21,45,61,52, 5,25,53,32, & - 45,46,62,61,25,26,54,53, & - 46,22,47,62,26, 6,27,54, & - 52,61,64,51,32,53,56,31, & - 61,62,63,64,53,54,55,56, & - 62,47,48,63,54,27,28,55, & - 51,64,50,24,31,56,30, 8, & - 64,63,49,50,56,55,29,30, & - 63,48,23,49,55,28, 7,29 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cellnodeParentnodeWeights *** - ! center of gravity of the weighted nodes gives the position of the cell node. - ! fill with 0. - ! example: face-centered cell node with face nodes 1,2,5,6 to be used in, - ! e.g., an 8 node element, would be encoded: - ! 1, 1, 0, 0, 1, 1, 0, 0 - me = 0_pInt - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) - reshape(real([& - 1, 0, 0, & - 0, 1, 0, & - 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 2, 2, 2 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) - reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1, & - 1, 1, 0, 0, & - 0, 1, 1, 0, & - 0, 0, 1, 1, & - 1, 0, 0, 1, & - 1, 1, 1, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 27 (2D 8node 9ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 1, 0, 0, 0, 2, 0, 0, 0, & - 0, 1, 0, 0, 2, 0, 0, 0, & - 0, 1, 0, 0, 0, 2, 0, 0, & - 0, 0, 1, 0, 0, 2, 0, 0, & - 0, 0, 1, 0, 0, 0, 2, 0, & - 0, 0, 0, 1, 0, 0, 2, 0, & - 0, 0, 0, 1, 0, 0, 0, 2, & - 1, 0, 0, 0, 0, 0, 0, 2, & - 4, 1, 1, 1, 8, 2, 2, 8, & - 1, 4, 1, 1, 8, 8, 2, 2, & - 1, 1, 4, 1, 2, 8, 8, 2, & - 1, 1, 1, 4, 2, 2, 8, 8 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 54 (2D 8node 4ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 1, 2, 2, 2, 2 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) - reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) - reshape(real([& - 1, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, & - 0, 0, 1, 0, 0, & - 0, 0, 0, 1, 0, & - 1, 1, 0, 0, 0, & - 0, 1, 1, 0, 0, & - 1, 0, 1, 0, 0, & - 1, 0, 0, 1, 0, & - 0, 1, 0, 1, 0, & - 0, 0, 1, 1, 0, & - 1, 1, 1, 0, 0, & - 1, 1, 0, 1, 0, & - 0, 1, 1, 1, 0, & - 1, 0, 1, 1, 0, & - 0, 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 127 (3D 10node 4ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & - 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & - 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & - 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & - 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & - 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 136 (3D 6node 6ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 1, & - 1, 1, 0, 0, 0, 0, & - 0, 1, 1, 0, 0, 0, & - 1, 0, 1, 0, 0, 0, & - 1, 0, 0, 1, 0, 0, & - 0, 1, 0, 0, 1, 0, & - 0, 0, 1, 0, 0, 1, & - 0, 0, 0, 1, 1, 0, & - 0, 0, 0, 0, 1, 1, & - 0, 0, 0, 1, 0, 1, & - 1, 1, 1, 0, 0, 0, & - 1, 1, 0, 1, 1, 0, & - 0, 1, 1, 0, 1, 1, & - 1, 0, 1, 1, 0, 1, & - 0, 0, 0, 1, 1, 1, & - 1, 1, 1, 1, 1, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 1, 0, 0, 0, 0, 0, & - 0, 0, 0, 1, 0, 0, 0, 0, & - 0, 0, 0, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 1, 0, 0, & - 0, 0, 0, 0, 0, 0, 1, 0, & - 0, 0, 0, 0, 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, & ! - 1, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 1, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 1, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 1, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 1, & ! - 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, & ! - 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, & ! - 1, 1, 1, 1, 1, 1, 1, 1 & ! - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! - 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! - 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) - reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 - 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! - 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 - 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! - 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! - 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! - 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 - 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! - 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 - 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! - 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! - 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 - 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! - 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! - 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! - 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! - 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 - 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! - 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! - 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! - 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - - ! *** FE_cellface *** me = 0_pInt From a57aa7985a9d9847b6fa84d61651b492e80a397b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 18:11:16 +0100 Subject: [PATCH 137/309] wrong name --- src/mesh_abaqus.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 89f0eed06..60b1484c1 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -490,7 +490,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_abaqus_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - call mesh_get_damaskOptions(mesh_periodic_surface,FILEUNIT) + call mesh_get_damaskOptions(mesh_periodicSurface,FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) From 5320803842a1f5d4abd99052e872d1c68c8f72e9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Feb 2019 00:06:38 +0100 Subject: [PATCH 138/309] bugfix: valid range for unit quaternion range is [-1,+1] --- src/rotations.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/rotations.f90 b/src/rotations.f90 index 59ee3512d..3f06d9a38 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -353,8 +353,6 @@ end function eu2qu !> @brief orientation matrix to Euler angles !--------------------------------------------------------------------------------------------------- pure function om2eu(om) result(eu) - use prec, only: & - dEq use math, only: & PI @@ -363,7 +361,7 @@ pure function om2eu(om) result(eu) real(pReal), dimension(3) :: eu real(pReal) :: zeta - if (dEq(abs(om(3,3)),1.0_pReal,1.0e-15_pReal)) then + if (abs(om(3,3))>1.0_pReal) then eu = [ atan2( om(1,2),om(1,1)), 0.5*PI*(1-om(3,3)),0.0_pReal ] else zeta = 1.0_pReal/sqrt(1.0_pReal-om(3,3)**2.0_pReal) @@ -774,7 +772,7 @@ pure function qu2ax(qu) result(ax) real(pReal) :: omega, s - omega = 2.0 * acos(math_clip(qu%w,0.0_pReal,1.0_pReal)) + omega = 2.0 * acos(math_clip(qu%w,-1.0_pReal,1.0_pReal)) ! if the angle equals zero, then we return the rotation axis as [001] if (dEq0(omega)) then ax = [ 0.0, 0.0, 1.0, 0.0 ] @@ -798,6 +796,8 @@ pure function qu2ro(qu) result(ro) IEEE_positive_inf use prec, only: & dEq0 + use math, only: & + math_clip type(quaternion), intent(in) :: qu real(pReal), dimension(4) :: ro @@ -810,7 +810,7 @@ pure function qu2ro(qu) result(ro) else s = norm2([qu%x,qu%y,qu%z]) ro = merge ( [ 0.0_pReal, 0.0_pReal, P, 0.0_pReal], & - [ qu%x/s, qu%y/s, qu%z/s, tan(acos(qu%w))], & + [ qu%x/s, qu%y/s, qu%z/s, tan(acos(math_clip(qu%w,-1.0_pReal,1.0_pReal))], & s < thr) !ToDo: not save (PGI compiler) end if @@ -833,7 +833,7 @@ pure function qu2ho(qu) result(ho) real(pReal) :: omega, f - omega = 2.0 * acos(math_clip(qu%w,0.0_pReal,1.0_pReal)) + omega = 2.0 * acos(math_clip(qu%w,-1.0_pReal,1.0_pReal)) if (dEq0(omega)) then ho = [ 0.0, 0.0, 0.0 ] From 40740b831e8819dc7c4845f1aeb446a669685e31 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Feb 2019 00:10:49 +0100 Subject: [PATCH 139/309] reverted code removal was not "just commented out" but served as documentation. now easier to see --- python/damask/orientation.py | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index a1fe1f845..1bc850734 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -574,6 +574,21 @@ class Symmetry: proper considers only vectors with z >= 0, hence uses two neighboring SSTs. Return inverse pole figure color if requested. + Bases are computed from + + basis = {'cubic' : np.linalg.inv(np.array([[0.,0.,1.], # direction of red + [1.,0.,1.]/np.sqrt(2.), # direction of green + [1.,1.,1.]/np.sqrt(3.)]).T), # direction of blue + 'hexagonal' : np.linalg.inv(np.array([[0.,0.,1.], # direction of red + [1.,0.,0.], # direction of green + [np.sqrt(3.),1.,0.]/np.sqrt(4.)]).T), # direction of blue + 'tetragonal' : np.linalg.inv(np.array([[0.,0.,1.], # direction of red + [1.,0.,0.], # direction of green + [1.,1.,0.]/np.sqrt(2.)]).T), # direction of blue + 'orthorhombic' : np.linalg.inv(np.array([[0.,0.,1.], # direction of red + [1.,0.,0.], # direction of green + [0.,1.,0.]]).T), # direction of blue + } """ if self.lattice == 'cubic': basis = {'improper':np.array([ [-1. , 0. , 1. ], From 453f4556e5368df0bef909b8c0f6a55e2b212af6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Feb 2019 00:12:27 +0100 Subject: [PATCH 140/309] bracket was missing --- src/rotations.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/rotations.f90 b/src/rotations.f90 index 3f06d9a38..cf6f66af8 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -810,7 +810,7 @@ pure function qu2ro(qu) result(ro) else s = norm2([qu%x,qu%y,qu%z]) ro = merge ( [ 0.0_pReal, 0.0_pReal, P, 0.0_pReal], & - [ qu%x/s, qu%y/s, qu%z/s, tan(acos(math_clip(qu%w,-1.0_pReal,1.0_pReal))], & + [ qu%x/s, qu%y/s, qu%z/s, tan(acos(math_clip(qu%w,-1.0_pReal,1.0_pReal)))], & s < thr) !ToDo: not save (PGI compiler) end if From 3f61c97dedeefd00fe8d508f7bccf36027dd65f1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Feb 2019 18:49:30 +0100 Subject: [PATCH 141/309] don't support non-DAMASK materials --- src/mesh_marc.f90 | 70 ++++++----------------------------------------- 1 file changed, 9 insertions(+), 61 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index a269b60e4..c793dc7eb 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -253,7 +253,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_marc_count_nodesAndElements, & mesh_marc_count_elementSets, & mesh_marc_map_elementSets, & - mesh_marc_count_cpElements, & mesh_marc_map_Elements, & mesh_marc_map_nodes, & mesh_marc_build_nodes, & @@ -359,7 +358,7 @@ subroutine mesh_init(ip,el) call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - mesh_NcpElems = mesh_marc_count_cpElements(hypoelasticTableStyle,Marc_matNumber,fileFormatVersion,FILEUNIT) + mesh_NcpElems = mesh_nElems if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) @@ -656,60 +655,6 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) 640 end subroutine mesh_marc_map_elementSets -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileFormatVersion,fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues, & - IO_error, & - IO_intValue, & - IO_countNumericalDataLines - - implicit none - integer(pInt), intent(in) :: fileUnit, tableStyle,fileFormatVersion - integer(pInt), dimension(:), intent(in) :: matNumber - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i - character(len=300):: line - - mesh_marc_count_cpElements = 0_pInt - - - rewind(fileUnit) - if (fileFormatVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+tableStyle ! Skip 3 or 4 lines - read (fileUnit,'(A300)') line - enddo - mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countContinuousIntValues(fileUnit) - exit - endif - enddo - else ! Marc2017 and later - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,'(A300)') line - chunkPos = IO_stringPos(line) - if (any(matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countNumericalDataLines(fileUnit) - endif - endif - enddo - end if - -620 end function mesh_marc_count_cpElements - - !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- @@ -880,10 +825,12 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) IO_stringPos, & IO_intValue, & IO_skipChunks + use element implicit none integer(pInt), intent(in) :: fileUnit + type(tElement) :: tempEl integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: i,t,g,e,c @@ -899,13 +846,14 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) do i=1_pInt,mesh_Nelems ! read all elements read (fileUnit,'(A300)') line chunkPos = IO_stringPos(line) ! limit to id and type - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then - if (t == -1_pInt) t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) - if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message + if (t == -1_pInt) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + call tempEl%init(t) mesh_marc_count_cpSizes = t - !call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line !ToDo: this is dangerous in case of a non-CP element, everything is mixed up + else + if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message endif + call IO_skipChunks(fileUnit,tempEl%nNodes-(chunkPos(1_pInt)-2_pInt)) enddo exit endif From 542ab946cc7db07e83d00f5d1097db1f62cd3fd7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Feb 2019 19:05:02 +0100 Subject: [PATCH 142/309] [skip ci] not needed --- src/mesh_marc.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index c793dc7eb..0e0336f99 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -53,8 +53,6 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) - integer(pInt), private :: & - mesh_Nmaterials integer(pInt), dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID From 36662f84192ec8a6131b6d09d6d582c2326d8f98 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 05:38:24 +0100 Subject: [PATCH 143/309] more generic formulation (works for all dimensions) --- src/HDF5_utilities.f90 | 446 ++++++++++++++++++++--------------------- 1 file changed, 223 insertions(+), 223 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 2a05f101c..2a302d6ed 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -459,20 +459,20 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(1) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -482,8 +482,8 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(1) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) @@ -492,8 +492,9 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:0),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -517,7 +518,7 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) !-------------------------------------------------------------------------------------------------- ! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5sselect_hyperslab_f') !-------------------------------------------------------------------------------------------------- @@ -554,20 +555,20 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(2) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -577,18 +578,19 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(2) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal2: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:1),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -649,20 +651,20 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(3) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -672,18 +674,19 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(3) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal3: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:2),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -744,20 +747,20 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(4) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -767,18 +770,19 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(4) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal4: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:3),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -839,20 +843,20 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(5) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -862,18 +866,19 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(5) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal5: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:4),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -934,20 +939,20 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(6) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -957,18 +962,19 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(6) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal6: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:5),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -1029,20 +1035,20 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(7) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties @@ -1052,18 +1058,19 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(7) + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal7: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - myStart = int([0,0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:6),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- @@ -1124,43 +1131,42 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(1) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(1) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt1: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:0),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1221,43 +1227,42 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(2) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(2) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt2: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:1),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1318,43 +1323,42 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(3) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(3) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt3: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:2),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1415,43 +1419,42 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(4) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(4) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt4: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:3),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1512,43 +1515,42 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(5) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(5) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt5: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:4),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1609,43 +1611,42 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(6) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(6) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt6: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:5),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) @@ -1706,43 +1707,42 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - readSize !< contribution of all processes + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), dimension(7) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - allocate(readSize(worldsize), source = 0_pInt) - readSize(worldrank+1) = localShape(7) - + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt7: MPI_allreduce') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') endif; endif #endif - - myStart = int([0,0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:6),sum(readSize)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) From c668260c37bfeb0407c85bff3a47d5e284651d44 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 08:05:29 +0100 Subject: [PATCH 144/309] avoiding code duplication --- src/HDF5_utilities.f90 | 1030 ++++++++++------------------------------ 1 file changed, 259 insertions(+), 771 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 2a302d6ed..39cca9502 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -449,9 +449,6 @@ end subroutine HDF5_setLink !> @brief subroutine for reading dataset of type pReal with 1 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:) :: dataset @@ -459,9 +456,7 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -469,65 +464,28 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f') -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- !close types, dataspaces call h5pclose_f(plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: plist_id') @@ -545,9 +503,6 @@ end subroutine HDF5_read_pReal1 !> @brief subroutine for reading dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:) :: dataset @@ -555,9 +510,7 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -565,59 +518,22 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -641,9 +557,6 @@ end subroutine HDF5_read_pReal2 !> @brief subroutine for reading dataset of type pReal with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:) :: dataset @@ -651,9 +564,7 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -661,59 +572,22 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -737,9 +611,6 @@ end subroutine HDF5_read_pReal3 !> @brief subroutine for reading dataset of type pReal with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:) :: dataset @@ -747,9 +618,7 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -757,59 +626,22 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -833,9 +665,6 @@ end subroutine HDF5_read_pReal4 !> @brief subroutine for reading dataset of type pReal with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset @@ -843,9 +672,7 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -853,59 +680,22 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -929,9 +719,6 @@ end subroutine HDF5_read_pReal5 !> @brief subroutine for reading dataset of type pReal with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset @@ -939,9 +726,7 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -949,59 +734,22 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1025,9 +773,6 @@ end subroutine HDF5_read_pReal6 !> @brief subroutine for reading dataset of type pReal with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset @@ -1035,9 +780,7 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1045,59 +788,22 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1121,9 +827,6 @@ end subroutine HDF5_read_pReal7 !> @brief subroutine for reading dataset of type pInt with 1 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:) :: dataset @@ -1131,9 +834,7 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1141,59 +842,22 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1217,9 +881,6 @@ end subroutine HDF5_read_pInt1 !> @brief subroutine for reading dataset of type pInt with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:) :: dataset @@ -1227,9 +888,7 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1237,59 +896,22 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1313,9 +935,6 @@ end subroutine HDF5_read_pInt2 !> @brief subroutine for reading dataset of type pInt with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:) :: dataset @@ -1323,9 +942,7 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1333,59 +950,22 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1409,9 +989,6 @@ end subroutine HDF5_read_pInt3 !> @brief subroutine for reading dataset of type pInt with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:) :: dataset @@ -1419,9 +996,7 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1429,59 +1004,22 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1505,9 +1043,6 @@ end subroutine HDF5_read_pInt4 !> @brief subroutine for reading dataset of type pInt with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:) :: dataset @@ -1515,9 +1050,7 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1525,59 +1058,22 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1601,9 +1097,6 @@ end subroutine HDF5_read_pInt5 !> @brief subroutine for reading dataset of type pInt with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:,:) :: dataset @@ -1611,9 +1104,7 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1621,59 +1112,22 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -1697,9 +1151,6 @@ end subroutine HDF5_read_pInt6 !> @brief subroutine for reading dataset of type pInt with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset @@ -1707,9 +1158,7 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - integer(pInt), dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & @@ -1717,59 +1166,22 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return ! ToDo: Correct? Seems to result in a deadlock for MPI if my processor has nothing to read + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (present(parallel)) then + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) -!-------------------------------------------------------------------------------------------------- - readSize = 0_pInt - readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') - endif; endif -#endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5pset_all_coll_metadata_ops_f') - -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) @@ -3050,6 +2462,82 @@ subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) end subroutine HDF5_write_pInt7 +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for reading dataset of type pReal with 1 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize + + implicit none + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel + + integer(pInt), dimension(worldsize) :: & + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), intent(in), dimension(:) :: & + localShape + integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & + myStart, & + globalShape !< shape of the dataset (all processes) + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + +!------------------------------------------------------------------------------------------------- +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) +!-------------------------------------------------------------------------------------------------- + readSize = 0_pInt + readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) +#ifdef PETSc + if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') + endif +#endif + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] + + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_all_coll_metadata_ops_f') +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5sselect_hyperslab_f') + + +end subroutine initialize_read + end module HDF5_Utilities From d934f2b141cf97c1935ff8ae2861b74280bdcd2c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 09:01:37 +0100 Subject: [PATCH 145/309] also modularize write --- src/HDF5_utilities.f90 | 531 +++++++++++++---------------------------- 1 file changed, 172 insertions(+), 359 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 39cca9502..d7b56a697 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -1204,9 +1204,6 @@ end subroutine HDF5_read_pInt7 !> @brief subroutine for writing dataset of type pReal with 1 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:) :: dataset @@ -1215,61 +1212,27 @@ subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(1) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(1) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal1: MPI_allreduce') - endif; endif -#endif - - myStart = int([sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:0),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1295,9 +1258,6 @@ end subroutine HDF5_write_pReal1 !> @brief subroutine for writing dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:) :: dataset @@ -1306,61 +1266,27 @@ subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(2) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(2) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal2: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:1),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1386,9 +1312,6 @@ end subroutine HDF5_write_pReal2 !> @brief subroutine for writing dataset of type pReal with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:) :: dataset @@ -1397,61 +1320,27 @@ subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(3) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(3) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal3: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:2),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1477,9 +1366,6 @@ end subroutine HDF5_write_pReal3 !> @brief subroutine for writing dataset of type pReal with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:) :: dataset @@ -1488,61 +1374,27 @@ subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(4) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(4) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal4: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:3),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1568,9 +1420,6 @@ end subroutine HDF5_write_pReal4 !> @brief subroutine for writing dataset of type pReal with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset @@ -1579,61 +1428,27 @@ subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(5) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(5) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal5: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:4),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1659,9 +1474,6 @@ end subroutine HDF5_write_pReal5 !> @brief subroutine for writing dataset of type pReal with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset @@ -1670,61 +1482,27 @@ subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(6) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(6) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal6: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:5),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1750,9 +1528,6 @@ end subroutine HDF5_write_pReal6 !> @brief subroutine for writing dataset of type pReal with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset @@ -1761,61 +1536,27 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(7) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) + localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)) == 0)) return -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(7) - -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal7: MPI_allreduce') - endif; endif -#endif - - myStart = int([0,0,0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:6),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5sselect_hyperslab_f') +if (present(parallel)) then +call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -2513,8 +2254,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) + call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') !-------------------------------------------------------------------------------------------------- ! set I/O mode for read operations to collective @@ -2538,6 +2278,79 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ end subroutine initialize_read + +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for writing dataset of type pReal with 1 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize + + implicit none + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel + + + integer(HSIZE_T), intent(in), dimension(:) :: & + localShape + integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & + myStart, & + globalShape !< shape of the dataset (all processes) + integer(pInt), dimension(worldsize) :: & + outputSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + +!-------------------------------------------------------------------------------------------------- + outputSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) + +#ifdef PETSc +if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal1: MPI_allreduce') + endif +#endif + + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(outputSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(outputSize),HSIZE_T)] + + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! create dataspace in file (global shape) + call h5screate_simple_f(size(globalShape), globalShape, filespace_id, hdferr, globalShape) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! create dataset + call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dcreate_f') +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sselect_hyperslab_f') + + +end subroutine initialize_write + + end module HDF5_Utilities From 73749dd7887f58ae734ec930664ffce5eda322ce Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 09:38:49 +0100 Subject: [PATCH 146/309] merged also finalization --- src/HDF5_utilities.f90 | 1047 +++++++++++++--------------------------- 1 file changed, 342 insertions(+), 705 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index d7b56a697..ee5128e20 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -18,7 +18,7 @@ module HDF5_utilities HDF5_ERR_TYPE = 4_pInt !< kind of the integer return in the HDF5 library !-------------------------------------------------------------------------------------------------- -!> @brief reads pInt or pReal data of defined shape from file +!> @brief reads pInt or pReal data of defined shape from file ! ToDo: order of arguments wrong !-------------------------------------------------------------------------------------------------- interface HDF5_read module procedure HDF5_read_pReal1 @@ -40,7 +40,7 @@ module HDF5_utilities end interface HDF5_read !-------------------------------------------------------------------------------------------------- -!> @brief writes pInt or pReal data of defined shape to file +!> @brief writes pInt or pReal data of defined shape to file ! ToDo: order of arguments wrong !-------------------------------------------------------------------------------------------------- interface HDF5_write module procedure HDF5_write_pReal1 @@ -446,163 +446,138 @@ subroutine HDF5_setLink(loc_id,target_name,link_name) end subroutine HDF5_setLink !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 1 dimensions +!> @brief subroutine for reading dataset of type pReal with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:) :: dataset + real(pReal), intent(inout), dimension(:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f') !--------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/memspace_id') - +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + end subroutine HDF5_read_pReal1 - !-------------------------------------------------------------------------------------------------- !> @brief subroutine for reading dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:) :: dataset + real(pReal), intent(inout), dimension(:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal2 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 3 dimensions +!> @brief subroutine for reading dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal3 @@ -613,50 +588,42 @@ end subroutine HDF5_read_pReal3 subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal4 @@ -667,50 +634,42 @@ end subroutine HDF5_read_pReal4 subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal5 @@ -721,50 +680,42 @@ end subroutine HDF5_read_pReal5 subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal6 @@ -775,105 +726,85 @@ end subroutine HDF5_read_pReal6 subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) implicit none - real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5sclose_f/memspace_id') +!--------------------------------------------------------------------------------------------------- +! finalize HDF5 data structures + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal7 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 1 dimensions +!> @brief subroutine for reading dataset of type pInt with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:) :: dataset + integer(pInt), intent(inout), dimension(:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt1 @@ -883,51 +814,39 @@ end subroutine HDF5_read_pInt1 subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt2 @@ -937,51 +856,39 @@ end subroutine HDF5_read_pInt2 subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt3 @@ -991,51 +898,39 @@ end subroutine HDF5_read_pInt3 subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt4 @@ -1045,51 +940,39 @@ end subroutine HDF5_read_pInt4 subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt5 @@ -1099,51 +982,39 @@ end subroutine HDF5_read_pInt5 subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt6 @@ -1153,51 +1024,39 @@ end subroutine HDF5_read_pInt6 subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) implicit none - integer(pInt), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel - - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HSIZE_T), dimension(size(shape(dataset))) :: & myStart, & localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) + integer(HDF5_ERR_TYPE) :: hdferr !--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) +!--------------------------------------------------------------------------------------------------- +! initialize HDF5 data structures if (present(parallel)) then call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + myStart, globalShape, loc_id,localShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) + myStart, globalShape, loc_id,localShape,datasetName,.false.) endif !--------------------------------------------------------------------------------------------------- ! read - call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5sclose_f/memspace_id') - end subroutine HDF5_read_pInt7 !-------------------------------------------------------------------------------------------------- @@ -1219,20 +1078,20 @@ subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1273,20 +1132,20 @@ subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1327,20 +1186,20 @@ subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1381,20 +1240,20 @@ subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1435,20 +1294,20 @@ subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1489,20 +1348,20 @@ subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1543,20 +1402,20 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) localShape, & !< shape of the dataset (this process) globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset localShape = int(shape(dataset),HSIZE_T) - if (any(localShape(1:size(localShape)) == 0)) return + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -if (present(parallel)) then -call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1584,9 +1443,6 @@ end subroutine HDF5_write_pReal7 !> @brief subroutine for writing dataset of type pInt with 1 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:) :: dataset @@ -1595,59 +1451,27 @@ subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(1) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(1) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt1: MPI_allreduce') - endif; endif -#endif - myStart = int([sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:0),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1673,9 +1497,6 @@ end subroutine HDF5_write_pInt1 !> @brief subroutine for writing dataset of type pInt with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:) :: dataset @@ -1684,59 +1505,27 @@ subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(2) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(2) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt2: MPI_allreduce') - endif; endif -#endif - myStart = int([0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:1),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1762,9 +1551,6 @@ end subroutine HDF5_write_pInt2 !> @brief subroutine for writing dataset of type pInt with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:) :: dataset @@ -1773,59 +1559,27 @@ subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(3) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(3) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt3: MPI_allreduce') - endif; endif -#endif - myStart = int([0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:2),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1851,9 +1605,6 @@ end subroutine HDF5_write_pInt3 !> @brief subroutine for writing dataset of type pInt with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:) :: dataset @@ -1862,59 +1613,27 @@ subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(4) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(4) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt4: MPI_allreduce') - endif; endif -#endif - myStart = int([0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:3),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -1940,9 +1659,6 @@ end subroutine HDF5_write_pInt4 !> @brief subroutine for writing dataset of type pInt with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:) :: dataset @@ -1951,59 +1667,27 @@ subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(5) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(5) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt5: MPI_allreduce') - endif; endif -#endif - myStart = int([0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:4),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -2029,9 +1713,6 @@ end subroutine HDF5_write_pInt5 !> @brief subroutine for writing dataset of type pInt with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:,:) :: dataset @@ -2040,59 +1721,27 @@ subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(6) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(6) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt6: MPI_allreduce') - endif; endif -#endif - myStart = int([0,0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:5),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -2118,9 +1767,6 @@ end subroutine HDF5_write_pInt6 !> @brief subroutine for writing dataset of type pInt with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) - use numerics, only: & - worldrank, & - worldsize implicit none integer(pInt), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset @@ -2129,59 +1775,27 @@ subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: & - globalShape, & !< shape of the dataset (all processes) - localShape, & !< shape of the dataset (this process) - outputSize !< contribution of all processes - integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(7) :: myStart + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + localShape, & !< shape of the dataset (this process) + globalShape !< shape of the dataset (all processes) -!------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------- ! determine shape of dataset - localShape = shape(dataset) - if (any(localShape(1:size(localShape)) == 0)) return + localShape = int(shape(dataset),HSIZE_T) + if (any(localShape(1:size(localShape)-1) == 0)) return !< empty dataset (last dimension can be empty) -!------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - -!-------------------------------------------------------------------------------------------------- - allocate(outputSize(worldsize), source = 0_pInt) - outputSize(worldrank+1) = localShape(7) -#ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt7: MPI_allreduce') - endif; endif -#endif - myStart = int([0,0,0,0,0,0,sum(outputSize(1:worldrank))],HSIZE_T) - globalShape = [localShape(1:6),sum(outputSize)] - - -!-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & - int(localShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) - call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & - int(globalShape,HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5dget_space_f') - -!-------------------------------------------------------------------------------------------------- -! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_INTEGER, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5dcreate_f') -!-------------------------------------------------------------------------------------------------- -! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5sselect_hyperslab_f') + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, globalShape, & + loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif !-------------------------------------------------------------------------------------------------- ! write @@ -2204,7 +1818,7 @@ end subroutine HDF5_write_pInt7 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 1 dimensions +!> @brief !-------------------------------------------------------------------------------------------------- subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & myStart, globalShape, & @@ -2280,11 +1894,33 @@ end subroutine initialize_read !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 1 dimensions +!> @brief +!-------------------------------------------------------------------------------------------------- +subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + + implicit none + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + +!--------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/memspace_id') + +end subroutine finalize_read + +!-------------------------------------------------------------------------------------------------- +!> @brief !-------------------------------------------------------------------------------------------------- subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & myStart, globalShape, & - loc_id,localShape,datasetName,parallel) + loc_id,localShape,datasetName,datatype,parallel) use numerics, only: & worldrank, & worldsize @@ -2302,6 +1938,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & globalShape !< shape of the dataset (all processes) integer(pInt), dimension(worldsize) :: & outputSize !< contribution of all processes +integer(HSIZE_T), intent(in) :: datatype integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id @@ -2340,7 +1977,7 @@ if (parallel) then !-------------------------------------------------------------------------------------------------- ! create dataset - call h5dcreate_f(loc_id, trim(datasetName), H5T_NATIVE_DOUBLE, filespace_id, dset_id, hdferr) + call h5dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dcreate_f') !-------------------------------------------------------------------------------------------------- ! select a hyperslab (the portion of the current process) in the file From 5d9c3fcf273d69042ac3cd1ec48cd6214d9ca2d7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 09:44:41 +0100 Subject: [PATCH 147/309] finalize for write --- src/HDF5_utilities.f90 | 47 ++++++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 20 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index ee5128e20..2b902c1c8 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -19,6 +19,7 @@ module HDF5_utilities !-------------------------------------------------------------------------------------------------- !> @brief reads pInt or pReal data of defined shape from file ! ToDo: order of arguments wrong +!> @details for parallel IO, all dimension except for the last need to match !-------------------------------------------------------------------------------------------------- interface HDF5_read module procedure HDF5_read_pReal1 @@ -41,6 +42,7 @@ module HDF5_utilities !-------------------------------------------------------------------------------------------------- !> @brief writes pInt or pReal data of defined shape to file ! ToDo: order of arguments wrong +!> @details for parallel IO, all dimension except for the last need to match !-------------------------------------------------------------------------------------------------- interface HDF5_write module procedure HDF5_write_pReal1 @@ -1059,8 +1061,9 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) end subroutine HDF5_read_pInt7 + !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 1 dimensions +!> @brief subroutine for writing dataset of type pReal with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) @@ -1436,11 +1439,8 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) end subroutine HDF5_write_pReal7 - - - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 1 dimensions +!> @brief subroutine for writing dataset of type pInt with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) @@ -1988,19 +1988,26 @@ if (parallel) then end subroutine initialize_write +!-------------------------------------------------------------------------------------------------- +!> @brief +!-------------------------------------------------------------------------------------------------- +subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id) + + implicit none + integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id + integer(HDF5_ERR_TYPE) :: hdferr + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5sclose_f/memspace_id') + +end subroutine finalize_write + end module HDF5_Utilities - - - - - - - - - - - - - - - From 8167f09ec6f82d699b39b37ffdbb4d387a9ac25f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 11:45:02 +0100 Subject: [PATCH 148/309] using functions as far as possible --- src/HDF5_utilities.f90 | 496 +++++++++++------------------------------ 1 file changed, 128 insertions(+), 368 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 2b902c1c8..da6bd4979 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -447,8 +447,9 @@ subroutine HDF5_setLink(loc_id,target_name,link_name) end subroutine HDF5_setLink + !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 1 dimension +!> @brief read dataset of type pReal with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) @@ -480,20 +481,16 @@ subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal1 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 2 dimensions +!> @brief read dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) @@ -525,21 +522,16 @@ subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal2 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 2 dimensions +!> @brief read dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) @@ -570,22 +562,17 @@ subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & myStart, globalShape, loc_id,localShape,datasetName,.false.) endif - -!--------------------------------------------------------------------------------------------------- -! read + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal3 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 4 dimensions +!> @brief read dataset of type pReal with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) @@ -617,21 +604,16 @@ subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal4 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 5 dimensions +!> @brief read dataset of type pReal with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) @@ -663,21 +645,16 @@ subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal5 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 6 dimensions +!> @brief read dataset of type pReal with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) @@ -709,21 +686,16 @@ subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal6 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pReal with 7 dimensions +!> @brief read dataset of type pReal with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) @@ -755,21 +727,17 @@ subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dread_f') -!--------------------------------------------------------------------------------------------------- -! finalize HDF5 data structures - call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pReal7 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 1 dimension +!> @brief read dataset of type pInt with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) @@ -801,17 +769,16 @@ subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dread_f') + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) + end subroutine HDF5_read_pInt1 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 2 dimensions +!> @brief read dataset of type pInt with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) @@ -843,17 +810,16 @@ subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt2 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 3 dimensions +!> @brief read dataset of type pInt with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) @@ -885,17 +851,16 @@ subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt3 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 4 dimensions +!> @brief read dataset of type pInt withh 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) @@ -927,17 +892,16 @@ subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt4 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 5 dimensions +!> @brief read dataset of type pInt with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) @@ -969,17 +933,16 @@ subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt5 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 6 dimensions +!> @brief read dataset of type pInt with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) @@ -1011,17 +974,16 @@ subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt6 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of type pInt with 7 dimensions +!> @brief read dataset of type pInt with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) @@ -1053,17 +1015,17 @@ subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) myStart, globalShape, loc_id,localShape,datasetName,.false.) endif -!--------------------------------------------------------------------------------------------------- -! read call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,globalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dread_f') + + call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) end subroutine HDF5_read_pInt7 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 1 dimension +!> @brief write dataset of type pReal with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) @@ -1088,36 +1050,22 @@ subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape,loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape,loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal1 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 2 dimensions +!> @brief write dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) @@ -1142,36 +1090,22 @@ subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal2 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 3 dimensions +!> @brief write dataset of type pReal with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) @@ -1196,36 +1130,22 @@ subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal3 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 4 dimensions +!> @brief write dataset of type pReal with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) @@ -1250,36 +1170,23 @@ subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal4 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 5 dimensions +!> @brief write dataset of type pReal with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) @@ -1304,36 +1211,22 @@ subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal5 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 6 dimensions +!> @brief write dataset of type pReal with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) @@ -1358,36 +1251,22 @@ subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal6 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pReal with 7 dimensions +!> @brief write dataset of type pReal with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) @@ -1412,35 +1291,23 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pReal7 + !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 1 dimension +!> @brief write dataset of type pInt with 1 dimension !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) @@ -1465,36 +1332,22 @@ subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt1: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt1 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 2 dimensions +!> @brief write dataset of type pInt with 2 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) @@ -1519,36 +1372,22 @@ subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt2: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt2 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 3 dimensions +!> @brief write dataset of type pInt with 3 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) @@ -1573,36 +1412,22 @@ subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt3: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt3 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 4 dimensions +!> @brief write dataset of type pInt with 4 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) @@ -1627,36 +1452,22 @@ subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt4: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt4 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 5 dimensions +!> @brief write dataset of type pInt with 5 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) @@ -1681,36 +1492,22 @@ subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt5: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt5 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 6 dimensions +!> @brief write dataset of type pInt with 6 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) @@ -1735,36 +1532,22 @@ subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt6: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt6 - !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of type pInt with 7 dimensions +!> @brief write dataset of type pInt with 7 dimensions !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) @@ -1789,36 +1572,23 @@ subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, & - loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) endif -!-------------------------------------------------------------------------------------------------- -! write call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5dread_f') -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pInt7: h5sclose_f/memspace_id') + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_pInt7 !-------------------------------------------------------------------------------------------------- -!> @brief +!> @brief initialize HDF5 handles, determines global shape and start for parallel read !-------------------------------------------------------------------------------------------------- subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & myStart, globalShape, & @@ -1844,57 +1614,53 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ globalShape !< shape of the dataset (all processes) !------------------------------------------------------------------------------------------------- -! creating a property list for transfer properties +! creating a property list for transfer properties (is collective for MPI) call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) -!------------------------------------------------------------------------------------------------- -! creating a property list for data access properties - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- readSize = 0_pInt readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='initialize_read: MPI_allreduce') endif #endif myStart = int(0,HSIZE_T) myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] - !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') -!-------------------------------------------------------------------------------------------------- -! set I/O mode for read operations to collective - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_all_coll_metadata_ops_f') -!-------------------------------------------------------------------------------------------------- -! open the dataset in the file - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dopen_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5screate_simple_f/memspace_id') !-------------------------------------------------------------------------------------------------- -! get the space_id of dataset in the file +! creating a property list for IO and set it to collective + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f') + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f') + +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file and get the space ID + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5dopen_f') call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dget_space_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5dget_space_f') !-------------------------------------------------------------------------------------------------- ! select a hyperslab (the portion of the current process) in the file call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5sselect_hyperslab_f') - + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5sselect_hyperslab_f') end subroutine initialize_read !-------------------------------------------------------------------------------------------------- -!> @brief +!> @brief closes HDF5 handles !-------------------------------------------------------------------------------------------------- subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -1902,21 +1668,20 @@ subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id -!--------------------------------------------------------------------------------------------------- -!close types, dataspaces call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: plist_id') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: plist_id') call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dclose_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5dclose_f') call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/filespace_id') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5sclose_f/filespace_id') call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/memspace_id') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5sclose_f/memspace_id') end subroutine finalize_read + !-------------------------------------------------------------------------------------------------- -!> @brief +!> @brief initialize HDF5 handles, determines global shape and start for parallel write !-------------------------------------------------------------------------------------------------- subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & myStart, globalShape, & @@ -1938,7 +1703,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & globalShape !< shape of the dataset (all processes) integer(pInt), dimension(worldsize) :: & outputSize !< contribution of all processes -integer(HSIZE_T), intent(in) :: datatype + integer(HID_T), intent(in) :: datatype integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id @@ -1954,9 +1719,9 @@ integer(HSIZE_T), intent(in) :: datatype #ifdef PETSc if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5pset_dxpl_mpio_f') call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal1: MPI_allreduce') + if (ierr /= 0) call IO_error(894_pInt,ext_msg='initialize_write: MPI_allreduce') endif #endif @@ -1966,30 +1731,27 @@ if (parallel) then !-------------------------------------------------------------------------------------------------- -! create dataspace in memory (local shape) +! create dataspace in memory (local shape) and in file (global shape) call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dopen_f') - -!-------------------------------------------------------------------------------------------------- -! create dataspace in file (global shape) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dopen_f') call h5screate_simple_f(size(globalShape), globalShape, filespace_id, hdferr, globalShape) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dget_space_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dget_space_f') !-------------------------------------------------------------------------------------------------- ! create dataset call h5dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dcreate_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dcreate_f') + !-------------------------------------------------------------------------------------------------- ! select a hyperslab (the portion of the current process) in the file call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sselect_hyperslab_f') - + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5sselect_hyperslab_f') end subroutine initialize_write !-------------------------------------------------------------------------------------------------- -!> @brief +!> @brief closes HDF5 handles !-------------------------------------------------------------------------------------------------- subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1997,8 +1759,6 @@ subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id) integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id integer(HDF5_ERR_TYPE) :: hdferr -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces call h5pclose_f(plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: plist_id') call h5dclose_f(dset_id, hdferr) From de26e41684a49669ec68eb4ac16ed923b656450b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 15:02:07 +0000 Subject: [PATCH 149/309] some first steps to support debugging with the PGI compiler norm2 and sum for initialization are not supported yet, need fixes --- CMakeLists.txt | 27 +++++++++++++++++++++++++++ src/compilation_info.f90 | 6 +++++- src/math.f90 | 18 ++++++++++++++++++ 3 files changed, 50 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 3aa49cd7a..6096c8824 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -445,6 +445,33 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") # Additional options # -fdefault-integer-8: Use it to set precision to 8 bytes for integer, don't use it for the standard case of pInt=4 (there is no -fdefault-integer-4) + + +################################################################################################### +# PGI Compiler +################################################################################################### +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "PGI") + + if (OPTIMIZATION STREQUAL "OFF") + set (OPTIMIZATION_FLAGS "-O0" ) + elseif (OPTIMIZATION STREQUAL "DEFENSIVE") + set (OPTIMIZATION_FLAGS "-O2") + elseif (OPTIMIZATION STREQUAL "AGGRESSIVE") + set (OPTIMIZATION_FLAGS "-O3") + endif () + + +#------------------------------------------------------------------------------------------------ +# Fine tuning compilation options + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Mpreprocess") + # preprocessor + + set (STANDARD_CHECK "-Mallocatable=03") + +#------------------------------------------------------------------------------------------------ +# Runtime debugging + set (DEBUG_FLAGS "${DEBUG_FLAGS} -g") + # Includes debugging information in the object module; sets the optimization level to zero unless a -⁠O option is present on the command line else () message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized") endif () diff --git a/src/compilation_info.f90 b/src/compilation_info.f90 index f0ca4d4cc..77d181a38 100644 --- a/src/compilation_info.f90 +++ b/src/compilation_info.f90 @@ -1,9 +1,13 @@ +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 write(6,*) 'Compiled with ', compiler_version() write(6,*) 'With options ', compiler_options() -#else +#elif defined(__INTEL_COMPILER) write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,& ', build date ', __INTEL_COMPILER_BUILD_DATE +#elif defined(__PGI) + write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version ', __PGIC__,& + '.', __PGIC_MINOR__ #endif write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ write(6,*) diff --git a/src/math.f90 b/src/math.f90 index 28c7175e3..4d7736b31 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -118,6 +118,9 @@ module math !--------------------------------------------------------------------------------------------------- public :: & +#if defined(__PGI) + norm2, & +#endif math_init, & math_qsort, & math_expand, & @@ -2707,4 +2710,19 @@ real(pReal) pure elemental function math_clip(a, left, right) end function math_clip + +#if defined(__PGI) +!-------------------------------------------------------------------------------------------------- +!> @brief substitute for the norm2 intrinsic which is not available when using PGI 18.10 +!-------------------------------------------------------------------------------------------------- +real(pReal) pure function norm2(v) + + implicit none + real(pReal), intent(in), dimension(3) :: v + + norm2 = sqrt(sum(a**2)) + +end function norm2 +#endif + end module math From 09859f1b12157b3580ef9014dfae8599d3e92089 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 16:53:05 +0100 Subject: [PATCH 150/309] wrong variable rename (was forgotten) --- src/math.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/math.f90 b/src/math.f90 index 4d7736b31..644063d66 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -2720,7 +2720,7 @@ real(pReal) pure function norm2(v) implicit none real(pReal), intent(in), dimension(3) :: v - norm2 = sqrt(sum(a**2)) + norm2 = sqrt(sum(v**2)) end function norm2 #endif From c4eef520fcb7dd796fa092b72298e7a944be2ace Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 17:21:11 +0100 Subject: [PATCH 151/309] initialize all variables --- src/HDF5_utilities.f90 | 60 +++++++++++++++++++++--------------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index da6bd4979..0582318ce 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -1291,10 +1291,10 @@ subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) if (present(parallel)) then call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,parallel) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, globalShape, loc_id,localShape,datasetName,H5T_NATIVE_DOUBLE,.false.) endif call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& @@ -1598,24 +1598,25 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ worldsize implicit none - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel - + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in) :: parallel + integer(HSIZE_T), intent(in), dimension(:) :: & + localShape + integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & + myStart, & + globalShape !< shape of the dataset (all processes) + integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(pInt), dimension(worldsize) :: & readSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr - integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(HSIZE_T), intent(in), dimension(:) :: & - localShape - integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & - myStart, & - globalShape !< shape of the dataset (all processes) - + !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties (is collective for MPI) call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f') !-------------------------------------------------------------------------------------------------- readSize = 0_pInt @@ -1665,8 +1666,8 @@ end subroutine initialize_read subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) implicit none - integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HDF5_ERR_TYPE) :: hdferr call h5pclose_f(plist_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: plist_id') @@ -1691,44 +1692,43 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & worldsize implicit none - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel - - - integer(HSIZE_T), intent(in), dimension(:) :: & + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in) :: parallel + integer(HID_T), intent(in) :: datatype + integer(HSIZE_T), intent(in), dimension(:) :: & localShape - integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & + integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & myStart, & globalShape !< shape of the dataset (all processes) + integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id + integer(pInt), dimension(worldsize) :: & - outputSize !< contribution of all processes - integer(HID_T), intent(in) :: datatype + writeSize !< contribution of all processes integer :: ierr integer(HDF5_ERR_TYPE) :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5pcreate_f') !-------------------------------------------------------------------------------------------------- - outputSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) + writeSize = 0_pInt + writeSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) #ifdef PETSc if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process if (ierr /= 0) call IO_error(894_pInt,ext_msg='initialize_write: MPI_allreduce') endif #endif myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(outputSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(outputSize),HSIZE_T)] - + myStart(ubound(myStart)) = int(sum(writeSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(writeSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) and in file (global shape) From af28e9cdd9ed2e959cb43e3d1df2163ba9a65f28 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Feb 2019 17:23:56 +0100 Subject: [PATCH 152/309] not needed anymore --- src/FEM_utilities.f90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 1db950e63..fd6e90206 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -162,7 +162,6 @@ subroutine utilities_init() character(len=1024) :: petsc_optionsPhysics integer(pInt) :: dimPlex - integer(pInt) :: headerID = 205_pInt PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:) PetscInt :: dim PetscErrorCode :: ierr @@ -213,13 +212,6 @@ subroutine utilities_init() nOutputCells(worldrank+1) = count(material_homog > 0_pInt) call MPI_Allreduce(MPI_IN_PLACE,nOutputNodes,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) call MPI_Allreduce(MPI_IN_PLACE,nOutputCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) - if (worldrank == 0_pInt) then - open(unit=headerID, file=trim(getSolverJobName())//'.header', & - form='FORMATTED', status='REPLACE') - write(headerID, '(a,i0)') 'dimension : ', dimPlex - write(headerID, '(a,i0)') 'number of nodes : ', sum(nOutputNodes) - write(headerID, '(a,i0)') 'number of cells : ', sum(nOutputCells) - endif end subroutine utilities_init From 87f3e3f62114bd083f20d92de688f363a6071794 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Feb 2019 10:08:34 +0100 Subject: [PATCH 153/309] more flexible and user friendly --- src/math.f90 | 79 +++++++++++++++++++++++++++++++--------------------- 1 file changed, 47 insertions(+), 32 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 644063d66..e663103c8 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -119,7 +119,7 @@ module math public :: & #if defined(__PGI) - norm2, & + norm2, & #endif math_init, & math_qsort, & @@ -354,20 +354,38 @@ end subroutine math_check !-------------------------------------------------------------------------------------------------- !> @brief Quicksort algorithm for two-dimensional integer arrays -! Sorting is done with respect to array(1,:) -! and keeps array(2:N,:) linked to it. +! Sorting is done with respect to array(sort,:) and keeps array(/=sort,:) linked to it. +! default: sort=1 !-------------------------------------------------------------------------------------------------- -recursive subroutine math_qsort(a, istart, iend) +recursive subroutine math_qsort(a, istart, iend, sortDim) implicit none integer(pInt), dimension(:,:), intent(inout) :: a - integer(pInt), intent(in) :: istart,iend - integer(pInt) :: ipivot - - if (istart < iend) then - ipivot = qsort_partition(a,istart, iend) - call math_qsort(a, istart, ipivot-1_pInt) - call math_qsort(a, ipivot+1_pInt, iend) + integer(pInt), intent(in),optional :: istart,iend, sortDim + integer(pInt) :: ipivot,s,e,d + + if(present(istart)) then + s = istart + else + s = lbound(a,2) + endif + + if(present(iend)) then + e = iend + else + e = ubound(a,2) + endif + + if(present(sortDim)) then + d = sortDim + else + d = 1 + endif + + if (s < e) then + ipivot = qsort_partition(a,s, e, d) + call math_qsort(a, s, ipivot-1_pInt, d) + call math_qsort(a, ipivot+1_pInt, e, d) endif !-------------------------------------------------------------------------------------------------- @@ -376,37 +394,34 @@ recursive subroutine math_qsort(a, istart, iend) !------------------------------------------------------------------------------------------------- !> @brief Partitioning required for quicksort !------------------------------------------------------------------------------------------------- - integer(pInt) function qsort_partition(a, istart, iend) + integer(pInt) function qsort_partition(a, istart, iend, sort) implicit none integer(pInt), dimension(:,:), intent(inout) :: a - integer(pInt), intent(in) :: istart,iend - integer(pInt) :: i,j,k,tmp + integer(pInt), intent(in) :: istart,iend,sort + integer(pInt), dimension(size(a,1)) :: tmp + integer(pInt) :: i,j do - ! find the first element on the right side less than or equal to the pivot point + ! find the first element on the right side less than or equal to the pivot point do j = iend, istart, -1_pInt - if (a(1,j) <= a(1,istart)) exit + if (a(sort,j) <= a(sort,istart)) exit enddo - ! find the first element on the left side greater than the pivot point + ! find the first element on the left side greater than the pivot point do i = istart, iend - if (a(1,i) > a(1,istart)) exit + if (a(sort,i) > a(sort,istart)) exit enddo - if (i < j) then ! if the indexes do not cross, exchange values - do k = 1_pInt, int(size(a,1_pInt), pInt) - tmp = a(k,i) - a(k,i) = a(k,j) - a(k,j) = tmp - enddo - else ! if they do cross, exchange left value with pivot and return with the partition index - do k = 1_pInt, int(size(a,1_pInt), pInt) - tmp = a(k,istart) - a(k,istart) = a(k,j) - a(k,j) = tmp - enddo + cross: if (i >= j) then ! if the indices cross, exchange left value with pivot and return with the partition index + tmp = a(:,istart) + a(:,istart) = a(:,j) + a(:,j) = tmp qsort_partition = j return - endif + else cross ! if they do not cross, exchange values + tmp = a(:,i) + a(:,i) = a(:,j) + a(:,j) = tmp + endif cross enddo end function qsort_partition @@ -2713,7 +2728,7 @@ end function math_clip #if defined(__PGI) !-------------------------------------------------------------------------------------------------- -!> @brief substitute for the norm2 intrinsic which is not available when using PGI 18.10 +!> @brief substitute for the norm2 intrinsic which is not available in PGI 18.10 !-------------------------------------------------------------------------------------------------- real(pReal) pure function norm2(v) From b0c20beefa3c899e810aa22f3f14db8efa28cde2 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 11 Feb 2019 15:11:31 +0100 Subject: [PATCH 154/309] [skip ci] updated version information after successful test of v2.0.2-1687-gfa1c946d --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 543d23432..f8fbcdee0 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1674-g683dee82 +v2.0.2-1687-gfa1c946d From 1a471bcd8a3f2d50e13d9e403442bc8923cb06f4 Mon Sep 17 00:00:00 2001 From: Arko Jyoti Bhattacharjee Date: Mon, 11 Feb 2019 18:46:14 +0100 Subject: [PATCH 155/309] signal handling implemented allows to trigger action in running simulation, i.e. writing restart or results --- src/C_routines.c | 10 +++ src/DAMASK_interface.f90 | 44 +++++++++++- src/system_routines.f90 | 148 +++++++++++++++++++-------------------- 3 files changed, 125 insertions(+), 77 deletions(-) diff --git a/src/C_routines.c b/src/C_routines.c index e3891765a..3dccb7644 100644 --- a/src/C_routines.c +++ b/src/C_routines.c @@ -6,9 +6,11 @@ #include #include #include +#include /* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */ + int isdirectory_c(const char *dir){ struct stat statbuf; if(stat(dir, &statbuf) != 0) /* error */ @@ -44,3 +46,11 @@ void gethostname_c(char hostname[], int *stat){ int chdir_c(const char *dir){ return chdir(dir); } + +void signalusr1_c(void (*handler)(int)){ + signal(SIGUSR1, handler); +} + +void signalusr2_c(void (*handler)(int)){ + signal(SIGUSR2, handler); +} \ No newline at end of file diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index a2b4f53f2..7a8e77f62 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -12,9 +12,9 @@ module DAMASK_interface use prec, only: & pInt - implicit none private + logical, public, protected :: SIGUSR1,SIGUSR2 integer(pInt), public, protected :: & interface_restartInc = 0_pInt !< Increment at which calculation starts character(len=1024), public, protected :: & @@ -42,6 +42,8 @@ contains subroutine DAMASK_interface_init() use, intrinsic :: & iso_fortran_env + use :: & + iso_c_binding #include #if defined(__GFORTRAN__) && __GNUC__ < 5 =================================================================================================== @@ -81,6 +83,8 @@ subroutine DAMASK_interface_init() use PETScSys use system_routines, only: & + signalusr1_C, & + signalusr2_C, & getHostName, & getCWD @@ -229,6 +233,12 @@ subroutine DAMASK_interface_init() if (interface_restartInc > 0_pInt) & write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc + call signalusr1_c(c_funloc(setSIGUSR1)) + call signalusr2_c(c_funloc(setSIGUSR2)) + SIGUSR1 = .false. + SIGUSR2 = .false. + + end subroutine DAMASK_interface_init @@ -412,6 +422,35 @@ character(len=1024) function makeRelativePath(a,b) end function makeRelativePath +!-------------------------------------------------------------------------------------------------- +!> @brief sets global variable SIGUSR1 to .true. if program receives SIGUSR1 +!-------------------------------------------------------------------------------------------------- +subroutine setSIGUSR1(signal) bind(C) + use :: iso_c_binding + + implicit none + integer(C_INT), value :: signal + SIGUSR1 = .true. + + write(6,*) 'received signal ',signal, 'set SIGUSR1' + +end subroutine setSIGUSR1 + + +!-------------------------------------------------------------------------------------------------- +!> @brief sets global variable SIGUSR2 to .true. if program receives SIGUSR2 +!-------------------------------------------------------------------------------------------------- +subroutine setSIGUSR2(signal) bind(C) + use :: iso_c_binding + + implicit none + integer(C_INT), value :: signal + SIGUSR2 = .true. + + write(6,*) 'received signal ',signal, 'set SIGUSR2' + +end subroutine setSIGUSR2 + !-------------------------------------------------------------------------------------------------- !> @brief taken from IO, check IO_stringValue for documentation @@ -469,11 +508,10 @@ pure function IIO_stringPos(string) do while (verify(string(right+1:),SEP)>0) left = right + verify(string(right+1:),SEP) right = left + scan(string(left:),SEP) - 2 - if ( string(left:left) == '#' ) exit IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)] IIO_stringPos(1) = IIO_stringPos(1)+1_pInt enddo end function IIO_stringPos -end module +end module \ No newline at end of file diff --git a/src/system_routines.f90 b/src/system_routines.f90 index bea777a3d..27f0cae34 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -3,11 +3,17 @@ !> @brief provides wrappers to C routines !-------------------------------------------------------------------------------------------------- module system_routines - + use, intrinsic :: ISO_C_Binding, only: & + C_INT, & + C_CHAR, & + C_NULL_CHAR + implicit none private public :: & + signalusr1_C, & + signalusr2_C, & isDirectory, & getCWD, & getHostName, & @@ -27,7 +33,7 @@ interface use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR - character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array + character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array integer(C_INT),intent(out) :: stat end subroutine getCurrentWorkDir_C @@ -35,7 +41,7 @@ interface use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR - character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array + character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array integer(C_INT),intent(out) :: stat end subroutine getHostName_C @@ -46,31 +52,38 @@ interface integer(C_INT) :: chdir_C character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array end function chdir_C + + subroutine signalusr1_C(handler) bind(C) + use, intrinsic :: ISO_C_Binding, only: & + C_FUNPTR + type(C_FUNPTR), intent(in), value :: handler + end subroutine signalusr1_C + + subroutine signalusr2_C(handler) bind(C) + use, intrinsic :: ISO_C_Binding, only: & + C_FUNPTR + type(C_FUNPTR), intent(in), value :: handler + end subroutine signalusr2_C end interface - contains !-------------------------------------------------------------------------------------------------- !> @brief figures out if a given path is a directory (and not an ordinary file) !-------------------------------------------------------------------------------------------------- logical function isDirectory(path) - use, intrinsic :: ISO_C_Binding, only: & - C_INT, & - C_CHAR, & - C_NULL_CHAR - implicit none - character(len=*), intent(in) :: path - character(kind=C_CHAR), dimension(1024) :: strFixedLength - integer :: i + implicit none + character(len=*), intent(in) :: path + character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string as array + integer :: i - strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) - do i=1,len(path) ! copy array components - strFixedLength(i)=path(i:i) - enddo - isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT) + strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) + do i=1,len(path) ! copy array components + strFixedLength(i)=path(i:i) + enddo + isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT) end function isDirectory @@ -79,29 +92,25 @@ end function isDirectory !> @brief gets the current working directory !-------------------------------------------------------------------------------------------------- character(len=1024) function getCWD() - use, intrinsic :: ISO_C_Binding, only: & - C_INT, & - C_CHAR, & - C_NULL_CHAR - implicit none - character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array - integer(C_INT) :: stat - integer :: i + implicit none + character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array + integer(C_INT) :: stat + integer :: i - call getCurrentWorkDir_C(charArray,stat) - if (stat /= 0_C_INT) then - getCWD = 'Error occured when getting currend working directory' - else - getCWD = repeat('',len(getCWD)) - arrayToString: do i=1,len(getCWD) - if (charArray(i) /= C_NULL_CHAR) then - getCWD(i:i)=charArray(i) - else - exit - endif - enddo arrayToString - endif + call getCurrentWorkDir_C(charArray,stat) + if (stat /= 0_C_INT) then + getCWD = 'Error occured when getting currend working directory' + else + getCWD = repeat('',len(getCWD)) + arrayToString: do i=1,len(getCWD) + if (charArray(i) /= C_NULL_CHAR) then + getCWD(i:i)=charArray(i) + else + exit + endif + enddo arrayToString + endif end function getCWD @@ -110,51 +119,42 @@ end function getCWD !> @brief gets the current host name !-------------------------------------------------------------------------------------------------- character(len=1024) function getHostName() - use, intrinsic :: ISO_C_Binding, only: & - C_INT, & - C_CHAR, & - C_NULL_CHAR + implicit none + character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array + integer(C_INT) :: stat + integer :: i - implicit none - character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array - integer(C_INT) :: stat - integer :: i - - call getHostName_C(charArray,stat) - if (stat /= 0_C_INT) then - getHostName = 'Error occured when getting host name' - else - getHostName = repeat('',len(getHostName)) - arrayToString: do i=1,len(getHostName) - if (charArray(i) /= C_NULL_CHAR) then - getHostName(i:i)=charArray(i) - else - exit - endif - enddo arrayToString - endif + call getHostName_C(charArray,stat) + if (stat /= 0_C_INT) then + getHostName = 'Error occured when getting host name' + else + getHostName = repeat('',len(getHostName)) + arrayToString: do i=1,len(getHostName) + if (charArray(i) /= C_NULL_CHAR) then + getHostName(i:i)=charArray(i) + else + exit + endif + enddo arrayToString + endif end function getHostName + !-------------------------------------------------------------------------------------------------- !> @brief changes the current working directory !-------------------------------------------------------------------------------------------------- logical function setCWD(path) - use, intrinsic :: ISO_C_Binding, only: & - C_INT, & - C_CHAR, & - C_NULL_CHAR + implicit none + character(len=*), intent(in) :: path + character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array + integer :: i - implicit none - character(len=*), intent(in) :: path - character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array - integer :: i - - strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) - do i=1,len(path) ! copy array components - strFixedLength(i)=path(i:i) - enddo - setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT) + strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength)) + do i=1,len(path) ! copy array components + strFixedLength(i)=path(i:i) + enddo + setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT) end function setCWD From e931b716fd6347f64161d50704c0c4a8184b8720 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Feb 2019 23:11:11 +0100 Subject: [PATCH 156/309] conversion routines from Marc de Graefs 3D rotation repository Python version available on https://github.com/MarDiehl/3Drotations --- python/damask/Lambert.py | 122 ++++++++++ python/damask/orientation.py | 443 +++++++++++++++++++++++++++++++++++ 2 files changed, 565 insertions(+) create mode 100644 python/damask/Lambert.py diff --git a/python/damask/Lambert.py b/python/damask/Lambert.py new file mode 100644 index 000000000..9972b7965 --- /dev/null +++ b/python/damask/Lambert.py @@ -0,0 +1,122 @@ +#################################################################################################### +# Code below available according to below conditions on https://github.com/MarDiehl/3Drotations +#################################################################################################### +# Copyright (c) 2017-2019, Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +# Copyright (c) 2013-2014, Marc De Graef/Carnegie Mellon University +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without modification, are +# permitted provided that the following conditions are met: +# +# - Redistributions of source code must retain the above copyright notice, this list +# of conditions and the following disclaimer. +# - Redistributions in binary form must reproduce the above copyright notice, this +# list of conditions and the following disclaimer in the documentation and/or +# other materials provided with the distribution. +# - Neither the names of Marc De Graef, Carnegie Mellon University nor the names +# of its contributors may be used to endorse or promote products derived from +# this software without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +# USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +#################################################################################################### +import numpy as np + +sc = np.pi**(1./6.)/6.**(1./6.) +beta = np.pi**(5./6.)/6.**(1./6.)/2. +R1 = (3.*np.pi/4.)**(1./3.) + +def CubeToBall(cube): + + if np.abs(np.max(cube))>np.pi**(2./3.) * 0.5: + raise ValueError + + # transform to the sphere grid via the curved square, and intercept the zero point + if np.allclose(cube,0.0,rtol=0.0,atol=1.0e-300): + ball = np.zeros(3) + else: + # get pyramide and scale by grid parameter ratio + p = GetPyramidOrder(cube) + XYZ = cube[p] * sc + + # intercept all the points along the z-axis + if np.allclose(XYZ[0:2],0.0,rtol=0.0,atol=1.0e-300): + ball = np.array([0.0, 0.0, np.sqrt(6.0/np.pi) * XYZ[2]]) + else: + order = [1,0] if np.abs(XYZ[1]) <= np.abs(XYZ[0]) else [0,1] + q = np.pi/12.0 * XYZ[order[0]]/XYZ[order[1]] + c = np.cos(q) + s = np.sin(q) + q = R1*2.0**0.25/beta * XYZ[order[1]] / np.sqrt(np.sqrt(2.0)-c) + T = np.array([ (np.sqrt(2.0)*c - 1.0), np.sqrt(2.0) * s]) * q + + # transform to sphere grid (inverse Lambert) + # note that there is no need to worry about dividing by zero, since XYZ[2] can not become zero + c = np.sum(T**2) + s = c * np.pi/24.0 /XYZ[2]**2 + c = c * np.sqrt(np.pi/24.0)/XYZ[2] + q = np.sqrt( 1.0 - s ) + ball = np.array([ T[order[1]] * q, T[order[0]] * q, np.sqrt(6.0/np.pi) * XYZ[2] - c ]) + + # reverse the coordinates back to the regular order according to the original pyramid number + ball = ball[p] + + return ball + + +def BallToCube(ball): + + rs = np.linalg.norm(ball) + if rs > R1: + raise ValueError + + if np.allclose(ball,0.0,rtol=0.0,atol=1.0e-300): + cube = np.zeros(3) + else: + p = GetPyramidOrder(ball) + xyz3 = ball[p] + + # inverse M_3 + xyz2 = xyz3[0:2] * np.sqrt( 2.0*rs/(rs+np.abs(xyz3[2])) ) + + # inverse M_2 + qxy = np.sum(xyz2**2) + + if np.isclose(qxy,0.0,rtol=0.0,atol=1.0e-300): + Tinv = np.zeros(2) + else: + q2 = qxy + np.max(np.abs(xyz2))**2 + sq2 = np.sqrt(q2) + q = (beta/np.sqrt(2.0)/R1) * np.sqrt(q2*qxy/(q2-np.max(np.abs(xyz2))*sq2)) + tt = np.clip((np.min(np.abs(xyz2))**2+np.max(np.abs(xyz2))*sq2)/np.sqrt(2.0)/qxy,-1.0,1.0) + Tinv = np.array([1.0,np.arccos(tt)/np.pi*12.0]) if np.abs(xyz2[1]) <= np.abs(xyz2[0]) else \ + np.array([np.arccos(tt)/np.pi*12.0,1.0]) + Tinv = q * np.where(xyz2<0.0,-Tinv,Tinv) + + # inverse M_1 + cube = np.array([ Tinv[0], Tinv[1], (-1.0 if xyz3[2] < 0.0 else 1.0) * rs / np.sqrt(6.0/np.pi) ]) /sc + + # reverst the coordinates back to the regular order according to the original pyramid number + cube = cube[p] + + return cube + +def GetPyramidOrder(xyz): + + if (abs(xyz[0])<= xyz[2]) and (abs(xyz[1])<= xyz[2]) or \ + (abs(xyz[0])<=-xyz[2]) and (abs(xyz[1])<=-xyz[2]): + return [0,1,2] + elif (abs(xyz[2])<= xyz[0]) and (abs(xyz[1])<= xyz[0]) or \ + (abs(xyz[2])<=-xyz[0]) and (abs(xyz[1])<=-xyz[0]): + return [1,2,0] + elif (abs(xyz[0])<= xyz[1]) and (abs(xyz[2])<= xyz[1]) or \ + (abs(xyz[0])<=-xyz[1]) and (abs(xyz[2])<=-xyz[1]): + return [2,0,1] diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 1bc850734..73b7620ca 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -6,6 +6,9 @@ import math,os import numpy as np +from . import Lambert + +P = -1 # ****************************************************************************************** class Quaternion: @@ -1093,3 +1096,443 @@ class Orientation: rot=np.dot(otherMatrix,myMatrix.T) return Orientation(matrix=np.dot(rot,self.asMatrix()),symmetry=targetSymmetry) + +#################################################################################################### +# Code below available according to below conditions on https://github.com/MarDiehl/3Drotations +#################################################################################################### +# Copyright (c) 2017-2019, Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +# Copyright (c) 2013-2014, Marc De Graef/Carnegie Mellon University +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without modification, are +# permitted provided that the following conditions are met: +# +# - Redistributions of source code must retain the above copyright notice, this list +# of conditions and the following disclaimer. +# - Redistributions in binary form must reproduce the above copyright notice, this +# list of conditions and the following disclaimer in the documentation and/or +# other materials provided with the distribution. +# - Neither the names of Marc De Graef, Carnegie Mellon University nor the names +# of its contributors may be used to endorse or promote products derived from +# this software without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +# USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +#################################################################################################### + +def isone(a): + return np.isclose(a,1.0,atol=1.0e-15,rtol=0.0) + +def iszero(a): + return np.isclose(a,0.0,atol=1.0e-300,rtol=0.0) + + +def eu2om(eu): + """Euler angles to orientation matrix""" + c = np.cos(eu) + s = np.sin(eu) + + om = np.array([[+c[0]*c[2]-s[0]*s[2]*c[1], +s[0]*c[2]+c[0]*s[2]*c[1], +s[2]*s[1]], + [-c[0]*s[2]-s[0]*c[2]*c[1], -s[0]*s[2]+c[0]*c[2]*c[1], +c[2]*s[1]], + [+s[0]*s[1], -c[0]*s[1], +c[1] ]]) + + om[np.where(iszero(om))] = 0.0 + return om + + +def eu2ax(eu): + """Euler angles to axis angle""" + t = np.tan(eu[1]*0.5) + sigma = 0.5*(eu[0]+eu[2]) + delta = 0.5*(eu[0]-eu[2]) + tau = np.linalg.norm([t,np.sin(sigma)]) + alpha = np.pi if iszero(np.cos(sigma)) else \ + 2.0*np.arctan(tau/np.cos(sigma)) + + if iszero(alpha): + ax = np.array([ 0.0, 0.0, 1.0, 0.0 ]) + else: + ax = -P/tau * np.array([ t*np.cos(delta), t*np.sin(delta), np.sin(sigma) ]) # passive axis-angle pair so a minus sign in front + ax = np.append(ax,alpha) + if alpha < 0.0: ax *= -1.0 # ensure alpha is positive + + return ax + + +def eu2ro(eu): + """Euler angles to Rodrigues vector""" + ro = eu2ax(eu) # convert to axis angle representation + if ro[3] >= np.pi: # Differs from original implementation. check convention 5 + ro[3] = np.inf + elif iszero(ro[3]): + ro = np.array([ 0.0, 0.0, P, 0.0 ]) + else: + ro[3] = np.tan(ro[3]*0.5) + + return ro + + +def eu2qu(eu): + """Euler angles to quaternion""" + ee = 0.5*eu + cPhi = np.cos(ee[1]) + sPhi = np.sin(ee[1]) + qu = np.array([ cPhi*np.cos(ee[0]+ee[2]), + -P*sPhi*np.cos(ee[0]-ee[2]), + -P*sPhi*np.sin(ee[0]-ee[2]), + -P*cPhi*np.sin(ee[0]+ee[2]) ]) + #if qu[0] < 0.0: qu.homomorph() !ToDo: Check with original + return qu + + +def om2eu(om): + """Euler angles to orientation matrix""" + if isone(om[2,2]**2): + eu = np.array([np.arctan2( om[0,1],om[0,0]), np.pi*0.5*(1-om[2,2]),0.0]) # following the paper, not the reference implementation + else: + zeta = 1.0/np.sqrt(1.0-om[2,2]**2) + eu = np.array([np.arctan2(om[2,0]*zeta,-om[2,1]*zeta), + np.arccos(om[2,2]), + np.arctan2(om[0,2]*zeta, om[1,2]*zeta)]) + + # reduce Euler angles to definition range, i.e a lower limit of 0.0 + eu = np.where(eu<0, (eu+2.0*np.pi)%np.array([2.0*np.pi,np.pi,2.0*np.pi]),eu) + return eu + + +def ax2om(ax): + """Axis angle to orientation matrix""" + c = np.cos(ax[3]) + s = np.sin(ax[3]) + omc = 1.0-c + om=np.diag(ax[0:3]**2*omc + c) + + for idx in [[0,1,2],[1,2,0],[2,0,1]]: + q = omc*ax[idx[0]] * ax[idx[1]] + om[idx[0],idx[1]] = q + s*ax[idx[2]] + om[idx[1],idx[0]] = q - s*ax[idx[2]] + + return om if P < 0.0 else om.T + + +def qu2eu(qu): + """Quaternion to Euler angles""" + q03 = qu[0]**2+qu[3]**2 + q12 = qu[1]**2+qu[2]**2 + chi = np.sqrt(q03*q12) + + if iszero(chi): + eu = np.array([np.arctan2(-P*2.0*qu[0]*qu[3],qu[0]**2-qu[3]**2), 0.0, 0.0]) if iszero(q12) else \ + np.array([np.arctan2(2.0*qu[1]*qu[2],qu[1]**2-qu[2]**2), np.pi, 0.0]) + else: + #chiInv = 1.0/chi ToDo: needed for what? + eu = np.array([np.arctan2((-P*qu[0]*qu[2]+qu[1]*qu[3])*chi, (-P*qu[0]*qu[1]-qu[2]*qu[3])*chi ), + np.arctan2( 2.0*chi, q03-q12 ), + np.arctan2(( P*qu[0]*qu[2]+qu[1]*qu[3])*chi, (-P*qu[0]*qu[1]+qu[2]*qu[3])*chi )]) + + # reduce Euler angles to definition range, i.e a lower limit of 0.0 + eu = np.where(eu<0, (eu+2.0*np.pi)%np.array([2.0*np.pi,np.pi,2.0*np.pi]),eu) + return eu + + +def ax2ho(ax): + """Axis angle to homochoric""" + f = (0.75 * ( ax[3] - np.sin(ax[3]) ))**(1.0/3.0) + ho = ax[0:3] * f + return ho + + +def ho2ax(ho): + """Homochoric to axis angle""" + tfit = np.array([+1.0000000000018852, -0.5000000002194847, + -0.024999992127593126, -0.003928701544781374, + -0.0008152701535450438, -0.0002009500426119712, + -0.00002397986776071756, -0.00008202868926605841, + +0.00012448715042090092, -0.0001749114214822577, + +0.0001703481934140054, -0.00012062065004116828, + +0.000059719705868660826, -0.00001980756723965647, + +0.000003953714684212874, -0.00000036555001439719544]) + # normalize h and store the magnitude + hmag_squared = np.sum(ho**2.) + if iszero(hmag_squared): + ax = np.array([ 0.0, 0.0, 1.0, 0.0 ]) + else: + hm = hmag_squared + + # convert the magnitude to the rotation angle + s = tfit[0] + tfit[1] * hmag_squared + for i in range(2,16): + hm *= hmag_squared + s += tfit[i] * hm + ax = np.append(ho/np.sqrt(hmag_squared),2.0*np.arccos(s)) # ToDo: Check sanity check in reference implementation + + return ax + + +def om2ax(om): + """Orientation matrix to axis angle""" + ax=np.empty(4) + + # first get the rotation angle + t = 0.5*(om.trace() -1.0) + ax[3] = np.arccos(np.clip(t,-1.0,1.0)) + + if iszero(ax[3]): + ax = [ 0.0, 0.0, 1.0, 0.0] + else: + w,vr = np.linalg.eig(om) + # next, find the eigenvalue (1,0j) + i = np.where(np.isclose(w,1.0+0.0j))[0][0] + ax[0:3] = np.real(vr[0:3,i]) + diagDelta = np.array([om[1,2]-om[2,1],om[2,0]-om[0,2],om[0,1]-om[1,0]]) + ax[0:3] = np.where(iszero(diagDelta), ax[0:3],np.abs(ax[0:3])*np.sign(-P*diagDelta)) + + return np.array(ax) + + +def ro2ax(ro): + """Rodrigues vector to axis angle""" + ta = ro[3] + + if iszero(ta): + ax = [ 0.0, 0.0, 1.0, 0.0 ] + elif not np.isfinite(ta): + ax = [ ro[0], ro[1], ro[2], np.pi ] + else: + angle = 2.0*np.arctan(ta) + ta = 1.0/np.linalg.norm(ro[0:3]) + ax = [ ro[0]/ta, ro[1]/ta, ro[2]/ta, angle ] + + return np.array(ax) + + +def ax2ro(ax): + """Axis angle to Rodrigues vector""" + if iszero(ax[3]): + ro = [ 0.0, 0.0, P, 0.0 ] + else: + ro = [ax[0], ax[1], ax[2]] + # 180 degree case + ro += [np.inf] if np.isclose(ax[3],np.pi,atol=1.0e-15,rtol=0.0) else \ + [np.tan(ax[3]*0.5)] + + return np.array(ro) + + +def ax2qu(ax): + """Axis angle to quaternion""" + if iszero(ax[3]): + qu = np.array([ 1.0, 0.0, 0.0, 0.0 ]) + else: + c = np.cos(ax[3]*0.5) + s = np.sin(ax[3]*0.5) + qu = np.array([ c, ax[0]*s, ax[1]*s, ax[2]*s ]) + + return qu + + +def ro2ho(ro): + """Rodrigues vector to homochoric""" + if iszero(np.sum(ro[0:3]**2.0)): + ho = [ 0.0, 0.0, 0.0 ] + else: + f = 2.0*np.arctan(ro[3]) -np.sin(2.0*np.arctan(ro[3])) if np.isfinite(ro[3]) else np.pi + ho = ro[0:3] * (0.75*f)**(1.0/3.0) + + return np.array(ho) + + +def qu2om(qu): + """Quaternion to orientation matrix""" + qq = qu[0]**2-(qu[1]**2 + qu[2]**2 + qu[3]**2) + om = np.diag(qq + 2.0*np.array([qu[1],qu[2],qu[3]])**2) + + om[1,0] = 2.0*(qu[2]*qu[1]+qu[0]*qu[3]) + om[0,1] = 2.0*(qu[1]*qu[2]-qu[0]*qu[3]) + om[2,1] = 2.0*(qu[3]*qu[2]+qu[0]*qu[1]) + om[1,2] = 2.0*(qu[2]*qu[3]-qu[0]*qu[1]) + om[0,2] = 2.0*(qu[1]*qu[3]+qu[0]*qu[2]) + om[2,0] = 2.0*(qu[3]*qu[1]-qu[0]*qu[2]) + return om if P > 0.0 else om.T + + +def om2qu(om): + """Orientation matrix to quaternion""" + s = [+om[0,0] +om[1,1] +om[2,2] +1.0, + +om[0,0] -om[1,1] -om[2,2] +1.0, + -om[0,0] +om[1,1] -om[2,2] +1.0, + -om[0,0] -om[1,1] +om[2,2] +1.0] + s = np.maximum(np.zeros(4),s) + qu = np.sqrt(s)*0.5*np.array([1.0,P,P,P]) + # verify the signs (q0 always positive) + #ToDo: Here I donot understand the original shortcut from paper to implementation + + qu /= np.linalg.norm(qu) + if any(isone(abs(qu))): qu[np.where(np.logical_not(isone(qu)))] = 0.0 + if om[2,1] < om[1,2]: qu[1] *= -1.0 + if om[0,2] < om[2,0]: qu[2] *= -1.0 + if om[1,0] < om[0,1]: qu[3] *= -1.0 + if any(om2ax(om)[0:3]*qu[1:4] < 0.0): print(om2ax(om),qu) # something is wrong here + return qu + +def qu2ax(qu): + """Quaternion to axis angle""" + omega = 2.0 * np.arccos(qu[0]) + if iszero(omega): # return axis as [001] if the angle is zero + ax = [ 0.0, 0.0, 1.0, 0.0 ] + elif not iszero(qu[0]): + s = np.sign(qu[0])/np.sqrt(qu[1]**2+qu[2]**2+qu[3]**2) + ax = [ qu[1]*s, qu[2]*s, qu[3]*s, omega ] + else: + ax = [ qu[1], qu[2], qu[3], np.pi] + + return np.array(ax) + + +def qu2ro(qu): + """Quaternion to Rodrigues vector""" + if iszero(qu[0]): + ro = [qu[1], qu[2], qu[3], np.inf] + else: + s = np.linalg.norm([qu[1],qu[2],qu[3]]) + ro = [0.0,0.0,P,0.0] if iszero(s) else \ + [ qu[1]/s, qu[2]/s, qu[3]/s, np.tan(np.arccos(qu[0]))] + + return np.array(ro) + + +def qu2ho(qu): + """Quaternion to homochoric""" + omega = 2.0 * np.arccos(qu[0]) + + if iszero(omega): + ho = np.array([ 0.0, 0.0, 0.0 ]) + else: + ho = np.array([qu[1], qu[2], qu[3]]) + f = 0.75 * ( omega - np.sin(omega) ) + ho = ho/np.linalg.norm(ho) * f**(1./3.) + + return ho + + +def ho2cu(ho): + """Homochoric to cubochoric""" + return Lambert.BallToCube(ho) + + +def cu2ho(cu): + """Cubochoric to homochoric""" + return Lambert.CubeToBall(cu) + + +def ro2eu(ro): + """Rodrigues vector to orientation matrix""" + return om2eu(ro2om(ro)) + + +def eu2ho(eu): + """Euler angles to homochoric""" + return ax2ho(eu2ax(eu)) + + +def om2ro(om): + """Orientation matrix to Rodriques vector""" + return eu2ro(om2eu(om)) + + +def om2ho(om): + """Orientation matrix to homochoric""" + return ax2ho(om2ax(om)) + + +def ax2eu(ax): + """Orientation matrix to Euler angles""" + return om2eu(ax2om(ax)) + + +def ro2om(ro): + """Rodgrigues vector to orientation matrix""" + return ax2om(ro2ax(ro)) + + +def ro2qu(ro): + """Rodrigues vector to quaternion""" + return ax2qu(ro2ax(ro)) + + +def ho2eu(ho): + """Homochoric to Euler angles""" + return ax2eu(ho2ax(ho)) + + +def ho2om(ho): + """Homochoric to orientation matrix""" + return ax2om(ho2ax(ho)) + + +def ho2ro(ho): + """Axis angle to Rodriques vector""" + return ax2ro(ho2ax(ho)) + + +def ho2qu(ho): + """Homochoric to quaternion""" + return ax2qu(ho2ax(ho)) + + +def eu2cu(eu): + """Euler angles to cubochoric""" + return ho2cu(eu2ho(eu)) + + +def om2cu(om): + """Orientation matrix to cubochoric""" + return ho2cu(om2ho(om)) + + +def ax2cu(ax): + """Axis angle to cubochoric""" + return ho2cu(ax2ho(ax)) + + +def ro2cu(ro): + """Rodrigues vector to cubochoric""" + return ho2cu(ro2ho(ro)) + + +def qu2cu(qu): + """Quaternion to cubochoric""" + return ho2cu(qu2ho(qu)) + + +def cu2eu(cu): + """Cubochoric to Euler angles""" + return ho2eu(cu2ho(cu)) + + +def cu2om(cu): + """Cubochoric to orientation matrix""" + return ho2om(cu2ho(cu)) + + +def cu2ax(cu): + """Cubochoric to axis angle""" + return ho2ax(cu2ho(cu)) + + +def cu2ro(cu): + """Cubochoric to Rodrigues vector""" + return ho2ro(cu2ho(cu)) + + +def cu2qu(cu): + """Cubochoric to quaternion""" + return ho2qu(cu2ho(cu)) From 7ee933b79d7749a393083455ee72ea841fbd3895 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Feb 2019 23:50:02 +0100 Subject: [PATCH 157/309] Rotation class uses (and hides) Quaternion2. Should replace Quaternion class. Orientation class should inherit from Rotation and adds symmetry. --- python/damask/__init__.py | 2 +- python/damask/orientation.py | 345 +++++++++++++++++++++++++++++++++++ 2 files changed, 346 insertions(+), 1 deletion(-) diff --git a/python/damask/__init__.py b/python/damask/__init__.py index c8981069d..a9209a1c6 100644 --- a/python/damask/__init__.py +++ b/python/damask/__init__.py @@ -13,7 +13,7 @@ from .asciitable import ASCIItable # noqa from .config import Material # noqa from .colormaps import Colormap, Color # noqa -from .orientation import Quaternion, Symmetry, Orientation # noqa +from .orientation import Quaternion, Symmetry, Rotation, Orientation # noqa #from .block import Block # only one class from .result import Result # noqa diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 73b7620ca..9a92c77d4 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -10,6 +10,350 @@ from . import Lambert P = -1 +#################################################################################################### +class Quaternion2: + u""" + Quaternion with basic operations + + q is the real part, p = (x, y, z) are the imaginary parts. + Defintion of multiplication depends on variable P, P ∉ {-1,1}. + """ + + def __init__(self, + q = 0.0, + p = np.zeros(3,dtype=float)): + """Initializes to identity unless specified""" + self.q = q + self.p = np.array(p) + + + def __copy__(self): + """Copy""" + return self.__class__(q=self.q, + p=self.p.copy()) + + copy = __copy__ + + + def __iter__(self): + """Components""" + return iter(self.asList()) + + def asArray(self): + """As numpy array""" + return np.array((self.q,self.p[0],self.p[1],self.p[2])) + + def asList(self): + return [self.q]+list(self.p) + + + def __repr__(self): + """Readable string""" + return 'Quaternion(real={q:+.6f}, imag=<{p[0]:+.6f}, {p[1]:+.6f}, {p[2]:+.6f}>)'.format(q=self.q,p=self.p) + + + def __add__(self, other): + """Addition""" + if isinstance(other, Quaternion2): + return self.__class__(q=self.q + other.q, + p=self.p + other.p) + else: + return NotImplemented + + def __iadd__(self, other): + """In-place addition""" + if isinstance(other, Quaternion2): + self.q += other.q + self.p += other.p + return self + else: + return NotImplemented + + def __pos__(self): + """Unary positive operator""" + return self + + + def __sub__(self, other): + """Subtraction""" + if isinstance(other, Quaternion2): + return self.__class__(q=self.q - other.q, + p=self.p - other.p) + else: + return NotImplemented + + def __isub__(self, other): + """In-place subtraction""" + if isinstance(other, Quaternion2): + self.q -= other.q + self.p -= other.p + return self + else: + return NotImplemented + + def __neg__(self): + """Unary positive operator""" + self.q *= -1.0 + self.p *= -1.0 + return self + + + def __mul__(self, other): + """Multiplication with quaternion or scalar""" + if isinstance(other, Quaternion2): + return self.__class__(q=self.q*other.q - np.dot(self.p,other.p), + p=self.q*other.p + other.q*self.p + P * np.cross(self.p,other.p)) + elif isinstance(other, (int, float)): + return self.__class__(q=self.q*other, + p=self.p*other) + else: + return NotImplemented + + def __imul__(self, other): + """In-place multiplication with quaternion or scalar""" + if isinstance(other, Quaternion2): + self.q = self.q*other.q - np.dot(self.p,other.p) + self.p = self.q*other.p + other.q*self.p + P * np.cross(self.p,other.p) + return self + elif isinstance(other, (int, float)): + self *= other + return self + else: + return NotImplemented + + + def __truediv__(self, other): + """Divsion with quaternion or scalar""" + if isinstance(other, Quaternion2): + s = other.conjugate()/abs(other)**2. + return self.__class__(q=self.q * s, + p=self.p * s) + elif isinstance(other, (int, float)): + self.q /= other + self.p /= other + return self + else: + return NotImplemented + + def __itruediv__(self, other): + """In-place divsion with quaternion or scalar""" + if isinstance(other, Quaternion2): + s = other.conjugate()/abs(other)**2. + self *= s + return self + elif isinstance(other, (int, float)): + self.q /= other + return self + else: + return NotImplemented + + + def __pow__(self, exponent): + """Power""" + if isinstance(exponent, (int, float)): + omega = np.acos(self.q) + return self.__class__(q= np.cos(exponent*omega), + p=self.p * np.sin(exponent*omega)/np.sin(omega)) + else: + return NotImplemented + + def __ipow__(self, exponent): + """In-place power""" + if isinstance(exponent, (int, float)): + omega = np.acos(self.q) + self.q = np.cos(exponent*omega) + self.p *= np.sin(exponent*omega)/np.sin(omega) + else: + return NotImplemented + + + def __abs__(self): + """Norm""" + return math.sqrt(self.q ** 2 + np.dot(self.p,self.p)) + + magnitude = __abs__ + + + def __eq__(self,other): + """Equal (sufficiently close) to each other""" + return np.isclose(( self-other).magnitude(),0.0) \ + or np.isclose((-self-other).magnitude(),0.0) + + def __ne__(self,other): + """Not equal (sufficiently close) to each other""" + return not self.__eq__(other) + + + def normalize(self): + d = self.magnitude() + if d > 0.0: + self.q /= d + self.p /= d + return self + + def normalized(self): + return self.copy().normalize() + + + def conjugate(self): + self.p = -self.p + return self + + def conjugated(self): + return self.copy().conjugate() + + + def homomorph(self): + if self.q < 0.0: + self.q = -self.q + self.p = -self.p + return self + + def homomorphed(self): + return self.copy().homomorph() + + + +#################################################################################################### +class Rotation: + u""" + Orientation stored as unit quaternion. + + All methods and naming conventions based on Rowenhorst_etal2015 + Convention 1: coordinate frames are right-handed + Convention 2: a rotation angle ω is taken to be positive for a counterclockwise rotation + when viewing from the end point of the rotation axis towards the origin + Convention 3: rotations will be interpreted in the passive sense + Convention 4: Euler angle triplets are implemented using the Bunge convention, + with the angular ranges as [0, 2π],[0, π],[0, 2π] + Convention 5: the rotation angle ω is limited to the interval [0, π] + Convention 6: P = -1 (as default) + + q is the real part, p = (x, y, z) are the imaginary parts. + + Vector "a" (defined in coordinate system "A") is passively rotated + resulting in new coordinates "b" when expressed in system "B". + b = Q * a + b = np.dot(Q.asMatrix(),a) + ToDo: Denfine how to 3x3 and 3x3x3x3 matrices + """ + + __slots__ = ['quaternion'] + + def __init__(self,quaternion = np.array([1.0,0.0,0.0,0.0])): + """Initializes to identity unless specified""" + self.quaternion = Quaternion2(q=quaternion[0],p=quaternion[1:4]) + self.quaternion.homomorph() # ToDo: Needed? + + def __repr__(self): + """Value in selected representation""" + return '\n'.join([ + 'Quaternion: {}'.format(self.quaternion), + 'Matrix:\n{}'.format( '\n'.join(['\t'.join(list(map(str,self.asMatrix()[i,:]))) for i in range(3)]) ), + 'Bunge Eulers / deg: {}'.format('\t'.join(list(map(str,self.asEulers(degrees=True)))) ), + ]) + + + def asQuaternion(self): + return self.quaternion.asArray() + + def asEulers(self, + degrees = False): + return np.degrees(qu2eu(self.quaternion.asArray())) if degrees else qu2eu(self.quaternion.asArray()) + + def asAngleAxis(self, + degrees = False): + + ax = qu2ax(self.quaternion.asArray()) + if degrees: ax[0] = np.degrees(ax[0]) + + return ax + + def asMatrix(self): + return qu2om(self.quaternion.asArray()) + + def asRodrigues(self): + return qu2ro(self.quaternion.asArray()) + + def asHomochoric(self): + return qu2ho(self.quaternion.asArray()) + + def asCubochoric(self): + return qu2cu(self.quaternion.asArray()) + + + + @classmethod + def fromQuaternion(cls, + quaternion, + P = -1): + + qu = quaternion + if P > 0: qu[1:3] *= -1 # convert from P=1 to P=-1 + if qu[0] < 0.0: + raise ValueError('Quaternion has negative first component.\n{}'.format(qu[0])) + if not np.isclose(np.linalg.norm(qu), 1.0): + raise ValueError('Quaternion is not of unit length.\n{} {} {} {}'.format(*qu)) + + return cls(qu) + + @classmethod + def fromEulers(cls, + eulers, + degrees = False): + + eu = np.radians(eulers) if degrees else eulers + if np.any(eu < 0.0) or np.any(eu > 2.0*np.pi) or eu[1] > np.pi: + raise ValueError('Euler angles outside of [0..2π],[0..π],[0..2π].\n{} {} {}.'.format(*eu)) + + return cls(eu2qu(eu)) + + @classmethod + def fromAngleAxis(cls, + angleAxis, + degrees = False, + P = -1): + + ax = angleAxis + if P > 0: ax[1:3] *= -1 # convert from P=1 to P=-1 + if degrees: ax[0] = np.degrees(ax[0]) + if ax[0] < 0.0 or ax[0] > np.pi: + raise ValueError('Axis angle rotation angle outside of [0..π].\n'.format(ax[0])) + if not np.isclose(np.linalg.norm(ax[1:3]), 1.0): + raise ValueError('Axis angle rotation axis is not of unit length.\n{} {} {}'.format(*ax[1:3])) + + return cls(ax2qu(ax)) + + @classmethod + def fromMatrix(cls, + matrix): + + om = matrix + if not np.isclose(np.linalg.det(om),1.0): + raise ValueError('matrix is not a proper rotation.\n{}'.format(om)) + if not np.isclose(np.dot(om[0],om[1]), 0.0) \ + or not np.isclose(np.dot(om[1],om[2]), 0.0) \ + or not np.isclose(np.dot(om[2],om[0]), 0.0): + raise ValueError('matrix is not orthogonal.\n{}'.format(om)) + + return cls(om2qu(om)) + + @classmethod + def fromRodrigues(cls, + rodrigues, + P = -1): + + ro = rodrigues + if P > 0: ro[1:3] *= -1 # convert from P=1 to P=-1 + if not np.isclose(np.linalg.norm(ro[1:3]), 1.0): + raise ValueError('Rodrigues rotation axis is not of unit length.\n{} {} {}'.format(*ro[1:3])) + if ro[0] < 0.0: + raise ValueError('Rodriques rotation angle not positive.\n'.format(ro[0])) + + return cls(ro2qu(ro)) + + + # ****************************************************************************************** class Quaternion: u""" @@ -1383,6 +1727,7 @@ def om2qu(om): if any(om2ax(om)[0:3]*qu[1:4] < 0.0): print(om2ax(om),qu) # something is wrong here return qu + def qu2ax(qu): """Quaternion to axis angle""" omega = 2.0 * np.arccos(qu[0]) From 48b0307fab9c932b7925bd3fa852dca67bdf1092 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 00:11:22 +0100 Subject: [PATCH 158/309] using new rotation class cannot rotate matrices (3,3) and (3,3,3,3) at the moment --- processing/post/addOrientations.py | 47 +++++++---------------------- processing/pre/geom_addPrimitive.py | 11 +++---- python/damask/orientation.py | 32 ++++++++++++++++++-- 3 files changed, 45 insertions(+), 45 deletions(-) diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index a33f96b91..ec824c88c 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -9,31 +9,6 @@ import damask scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) -# -------------------------------------------------------------------- -# convention conformity checks -# -------------------------------------------------------------------- - -def check_Eulers(eulers): - if np.any(eulers < 0.0) or np.any(eulers > 2.0*np.pi) or eulers[1] > np.pi: # Euler angles within valid range? - raise ValueError('Euler angles outside of [0..2π],[0..π],[0..2π].\n{} {} {}.'.format(*eulers)) - return eulers - -def check_quaternion(q): - if q[0] < 0.0: # positive first quaternion component? - raise ValueError('quaternion has negative first component.\n{}'.format(q[0])) - if not np.isclose(np.linalg.norm(q), 1.0): # unit quaternion? - raise ValueError('quaternion is not of unit length.\n{} {} {} {}'.format(*q)) - return q - -def check_matrix(M): - if not np.isclose(np.linalg.det(M),1.0): # proper rotation? - raise ValueError('matrix is not a proper rotation.\n{}'.format(M)) - if not np.isclose(np.dot(M[0],M[1]), 0.0) \ - or not np.isclose(np.dot(M[1],M[2]), 0.0) \ - or not np.isclose(np.dot(M[2],M[0]), 0.0): # all orthogonal? - raise ValueError('matrix is not orthogonal.\n{}'.format(M)) - return M - # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- @@ -133,9 +108,8 @@ if np.sum(input) != 1: parser.error('needs exactly one input format.') (options.quaternion,4,'quaternion'), ][np.where(input)[0][0]] # select input label that was requested -toRadians = np.pi/180.0 if options.degrees else 1.0 # rescale degrees to radians -r = damask.Quaternion.fromAngleAxis(toRadians*options.crystalrotation[0],options.crystalrotation[1:]) # crystal frame rotation -R = damask.Quaternion.fromAngleAxis(toRadians*options. labrotation[0],options. labrotation[1:]) # lab frame rotation +r = damask.Rotation.fromAngleAxis(np.array(options.crystalrotation),options.degrees) # crystal frame rotation +R = damask.Rotation.fromAngleAxis(np.array(options.labrotation),options.degrees) # lab frame rotation # --- loop over input files ------------------------------------------------------------------------ @@ -179,23 +153,24 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': + o = damask.Rotation.fromEulers(np.array(list(map(float,table.data[column:column+3]))),options.degrees) - o = damask.Orientation(Eulers = check_Eulers(np.array(list(map(float,table.data[column:column+3])))*toRadians)) elif inputtype == 'rodrigues': - o = damask.Orientation(Rodrigues = np.array(list(map(float,table.data[column:column+3])))) - elif inputtype == 'matrix': + o = damask.Rotation.fromRodrigues(np.array(list(map(float,table.data[column:column+3])))) - o = damask.Orientation(matrix = check_matrix(np.array(list(map(float,table.data[column:column+9]))).reshape(3,3))) + elif inputtype == 'matrix': + o = damask.Rotation.fromMatrix(np.array(list(map(float,table.data[column:column+9]))).reshape(3,3)) + elif inputtype == 'frame': M = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ table.data[column[1]:column[1]+3] + \ table.data[column[2]:column[2]+3]))).reshape(3,3).T - o = damask.Orientation(matrix = check_matrix(M/np.linalg.norm(M,axis=0))) - elif inputtype == 'quaternion': + o = damask.Rotation.fromMatrix(M/np.linalg.norm(M,axis=0)) - o = damask.Orientation(quaternion = check_quaternion(np.array(list(map(float,table.data[column:column+4]))))) + elif inputtype == 'quaternion': + o = damask.Rotation.fromQuaternion(np.array(list(map(float,table.data[column:column+4])))) - o.quaternion = r*o.quaternion*R # apply additional lab and crystal frame rotations + o= r*o*R # apply additional lab and crystal frame rotations for output in options.output: if output == 'quaternion': table.data_append(o.asQuaternion()) diff --git a/processing/pre/geom_addPrimitive.py b/processing/pre/geom_addPrimitive.py index 54de558f7..08281bd5c 100755 --- a/processing/pre/geom_addPrimitive.py +++ b/processing/pre/geom_addPrimitive.py @@ -43,7 +43,7 @@ parser.add_option('-f', '--fill', dest='fill', type='int', metavar = 'int' help='grain index to fill primitive. "0" selects maximum microstructure index + 1 [%default]') parser.add_option('-q', '--quaternion', dest='quaternion', type='float', nargs = 4, metavar=' '.join(['float']*4), help = 'rotation of primitive as quaternion') -parser.add_option('-a', '--angleaxis', dest='angleaxis', nargs = 4, metavar=' '.join(['float']*4), +parser.add_option('-a', '--angleaxis', dest='angleaxis', nargs = 4, metavar=' '.join(['float']*4), type=float, help = 'angle,x,y,z clockwise rotation of primitive about axis by angle') parser.add_option( '--degrees', dest='degrees', action='store_true', help = 'angle is given in degrees [%default]') @@ -63,14 +63,11 @@ parser.set_defaults(center = (.0,.0,.0), if options.dimension is None: parser.error('no dimension specified.') if options.angleaxis is not None: - options.angleaxis = list(map(float,options.angleaxis)) - rotation = damask.Quaternion.fromAngleAxis(np.radians(options.angleaxis[0]) if options.degrees else options.angleaxis[0], - options.angleaxis[1:4]) + rotation = damask.Rotation.fromAngleAxis(np.array(options.angleaxis),options.degrees) elif options.quaternion is not None: - options.quaternion = list(map(float,options.quaternion)) - rotation = damask.Quaternion(quat=options.quaternion) + rotation = damask.Rotation.fromQuaternion(np.array(options.quaternion)) else: - rotation = damask.Quaternion() + rotation = damask.Rotation() options.center = np.array(options.center) options.dimension = np.array(options.dimension) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 9a92c77d4..bba13eb8a 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -235,7 +235,6 @@ class Rotation: resulting in new coordinates "b" when expressed in system "B". b = Q * a b = np.dot(Q.asMatrix(),a) - ToDo: Denfine how to 3x3 and 3x3x3x3 matrices """ __slots__ = ['quaternion'] @@ -351,9 +350,38 @@ class Rotation: raise ValueError('Rodriques rotation angle not positive.\n'.format(ro[0])) return cls(ro2qu(ro)) - + def __mul__(self, other): + """ + Multiplication + + Rotation: Details needed (active/passive), more cases (3,3), (3,3,3,3) need to be considered + """ + if isinstance(other, Rotation): + return self.__class__((self.quaternion * other.quaternion).asArray()) + elif isinstance(other, np.ndarray): + if other.shape == (3,): + ( x, y, z) = self.quaternion.p + (Vx,Vy,Vz) = other[0:3] + A = self.quaternion.q*self.quaternion.q - np.dot(self.quaternion.p,self.quaternion.p) + B = 2.0 * (x*Vx + y*Vy + z*Vz) + C = 2.0 * P*self.quaternion.q + + return np.array([ + A*Vx + B*x + C*(y*Vz - z*Vy), + A*Vy + B*y + C*(z*Vx - x*Vz), + A*Vz + B*z + C*(x*Vy - y*Vx), + ]) + elif other.shape == (3,3,): + raise NotImplementedError + elif other.shape == (3,3,3,3): + raise NotImplementedError + else: + return NotImplemented + else: + return NotImplemented + # ****************************************************************************************** class Quaternion: u""" From 79b7ae1b3ef94a744089d226be8670775b39deb1 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 12 Feb 2019 01:12:16 +0100 Subject: [PATCH 159/309] [skip ci] updated version information after successful test of v2.0.2-1689-g1a471bcd --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index f8fbcdee0..6e1ce244f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1687-gfa1c946d +v2.0.2-1689-g1a471bcd From e47c275e0c8af0ff5e0307430d558e740adb7c24 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 06:18:21 +0100 Subject: [PATCH 160/309] unknown encoding caused problem (on python2?) --- python/damask/Lambert.py | 9 ++++++--- python/damask/orientation.py | 8 ++------ 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/python/damask/Lambert.py b/python/damask/Lambert.py index 9972b7965..5d07f73f4 100644 --- a/python/damask/Lambert.py +++ b/python/damask/Lambert.py @@ -1,7 +1,9 @@ +# -*- coding: UTF-8 no BOM -*- + #################################################################################################### -# Code below available according to below conditions on https://github.com/MarDiehl/3Drotations +# Code below available according to the followin conditions on https://github.com/MarDiehl/3Drotations #################################################################################################### -# Copyright (c) 2017-2019, Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +# Copyright (c) 2017-2019, Martin Diehl/Max-Planck-Institut für Eisenforschung GmbH # Copyright (c) 2013-2014, Marc De Graef/Carnegie Mellon University # All rights reserved. # @@ -28,6 +30,7 @@ # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE # USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #################################################################################################### + import numpy as np sc = np.pi**(1./6.)/6.**(1./6.) @@ -104,7 +107,7 @@ def BallToCube(ball): # inverse M_1 cube = np.array([ Tinv[0], Tinv[1], (-1.0 if xyz3[2] < 0.0 else 1.0) * rs / np.sqrt(6.0/np.pi) ]) /sc - # reverst the coordinates back to the regular order according to the original pyramid number + # reverse the coordinates back to the regular order according to the original pyramid number cube = cube[p] return cube diff --git a/python/damask/orientation.py b/python/damask/orientation.py index bba13eb8a..5316b2026 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -1,9 +1,5 @@ # -*- coding: UTF-8 no BOM -*- -################################################### -# NOTE: everything here needs to be a np array # -################################################### - import math,os import numpy as np from . import Lambert @@ -1470,9 +1466,9 @@ class Orientation: return Orientation(matrix=np.dot(rot,self.asMatrix()),symmetry=targetSymmetry) #################################################################################################### -# Code below available according to below conditions on https://github.com/MarDiehl/3Drotations +# Code below available according to the followin conditions on https://github.com/MarDiehl/3Drotations #################################################################################################### -# Copyright (c) 2017-2019, Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +# Copyright (c) 2017-2019, Martin Diehl/Max-Planck-Institut für Eisenforschung GmbH # Copyright (c) 2013-2014, Marc De Graef/Carnegie Mellon University # All rights reserved. # From 4215ae3888582d70eedc5707375158b202d08ecb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 06:32:26 +0100 Subject: [PATCH 161/309] rotation of matrix is defined in class --- python/damask/orientation.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 5316b2026..cb3b61ee2 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -45,7 +45,7 @@ class Quaternion2: def __repr__(self): """Readable string""" - return 'Quaternion(real={q:+.6f}, imag=<{p[0]:+.6f}, {p[1]:+.6f}, {p[2]:+.6f}>)'.format(q=self.q,p=self.p) + return 'Quaternion: (real={q:+.6f}, imag=<{p[0]:+.6f}, {p[1]:+.6f}, {p[2]:+.6f}>)'.format(q=self.q,p=self.p) def __add__(self, other): @@ -243,7 +243,7 @@ class Rotation: def __repr__(self): """Value in selected representation""" return '\n'.join([ - 'Quaternion: {}'.format(self.quaternion), + '{}'.format(self.quaternion), 'Matrix:\n{}'.format( '\n'.join(['\t'.join(list(map(str,self.asMatrix()[i,:]))) for i in range(3)]) ), 'Bunge Eulers / deg: {}'.format('\t'.join(list(map(str,self.asEulers(degrees=True)))) ), ]) @@ -370,7 +370,7 @@ class Rotation: A*Vz + B*z + C*(x*Vy - y*Vx), ]) elif other.shape == (3,3,): - raise NotImplementedError + return np.dot(self.asMatrix(),np.dot(other,self.asMatrix().T)) elif other.shape == (3,3,3,3): raise NotImplementedError else: From ef3fc0b58ad32eea2fc0c8dbffaf99070f129c1d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 07:42:46 +0100 Subject: [PATCH 162/309] bugfix: wrong array indexing rotation of meshgrid tuple implemented --- processing/post/rotateData.py | 11 +++---- processing/pre/geom_addPrimitive.py | 5 ++- python/damask/orientation.py | 49 ++++++++++++++++++++++------- 3 files changed, 44 insertions(+), 21 deletions(-) diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 95102345b..3712b8c73 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -40,9 +40,7 @@ parser.set_defaults(rotation = (0.,1.,1.,1.), if options.data is None: parser.error('no data column specified.') -toRadians = math.pi/180.0 if options.degrees else 1.0 # rescale degrees to radians -q = damask.Quaternion().fromAngleAxis(toRadians*options.rotation[0],options.rotation[1:]) -R = q.asMatrix() +r = damask.Rotation.fromAngleAxis(options.rotation,degrees) # --- loop over input files ------------------------------------------------------------------------- @@ -90,12 +88,11 @@ for name in filenames: while outputAlive and table.data_read(): # read next data line of ASCII table for v in active['vector']: column = table.label_index(v) - table.data[column:column+3] = q * np.array(list(map(float,table.data[column:column+3]))) + table.data[column:column+3] = r * np.array(list(map(float,table.data[column:column+3]))) for t in active['tensor']: column = table.label_index(t) - table.data[column:column+9] = \ - np.dot(R,np.dot(np.array(list(map(float,table.data[column:column+9]))).reshape((3,3)), - R.transpose())).reshape((9)) + table.data[column:column+9] = (r * (np.array(list(map(float,table.data[column:column+9]))))).reshape((3,3)) + outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- diff --git a/processing/pre/geom_addPrimitive.py b/processing/pre/geom_addPrimitive.py index 08281bd5c..f93cdd54f 100755 --- a/processing/pre/geom_addPrimitive.py +++ b/processing/pre/geom_addPrimitive.py @@ -63,7 +63,7 @@ parser.set_defaults(center = (.0,.0,.0), if options.dimension is None: parser.error('no dimension specified.') if options.angleaxis is not None: - rotation = damask.Rotation.fromAngleAxis(np.array(options.angleaxis),options.degrees) + rotation = damask.Rotation.fromAngleAxis(np.array(options.angleaxis),options.degrees,normalise=True) elif options.quaternion is not None: rotation = damask.Rotation.fromQuaternion(np.array(options.quaternion)) else: @@ -156,8 +156,7 @@ for name in filenames: X -= options.center[0] - 0.5 Y -= options.center[1] - 0.5 Z -= options.center[2] - 0.5 - # and then by applying the quaternion - # this should be rotation.conjugate() * (X,Y,Z), but it is this way for backwards compatibility with the older version of this script + # and then by applying the rotation (X, Y, Z) = rotation * (X, Y, Z) # and finally by scaling (we don't worry about options.dimension being negative, np.abs occurs on the microstructure = np.where... line) X /= options.dimension[0] * 0.5 diff --git a/python/damask/orientation.py b/python/damask/orientation.py index cb3b61ee2..54482332b 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -284,7 +284,7 @@ class Rotation: P = -1): qu = quaternion - if P > 0: qu[1:3] *= -1 # convert from P=1 to P=-1 + if P > 0: qu[1:4] *= -1 # convert from P=1 to P=-1 if qu[0] < 0.0: raise ValueError('Quaternion has negative first component.\n{}'.format(qu[0])) if not np.isclose(np.linalg.norm(qu), 1.0): @@ -307,15 +307,17 @@ class Rotation: def fromAngleAxis(cls, angleAxis, degrees = False, + normalise = False, P = -1): ax = angleAxis - if P > 0: ax[1:3] *= -1 # convert from P=1 to P=-1 - if degrees: ax[0] = np.degrees(ax[0]) + if P > 0: ax[1:4] *= -1 # convert from P=1 to P=-1 + if degrees: ax[0] = np.degrees(ax[0]) + if normalise: ax[1:4] /=np.linalg.norm(ax[1:4]) if ax[0] < 0.0 or ax[0] > np.pi: raise ValueError('Axis angle rotation angle outside of [0..π].\n'.format(ax[0])) - if not np.isclose(np.linalg.norm(ax[1:3]), 1.0): - raise ValueError('Axis angle rotation axis is not of unit length.\n{} {} {}'.format(*ax[1:3])) + if not np.isclose(np.linalg.norm(ax[1:4]), 1.0): + raise ValueError('Axis angle rotation axis is not of unit length.\n{} {} {}'.format(*ax[1:4])) return cls(ax2qu(ax)) @@ -336,12 +338,14 @@ class Rotation: @classmethod def fromRodrigues(cls, rodrigues, + normalise = False, P = -1): ro = rodrigues - if P > 0: ro[1:3] *= -1 # convert from P=1 to P=-1 - if not np.isclose(np.linalg.norm(ro[1:3]), 1.0): - raise ValueError('Rodrigues rotation axis is not of unit length.\n{} {} {}'.format(*ro[1:3])) + if P > 0: ro[1:4] *= -1 # convert from P=1 to P=-1 + if normalise: ro[1:4] /=np.linalg.norm(ro[1:4]) + if not np.isclose(np.linalg.norm(ro[1:4]), 1.0): + raise ValueError('Rodrigues rotation axis is not of unit length.\n{} {} {}'.format(*ro[1:4])) if ro[0] < 0.0: raise ValueError('Rodriques rotation angle not positive.\n'.format(ro[0])) @@ -354,10 +358,10 @@ class Rotation: Rotation: Details needed (active/passive), more cases (3,3), (3,3,3,3) need to be considered """ - if isinstance(other, Rotation): + if isinstance(other, Rotation): # rotate a rotation return self.__class__((self.quaternion * other.quaternion).asArray()) elif isinstance(other, np.ndarray): - if other.shape == (3,): + if other.shape == (3,): # rotate a single (3)-vector ( x, y, z) = self.quaternion.p (Vx,Vy,Vz) = other[0:3] A = self.quaternion.q*self.quaternion.q - np.dot(self.quaternion.p,self.quaternion.p) @@ -369,14 +373,37 @@ class Rotation: A*Vy + B*y + C*(z*Vx - x*Vz), A*Vz + B*z + C*(x*Vy - y*Vx), ]) - elif other.shape == (3,3,): + elif other.shape == (3,3,): # rotate a single (3x3)-matrix return np.dot(self.asMatrix(),np.dot(other,self.asMatrix().T)) elif other.shape == (3,3,3,3): raise NotImplementedError else: return NotImplemented + elif isinstance(other, tuple): # used to rotate a meshgrid-tuple + ( x, y, z) = self.quaternion.p + (Vx,Vy,Vz) = other[0:3] + A = self.quaternion.q*self.quaternion.q - np.dot(self.quaternion.p,self.quaternion.p) + B = 2.0 * (x*Vx + y*Vy + z*Vz) + C = 2.0 * P*self.quaternion.q + + return np.array([ + A*Vx + B*x + C*(y*Vz - z*Vy), + A*Vy + B*y + C*(z*Vx - x*Vz), + A*Vz + B*z + C*(x*Vy - y*Vx), + ]) else: return NotImplemented + + + def inverse(self): + """Inverse rotation/backward rotation""" + self.quaternion.conjugate() + return self + + def inversed(self): + """In-place inverse rotation/backward rotation""" + return self.__class__(self.quaternion.conjugated().asArray()) + # ****************************************************************************************** class Quaternion: From 97ac4376865b9f8061b1a5345b5955c646e44a35 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 07:55:54 +0100 Subject: [PATCH 163/309] more user friendly constructors --- PRIVATE | 2 +- processing/post/addOrientations.py | 16 +++++------ processing/post/rotateData.py | 8 +++--- processing/pre/geom_addPrimitive.py | 4 +-- python/damask/orientation.py | 44 +++++++++++++++++++---------- 5 files changed, 44 insertions(+), 30 deletions(-) diff --git a/PRIVATE b/PRIVATE index 25006bc97..406d482f8 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 25006bc974b752faf3464b082511590d50093c37 +Subproject commit 406d482f8059b4459634af729ce85491a9a3245c diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index ec824c88c..65444bcb9 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -79,8 +79,8 @@ parser.add_option('-z', help = 'label of lab z vector (expressed in crystal coords)') parser.set_defaults(output = [], - labrotation = (0.,1.,1.,1.), # no rotation about 1,1,1 - crystalrotation = (0.,1.,1.,1.), # no rotation about 1,1,1 + labrotation = (0.,1.,0.,0.), # no rotation about 1,0,0 + crystalrotation = (0.,1.,0.,0.), # no rotation about 1,0,0 degrees = False, ) @@ -108,8 +108,8 @@ if np.sum(input) != 1: parser.error('needs exactly one input format.') (options.quaternion,4,'quaternion'), ][np.where(input)[0][0]] # select input label that was requested -r = damask.Rotation.fromAngleAxis(np.array(options.crystalrotation),options.degrees) # crystal frame rotation -R = damask.Rotation.fromAngleAxis(np.array(options.labrotation),options.degrees) # lab frame rotation +r = damask.Rotation.fromAngleAxis(options.crystalrotation,options.degrees) # crystal frame rotation +R = damask.Rotation.fromAngleAxis(options.labrotation,options.degrees) # lab frame rotation # --- loop over input files ------------------------------------------------------------------------ @@ -153,13 +153,13 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': - o = damask.Rotation.fromEulers(np.array(list(map(float,table.data[column:column+3]))),options.degrees) + o = damask.Rotation.fromEulers(list(map(float,table.data[column:column+3])),options.degrees) elif inputtype == 'rodrigues': - o = damask.Rotation.fromRodrigues(np.array(list(map(float,table.data[column:column+3])))) + o = damask.Rotation.fromRodrigues(list(map(float,table.data[column:column+3]))) elif inputtype == 'matrix': - o = damask.Rotation.fromMatrix(np.array(list(map(float,table.data[column:column+9]))).reshape(3,3)) + o = damask.Rotation.fromMatrix(list(map(float,table.data[column:column+9])).reshape(3,3)) elif inputtype == 'frame': M = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ @@ -168,7 +168,7 @@ for name in filenames: o = damask.Rotation.fromMatrix(M/np.linalg.norm(M,axis=0)) elif inputtype == 'quaternion': - o = damask.Rotation.fromQuaternion(np.array(list(map(float,table.data[column:column+4])))) + o = damask.Rotation.fromQuaternion(list(map(float,table.data[column:column+4]))) o= r*o*R # apply additional lab and crystal frame rotations diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 3712b8c73..293f0f0b8 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -1,7 +1,7 @@ #!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- -import os,sys,math +import os,sys import numpy as np from optparse import OptionParser import damask @@ -29,9 +29,9 @@ parser.add_option('-r', '--rotation', parser.add_option('--degrees', dest = 'degrees', action = 'store_true', - help = 'angles are given in degrees [%default]') + help = 'angle is given in degrees [%default]') -parser.set_defaults(rotation = (0.,1.,1.,1.), # no rotation about 1,1,1 +parser.set_defaults(rotation = (0.,1.,0.,0.), # no rotation about 1,0,0 degrees = False, ) @@ -40,7 +40,7 @@ parser.set_defaults(rotation = (0.,1.,1.,1.), if options.data is None: parser.error('no data column specified.') -r = damask.Rotation.fromAngleAxis(options.rotation,degrees) +r = damask.Rotation.fromAngleAxis(options.rotation,options.degrees,normalise=True) # --- loop over input files ------------------------------------------------------------------------- diff --git a/processing/pre/geom_addPrimitive.py b/processing/pre/geom_addPrimitive.py index f93cdd54f..e0d1094cf 100755 --- a/processing/pre/geom_addPrimitive.py +++ b/processing/pre/geom_addPrimitive.py @@ -63,9 +63,9 @@ parser.set_defaults(center = (.0,.0,.0), if options.dimension is None: parser.error('no dimension specified.') if options.angleaxis is not None: - rotation = damask.Rotation.fromAngleAxis(np.array(options.angleaxis),options.degrees,normalise=True) + rotation = damask.Rotation.fromAngleAxis(options.angleaxis,options.degrees,normalise=True) elif options.quaternion is not None: - rotation = damask.Rotation.fromQuaternion(np.array(options.quaternion)) + rotation = damask.Rotation.fromQuaternion(options.quaternion) else: rotation = damask.Rotation() diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 54482332b..e53915b13 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -236,7 +236,12 @@ class Rotation: __slots__ = ['quaternion'] def __init__(self,quaternion = np.array([1.0,0.0,0.0,0.0])): - """Initializes to identity unless specified""" + """ + Initializes to identity unless specified + + If a quaternion is given, it needs to comply with the convection. Use .fromQuaternion + to check the input. + """ self.quaternion = Quaternion2(q=quaternion[0],p=quaternion[1:4]) self.quaternion.homomorph() # ToDo: Needed? @@ -247,7 +252,9 @@ class Rotation: 'Matrix:\n{}'.format( '\n'.join(['\t'.join(list(map(str,self.asMatrix()[i,:]))) for i in range(3)]) ), 'Bunge Eulers / deg: {}'.format('\t'.join(list(map(str,self.asEulers(degrees=True)))) ), ]) - + + ################################################################################################ + # convert to different orientation representations (numpy arrays) def asQuaternion(self): return self.quaternion.asArray() @@ -276,14 +283,16 @@ class Rotation: def asCubochoric(self): return qu2cu(self.quaternion.asArray()) - - + + ################################################################################################ + # static constructors. The input data needs to follow the convention, options allow to + # relax these convections @classmethod def fromQuaternion(cls, - quaternion, - P = -1): + quaternion, + P = -1): - qu = quaternion + qu = quaternion if isinstance(quaternion, np.ndarray) else np.array(quaternion) if P > 0: qu[1:4] *= -1 # convert from P=1 to P=-1 if qu[0] < 0.0: raise ValueError('Quaternion has negative first component.\n{}'.format(qu[0])) @@ -296,8 +305,9 @@ class Rotation: def fromEulers(cls, eulers, degrees = False): - - eu = np.radians(eulers) if degrees else eulers + + eu = eulers if isinstance(eulers, np.ndarray) else np.array(eulers) + eu = np.radians(eu) if degrees else eu if np.any(eu < 0.0) or np.any(eu > 2.0*np.pi) or eu[1] > np.pi: raise ValueError('Euler angles outside of [0..2π],[0..π],[0..2π].\n{} {} {}.'.format(*eu)) @@ -309,8 +319,8 @@ class Rotation: degrees = False, normalise = False, P = -1): - - ax = angleAxis + + ax = angleAxis if isinstance(angleAxis, np.ndarray) else np.array(angleAxis) if P > 0: ax[1:4] *= -1 # convert from P=1 to P=-1 if degrees: ax[0] = np.degrees(ax[0]) if normalise: ax[1:4] /=np.linalg.norm(ax[1:4]) @@ -323,9 +333,13 @@ class Rotation: @classmethod def fromMatrix(cls, - matrix): + matrix, + containsStretch = False): #ToDo: better name? - om = matrix + om = matrix if isinstance(matrix, np.ndarray) else np.array(matrix) + if containsStretch: + (U,S,Vh) = np.linalg.svd(om) # singular value decomposition + om = np.dot(U,Vh) if not np.isclose(np.linalg.det(om),1.0): raise ValueError('matrix is not a proper rotation.\n{}'.format(om)) if not np.isclose(np.dot(om[0],om[1]), 0.0) \ @@ -341,7 +355,7 @@ class Rotation: normalise = False, P = -1): - ro = rodrigues + ro = rodrigues if isinstance(rodrigues, np.ndarray) else np.array(rodrigues) if P > 0: ro[1:4] *= -1 # convert from P=1 to P=-1 if normalise: ro[1:4] /=np.linalg.norm(ro[1:4]) if not np.isclose(np.linalg.norm(ro[1:4]), 1.0): @@ -356,7 +370,7 @@ class Rotation: """ Multiplication - Rotation: Details needed (active/passive), more cases (3,3), (3,3,3,3) need to be considered + Rotation: Details needed (active/passive), more rotation of (3,3,3,3) should be considered """ if isinstance(other, Rotation): # rotate a rotation return self.__class__((self.quaternion * other.quaternion).asArray()) From 336a80091fc4fd6fc6fa5857541429a49a4aa79d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 08:58:23 +0100 Subject: [PATCH 164/309] rodrigues is 4-vector with rotation being the last component established a single source of truth for length --- processing/post/addOrientations.py | 42 ++++++++++++++++-------------- python/damask/orientation.py | 14 +++++----- 2 files changed, 30 insertions(+), 26 deletions(-) diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index 65444bcb9..8353e0403 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -21,19 +21,19 @@ Additional (globally fixed) rotations of the lab frame and/or crystal frame can """, version = scriptID) -outputChoices = { - 'quaternion': ['quat',4], - 'rodrigues': ['rodr',3], +representations = { + 'quaternion': ['quat',4], #ToDo: Use here Rowenhorst names (qu/ro/om/ax?) + 'rodrigues': ['rodr',4], 'eulers': ['eulr',3], 'matrix': ['mtrx',9], 'angleaxis': ['aaxs',4], - } + } parser.add_option('-o', '--output', dest = 'output', action = 'extend', metavar = '', - help = 'output orientation formats {{{}}}'.format(', '.join(outputChoices))) + help = 'output orientation formats {{{}}}'.format(', '.join(representations))) parser.add_option('-d', '--degrees', dest = 'degrees', @@ -87,8 +87,8 @@ parser.set_defaults(output = [], (options, filenames) = parser.parse_args() options.output = list(map(lambda x: x.lower(), options.output)) -if options.output == [] or (not set(options.output).issubset(set(outputChoices))): - parser.error('output must be chosen from {}.'.format(', '.join(outputChoices))) +if options.output == [] or (not set(options.output).issubset(set(representations))): + parser.error('output must be chosen from {}.'.format(', '.join(representations))) input = [options.eulers is not None, options.rodrigues is not None, @@ -101,11 +101,11 @@ input = [options.eulers is not None, if np.sum(input) != 1: parser.error('needs exactly one input format.') -(label,dim,inputtype) = [(options.eulers,3,'eulers'), - (options.rodrigues,3,'rodrigues'), +(label,dim,inputtype) = [(options.eulers,representations['eulers'][1],'eulers'), + (options.rodrigues,representations['rodrigues'][1],'rodrigues'), ([options.x,options.y,options.z],[3,3,3],'frame'), - (options.matrix,9,'matrix'), - (options.quaternion,4,'quaternion'), + (options.matrix,representations['matrix'][1],'matrix'), + (options.quaternion,representations['quaternion'][1],'quaternion'), ][np.where(input)[0][0]] # select input label that was requested r = damask.Rotation.fromAngleAxis(options.crystalrotation,options.degrees) # crystal frame rotation @@ -143,9 +143,9 @@ for name in filenames: table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) for output in options.output: - if output in outputChoices: - table.labels_append(['{}_{}({})'.format(i+1,outputChoices[output][0],label) \ - for i in range(outputChoices[output][1])]) + if output in representations: + table.labels_append(['{}_{}({})'.format(i+1,representations[output][0],label) \ + for i in range(representations[output][1])]) table.head_write() # ------------------------------------------ process data ------------------------------------------ @@ -153,13 +153,16 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': - o = damask.Rotation.fromEulers(list(map(float,table.data[column:column+3])),options.degrees) + l = representations['eulers'][1] + o = damask.Rotation.fromEulers(list(map(float,table.data[column:column+l])),options.degrees) elif inputtype == 'rodrigues': - o = damask.Rotation.fromRodrigues(list(map(float,table.data[column:column+3]))) + l = representations['rodrigues'][1] + o = damask.Rotation.fromRodrigues(list(map(float,table.data[column:column+l]))) elif inputtype == 'matrix': - o = damask.Rotation.fromMatrix(list(map(float,table.data[column:column+9])).reshape(3,3)) + l = representations['matrix'][1] + o = damask.Rotation.fromMatrix(list(map(float,table.data[column:column+l]))) elif inputtype == 'frame': M = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ @@ -168,7 +171,8 @@ for name in filenames: o = damask.Rotation.fromMatrix(M/np.linalg.norm(M,axis=0)) elif inputtype == 'quaternion': - o = damask.Rotation.fromQuaternion(list(map(float,table.data[column:column+4]))) + l = representations['quaternion'][1] + o = damask.Rotation.fromQuaternion(list(map(float,table.data[column:column+l]))) o= r*o*R # apply additional lab and crystal frame rotations @@ -177,7 +181,7 @@ for name in filenames: elif output == 'rodrigues': table.data_append(o.asRodrigues()) elif output == 'eulers': table.data_append(o.asEulers(degrees=options.degrees)) elif output == 'matrix': table.data_append(o.asMatrix()) - elif output == 'angleaxis': table.data_append(o.asAngleAxis(degrees=options.degrees,flat=True)) + elif output == 'angleaxis': table.data_append(o.asAngleAxis(degrees=options.degrees)) outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- diff --git a/python/damask/orientation.py b/python/damask/orientation.py index e53915b13..6f1b12671 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -336,7 +336,7 @@ class Rotation: matrix, containsStretch = False): #ToDo: better name? - om = matrix if isinstance(matrix, np.ndarray) else np.array(matrix) + om = matrix if isinstance(matrix, np.ndarray) else np.array(matrix).reshape((3,3)) # ToDo: Reshape here or require explicit? if containsStretch: (U,S,Vh) = np.linalg.svd(om) # singular value decomposition om = np.dot(U,Vh) @@ -356,12 +356,12 @@ class Rotation: P = -1): ro = rodrigues if isinstance(rodrigues, np.ndarray) else np.array(rodrigues) - if P > 0: ro[1:4] *= -1 # convert from P=1 to P=-1 - if normalise: ro[1:4] /=np.linalg.norm(ro[1:4]) - if not np.isclose(np.linalg.norm(ro[1:4]), 1.0): - raise ValueError('Rodrigues rotation axis is not of unit length.\n{} {} {}'.format(*ro[1:4])) - if ro[0] < 0.0: - raise ValueError('Rodriques rotation angle not positive.\n'.format(ro[0])) + if P > 0: ro[0:3] *= -1 # convert from P=1 to P=-1 + if normalise: ro[0:3] /=np.linalg.norm(ro[0:3]) + if not np.isclose(np.linalg.norm(ro[0:3]), 1.0): + raise ValueError('Rodrigues rotation axis is not of unit length.\n{} {} {}'.format(*ro[0:3])) + if ro[3] < 0.0: + raise ValueError('Rodriques rotation angle not positive.\n'.format(ro[3])) return cls(ro2qu(ro)) From 7da8980cc04ed0e5e641cd1feebff4c5c8188b1f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 09:04:35 +0100 Subject: [PATCH 165/309] bugfixes: wrong shape, wrong conversion --- processing/post/addSchmidfactors.py | 6 +++--- processing/post/rotateData.py | 2 +- python/damask/orientation.py | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/processing/post/addSchmidfactors.py b/processing/post/addSchmidfactors.py index 6335b419e..37dd56512 100755 --- a/processing/post/addSchmidfactors.py +++ b/processing/post/addSchmidfactors.py @@ -212,10 +212,10 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4])))) + o = damask.Rotation(list(map(float,table.data[column:column+4]))) - table.data_append( np.abs( np.sum(slip_direction * (o.quaternion * force) ,axis=1) \ - * np.sum(slip_normal * (o.quaternion * normal),axis=1))) + table.data_append( np.abs( np.sum(slip_direction * (o * force) ,axis=1) \ + * np.sum(slip_normal * (o * normal),axis=1))) outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 293f0f0b8..1aafe7eb9 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -91,7 +91,7 @@ for name in filenames: table.data[column:column+3] = r * np.array(list(map(float,table.data[column:column+3]))) for t in active['tensor']: column = table.label_index(t) - table.data[column:column+9] = (r * (np.array(list(map(float,table.data[column:column+9]))))).reshape((3,3)) + table.data[column:column+9] = (r * np.array(list(map(float,table.data[column:column+9]))).reshape((3,3))).reshape(9) outputAlive = table.data_write() # output processed line diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 6f1b12671..85f3fb173 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -322,7 +322,7 @@ class Rotation: ax = angleAxis if isinstance(angleAxis, np.ndarray) else np.array(angleAxis) if P > 0: ax[1:4] *= -1 # convert from P=1 to P=-1 - if degrees: ax[0] = np.degrees(ax[0]) + if degrees: ax[0] = np.radians(ax[0]) if normalise: ax[1:4] /=np.linalg.norm(ax[1:4]) if ax[0] < 0.0 or ax[0] > np.pi: raise ValueError('Axis angle rotation angle outside of [0..π].\n'.format(ax[0])) From 608852df839498244e3591ef9170d260f2948b95 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 10:53:28 +0100 Subject: [PATCH 166/309] rotation paper has angle as last component --- processing/post/addOrientations.py | 7 +++++-- processing/post/rotateData.py | 3 ++- processing/pre/geom_addPrimitive.py | 3 ++- python/damask/orientation.py | 16 ++++++++-------- 4 files changed, 17 insertions(+), 12 deletions(-) diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index 8353e0403..c25bfed39 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -108,8 +108,11 @@ if np.sum(input) != 1: parser.error('needs exactly one input format.') (options.quaternion,representations['quaternion'][1],'quaternion'), ][np.where(input)[0][0]] # select input label that was requested -r = damask.Rotation.fromAngleAxis(options.crystalrotation,options.degrees) # crystal frame rotation -R = damask.Rotation.fromAngleAxis(options.labrotation,options.degrees) # lab frame rotation +crystalrotation = np.array(options.crystalrotation[1:4] + (options.crystalrotation[0],)) # Compatibility hack +labrotation = np.array(options.labrotation[1:4], + (options.labrotation[0],)) # Compatibility hack +r = damask.Rotation.fromAngleAxis(crystalrotation,options.degrees) # crystal frame rotation +R = damask.Rotation.fromAngleAxis(labrotation,options.degrees) # lab frame rotation + # --- loop over input files ------------------------------------------------------------------------ diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 1aafe7eb9..5be38f1e8 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -40,7 +40,8 @@ parser.set_defaults(rotation = (0.,1.,0.,0.), if options.data is None: parser.error('no data column specified.') -r = damask.Rotation.fromAngleAxis(options.rotation,options.degrees,normalise=True) +rotation = np.array(options.rotation[1:4]+(options.rotation[0],)) # Compatibility hack +r = damask.Rotation.fromAngleAxis(rotation,options.degrees,normalise=True) # --- loop over input files ------------------------------------------------------------------------- diff --git a/processing/pre/geom_addPrimitive.py b/processing/pre/geom_addPrimitive.py index e0d1094cf..8e512c44d 100755 --- a/processing/pre/geom_addPrimitive.py +++ b/processing/pre/geom_addPrimitive.py @@ -63,7 +63,8 @@ parser.set_defaults(center = (.0,.0,.0), if options.dimension is None: parser.error('no dimension specified.') if options.angleaxis is not None: - rotation = damask.Rotation.fromAngleAxis(options.angleaxis,options.degrees,normalise=True) + ax = np.array(options.angleaxis[1:4] + (options.angleaxis[0],)) # Compatibility hack + rotation = damask.Rotation.fromAngleAxis(ax,options.degrees,normalise=True) elif options.quaternion is not None: rotation = damask.Rotation.fromQuaternion(options.quaternion) else: diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 85f3fb173..442a98f6e 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -267,7 +267,7 @@ class Rotation: degrees = False): ax = qu2ax(self.quaternion.asArray()) - if degrees: ax[0] = np.degrees(ax[0]) + if degrees: ax[3] = np.degrees(ax[3]) return ax @@ -321,13 +321,13 @@ class Rotation: P = -1): ax = angleAxis if isinstance(angleAxis, np.ndarray) else np.array(angleAxis) - if P > 0: ax[1:4] *= -1 # convert from P=1 to P=-1 - if degrees: ax[0] = np.radians(ax[0]) - if normalise: ax[1:4] /=np.linalg.norm(ax[1:4]) - if ax[0] < 0.0 or ax[0] > np.pi: - raise ValueError('Axis angle rotation angle outside of [0..π].\n'.format(ax[0])) - if not np.isclose(np.linalg.norm(ax[1:4]), 1.0): - raise ValueError('Axis angle rotation axis is not of unit length.\n{} {} {}'.format(*ax[1:4])) + if P > 0: ax[0:3] *= -1 # convert from P=1 to P=-1 + if degrees: ax[3] = np.radians(ax[3]) + if normalise: ax[0:3] /=np.linalg.norm(ax[0:3]) + if ax[3] < 0.0 or ax[3] > np.pi: + raise ValueError('Axis angle rotation angle outside of [0..π].\n'.format(ax[3])) + if not np.isclose(np.linalg.norm(ax[0:3]), 1.0): + raise ValueError('Axis angle rotation axis is not of unit length.\n{} {} {}'.format(*ax[0:3])) return cls(ax2qu(ax)) From 217024667b65c86d1063537350f1b7e41398b879 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 11:30:43 +0100 Subject: [PATCH 167/309] forgotten comma --- processing/post/addOrientations.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index c25bfed39..c9db1cbd7 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -109,7 +109,7 @@ if np.sum(input) != 1: parser.error('needs exactly one input format.') ][np.where(input)[0][0]] # select input label that was requested crystalrotation = np.array(options.crystalrotation[1:4] + (options.crystalrotation[0],)) # Compatibility hack -labrotation = np.array(options.labrotation[1:4], + (options.labrotation[0],)) # Compatibility hack +labrotation = np.array(options.labrotation[1:4] + (options.labrotation[0],)) # Compatibility hack r = damask.Rotation.fromAngleAxis(crystalrotation,options.degrees) # crystal frame rotation R = damask.Rotation.fromAngleAxis(labrotation,options.degrees) # lab frame rotation From 69d53ed869d55531f4cd2ef4b6b01104196529e8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 23:20:24 +0100 Subject: [PATCH 168/309] determining output size was overly complicated general cleaning --- src/thermal_adiabatic.f90 | 61 ++++++++++++-------------------------- src/thermal_conduction.f90 | 30 +++---------------- 2 files changed, 23 insertions(+), 68 deletions(-) diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index e0ad3214f..937c20275 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -69,7 +69,7 @@ subroutine thermal_adiabatic_init config_homogenization implicit none - integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o,i + integer(pInt) :: maxNinstance,section,instance,i integer(pInt) :: sizeState integer(pInt) :: NofMyHomog character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -100,36 +100,24 @@ subroutine thermal_adiabatic_init thermal_adiabatic_Noutput(instance) = thermal_adiabatic_Noutput(instance) + 1_pInt thermal_adiabatic_outputID(thermal_adiabatic_Noutput(instance),instance) = temperature_ID thermal_adiabatic_output(thermal_adiabatic_Noutput(instance),instance) = outputs(i) + thermal_adiabatic_sizePostResult(thermal_adiabatic_Noutput(instance),instance) = 1_pInt end select enddo -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,thermal_adiabatic_Noutput(instance) - select case(thermal_adiabatic_outputID(o,instance)) - case(temperature_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - thermal_adiabatic_sizePostResult(o,instance) = mySize - endif - enddo outputsLoop - ! allocate state arrays - sizeState = 1_pInt - thermalState(section)%sizeState = sizeState - thermalState(section)%sizePostResults = sum(thermal_adiabatic_sizePostResult(:,instance)) - allocate(thermalState(section)%state0 (sizeState,NofMyHomog), source=thermal_initialT(section)) - allocate(thermalState(section)%subState0(sizeState,NofMyHomog), source=thermal_initialT(section)) - allocate(thermalState(section)%state (sizeState,NofMyHomog), source=thermal_initialT(section)) + sizeState = 1_pInt + thermalState(section)%sizeState = sizeState + thermalState(section)%sizePostResults = sum(thermal_adiabatic_sizePostResult(:,instance)) + allocate(thermalState(section)%state0 (sizeState,NofMyHomog), source=thermal_initialT(section)) + allocate(thermalState(section)%subState0(sizeState,NofMyHomog), source=thermal_initialT(section)) + allocate(thermalState(section)%state (sizeState,NofMyHomog), source=thermal_initialT(section)) - nullify(thermalMapping(section)%p) - thermalMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(temperature(section)%p) - temperature(section)%p => thermalState(section)%state(1,:) - deallocate(temperatureRate(section)%p) - allocate (temperatureRate(section)%p(NofMyHomog), source=0.0_pReal) + nullify(thermalMapping(section)%p) + thermalMapping(section)%p => mappingHomogenization(1,:,:) + deallocate(temperature(section)%p) + temperature(section)%p => thermalState(section)%state(1,:) + deallocate(temperatureRate(section)%p) + allocate (temperatureRate(section)%p(NofMyHomog), source=0.0_pReal) enddo initializeInstances @@ -186,8 +174,6 @@ end function thermal_adiabatic_updateState !> @brief returns heat generation rate !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - use math, only: & - math_Mandel6to33 use material, only: & homogenization_Ngrains, & mappingHomogenization, & @@ -219,14 +205,12 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) integer(pInt) :: & phase, & homog, & - offset, & instance, & grain, & source, & constituent homog = mappingHomogenization(2,ip,el) - offset = mappingHomogenization(1,ip,el) instance = thermal_typeInstance(homog) Tdot = 0.0_pReal @@ -268,12 +252,9 @@ function thermal_adiabatic_getSpecificHeat(ip,el) lattice_specificHeat use material, only: & homogenization_Ngrains, & - mappingHomogenization, & material_phase use mesh, only: & mesh_element - use crystallite, only: & - crystallite_push33ToRef implicit none integer(pInt), intent(in) :: & @@ -282,11 +263,10 @@ function thermal_adiabatic_getSpecificHeat(ip,el) real(pReal) :: & thermal_adiabatic_getSpecificHeat integer(pInt) :: & - homog, grain + grain thermal_adiabatic_getSpecificHeat = 0.0_pReal - homog = mappingHomogenization(2,ip,el) do grain = 1, homogenization_Ngrains(mesh_element(3,el)) thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat + & @@ -311,9 +291,7 @@ function thermal_adiabatic_getMassDensity(ip,el) material_phase use mesh, only: & mesh_element - use crystallite, only: & - crystallite_push33ToRef - + implicit none integer(pInt), intent(in) :: & ip, & !< integration point number @@ -321,11 +299,10 @@ function thermal_adiabatic_getMassDensity(ip,el) real(pReal) :: & thermal_adiabatic_getMassDensity integer(pInt) :: & - homog, grain + grain thermal_adiabatic_getMassDensity = 0.0_pReal - - homog = mappingHomogenization(2,ip,el) + do grain = 1, homogenization_Ngrains(mesh_element(3,el)) thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity + & @@ -346,7 +323,7 @@ function thermal_adiabatic_postResults(homog,instance,of) result(postResults) temperature implicit none - integer(pInt), intent(in) :: & + integer(pInt), intent(in) :: & homog, & instance, & of diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 067871c59..ab1b030c8 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -70,7 +70,7 @@ subroutine thermal_conduction_init config_homogenization implicit none - integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o,i + integer(pInt) :: maxNinstance,section,instance,i integer(pInt) :: sizeState integer(pInt) :: NofMyHomog character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -101,21 +101,10 @@ subroutine thermal_conduction_init thermal_conduction_Noutput(instance) = thermal_conduction_Noutput(instance) + 1_pInt thermal_conduction_outputID(thermal_conduction_Noutput(instance),instance) = temperature_ID thermal_conduction_output(thermal_conduction_Noutput(instance),instance) = outputs(i) + thermal_conduction_sizePostResult(thermal_conduction_Noutput(instance),instance) = 1_pInt end select enddo -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,thermal_conduction_Noutput(instance) - select case(thermal_conduction_outputID(o,instance)) - case(temperature_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - thermal_conduction_sizePostResult(o,instance) = mySize - endif - enddo outputsLoop ! allocate state arrays sizeState = 0_pInt @@ -224,7 +213,6 @@ function thermal_conduction_getConductivity33(ip,el) lattice_thermalConductivity33 use material, only: & homogenization_Ngrains, & - mappingHomogenization, & material_phase use mesh, only: & mesh_element @@ -238,10 +226,8 @@ function thermal_conduction_getConductivity33(ip,el) real(pReal), dimension(3,3) :: & thermal_conduction_getConductivity33 integer(pInt) :: & - homog, & grain - homog = mappingHomogenization(2,ip,el) thermal_conduction_getConductivity33 = 0.0_pReal do grain = 1, homogenization_Ngrains(mesh_element(3,el)) @@ -263,12 +249,9 @@ function thermal_conduction_getSpecificHeat(ip,el) lattice_specificHeat use material, only: & homogenization_Ngrains, & - mappingHomogenization, & material_phase use mesh, only: & mesh_element - use crystallite, only: & - crystallite_push33ToRef implicit none integer(pInt), intent(in) :: & @@ -277,11 +260,10 @@ function thermal_conduction_getSpecificHeat(ip,el) real(pReal) :: & thermal_conduction_getSpecificHeat integer(pInt) :: & - homog, grain + grain thermal_conduction_getSpecificHeat = 0.0_pReal - homog = mappingHomogenization(2,ip,el) do grain = 1, homogenization_Ngrains(mesh_element(3,el)) thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat + & @@ -301,12 +283,9 @@ function thermal_conduction_getMassDensity(ip,el) lattice_massDensity use material, only: & homogenization_Ngrains, & - mappingHomogenization, & material_phase use mesh, only: & mesh_element - use crystallite, only: & - crystallite_push33ToRef implicit none integer(pInt), intent(in) :: & @@ -315,11 +294,10 @@ function thermal_conduction_getMassDensity(ip,el) real(pReal) :: & thermal_conduction_getMassDensity integer(pInt) :: & - homog, grain + grain thermal_conduction_getMassDensity = 0.0_pReal - homog = mappingHomogenization(2,ip,el) do grain = 1, homogenization_Ngrains(mesh_element(3,el)) thermal_conduction_getMassDensity = thermal_conduction_getMassDensity & From c9fc7ea982ee776789b74c94b3f1fd60b636b665 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 23:35:22 +0100 Subject: [PATCH 169/309] cleaning trying to find logic with less dependencies on the various mappings --- src/constitutive.f90 | 15 ++++++++--- src/kinematics_thermal_expansion.f90 | 40 +++++++++++++--------------- 2 files changed, 31 insertions(+), 24 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 1449c35e9..5dc59c2c3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -649,6 +649,9 @@ pure function constitutive_initialFi(ipc, ip, el) math_inv33, & math_mul33x33 use material, only: & + material_phase, & + material_homog, & + thermalMapping, & phase_kinematics, & phase_Nkinematics, & material_phase, & @@ -665,14 +668,20 @@ pure function constitutive_initialFi(ipc, ip, el) constitutive_initialFi !< composite initial intermediate deformation gradient integer(pInt) :: & k !< counter in kinematics loop + integer(pInt) :: & + phase, & + homog, offset constitutive_initialFi = math_I3 + phase = material_phase(ipc,ip,el) - KinematicsLoop: do k = 1_pInt, phase_Nkinematics(material_phase(ipc,ip,el)) !< Warning: small initial strain assumption - kinematicsType: select case (phase_kinematics(k,material_phase(ipc,ip,el))) + KinematicsLoop: do k = 1_pInt, phase_Nkinematics(phase) !< Warning: small initial strain assumption + kinematicsType: select case (phase_kinematics(k,phase)) case (KINEMATICS_thermal_expansion_ID) kinematicsType + homog = material_homog(ip,el) + offset = thermalMapping(homog)%p(ip,el) constitutive_initialFi = & - constitutive_initialFi + kinematics_thermal_expansion_initialStrain(ipc, ip, el) + constitutive_initialFi + kinematics_thermal_expansion_initialStrain(homog,phase,offset) end select kinematicsType enddo KinematicsLoop diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index e8f0d71c7..a44bc6902 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -10,7 +10,11 @@ module kinematics_thermal_expansion implicit none private - + + !type, private :: tParameters + ! real(pReal), allocatable, dimension(:) :: & + !end type tParameters + public :: & kinematics_thermal_expansion_init, & kinematics_thermal_expansion_initialStrain, & @@ -43,49 +47,43 @@ subroutine kinematics_thermal_expansion_init() config_phase implicit none - integer(pInt) maxNinstance + integer(pInt) :: & + Ninstance, & + p write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance -! ToDo: this subroutine should read in lattice_thermal_expansion. No need to make it a global array + do p = 1_pInt, size(phase_kinematics) + if (all(phase_kinematics(:,p) /= KINEMATICS_thermal_expansion_ID)) cycle + enddo end subroutine kinematics_thermal_expansion_init !-------------------------------------------------------------------------------------------------- !> @brief report initial thermal strain based on current temperature deviation from reference !-------------------------------------------------------------------------------------------------- -pure function kinematics_thermal_expansion_initialStrain(ipc, ip, el) +pure function kinematics_thermal_expansion_initialStrain(homog,phase,offset) use material, only: & - material_phase, & - material_homog, & - temperature, & - thermalMapping + temperature use lattice, only: & lattice_thermalExpansion33, & lattice_referenceTemperature implicit none integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - kinematics_thermal_expansion_initialStrain !< initial thermal strain (should be small strain, though) - integer(pInt) :: & phase, & homog, offset - - phase = material_phase(ipc,ip,el) - homog = material_homog(ip,el) - offset = thermalMapping(homog)%p(ip,el) + real(pReal), dimension(3,3) :: & + kinematics_thermal_expansion_initialStrain !< initial thermal strain (should be small strain, though) + kinematics_thermal_expansion_initialStrain = & (temperature(homog)%p(offset) - lattice_referenceTemperature(phase))**1 / 1. * & From 55cef533f1cba72a540a663bd6da838f0123db16 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Feb 2019 23:56:04 +0100 Subject: [PATCH 170/309] conversion 3x3-matrix <-> 6-vector not helpful --- src/constitutive.f90 | 6 +++--- src/kinematics_cleavage_opening.f90 | 19 ++++++++++--------- src/kinematics_slipplane_opening.f90 | 26 ++++++++++---------------- src/lattice.f90 | 11 +---------- src/source_damage_anisoBrittle.f90 | 16 +++++++++------- 5 files changed, 33 insertions(+), 45 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6c096ecd0..ef6004109 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -611,9 +611,9 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e KinematicsLoop: do k = 1_pInt, phase_Nkinematics(material_phase(ipc,ip,el)) kinematicsType: select case (phase_kinematics(k,material_phase(ipc,ip,el))) case (KINEMATICS_cleavage_opening_ID) kinematicsType - call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el) + call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6), ipc, ip, el) case (KINEMATICS_slipplane_opening_ID) kinematicsType - call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el) + call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6), ipc, ip, el) case (KINEMATICS_thermal_expansion_ID) kinematicsType call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el) case default kinematicsType @@ -901,7 +901,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac sourceType: select case (phase_source(s,material_phase(ipc,ip,el))) case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState (S6, ipc, ip, el) !< correct stress? + call source_damage_anisoBrittle_dotState (math_6toSym33(S6), ipc, ip, el) !< correct stress? case (SOURCE_damage_isoDuctile_ID) sourceType call source_damage_isoDuctile_dotState ( ipc, ip, el) diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 89d9dcd68..89c2f6ff0 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -113,10 +113,10 @@ subroutine kinematics_cleavage_opening_init() tempInt = config_phase(p)%getInts('ncleavage') kinematics_cleavage_opening_Ncleavage(1:size(tempInt),instance) = tempInt - tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredShape=shape(tempInt)) + tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(tempInt)) kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) = tempFloat - tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredShape=shape(tempInt)) + tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredSize=size(tempInt)) kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) = tempFloat kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & @@ -138,9 +138,11 @@ end subroutine kinematics_cleavage_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, ip, el) +subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) use prec, only: & tol_math_check + use math, only: & + math_mul33xx33 use material, only: & material_phase, & material_homog, & @@ -148,7 +150,6 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, damageMapping use lattice, only: & lattice_Scleavage, & - lattice_Scleavage_v, & lattice_maxNcleavageFamily, & lattice_NcleavageSystem @@ -157,8 +158,8 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, & !< grain number ip, & !< integration point number el !< element number - real(pReal), intent(in), dimension(6) :: & - Tstar_v !< 2nd Piola-Kirchhoff stress + real(pReal), intent(in), dimension(3,3) :: & + S real(pReal), intent(out), dimension(3,3) :: & Ld !< damage velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & @@ -181,9 +182,9 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, do f = 1_pInt,lattice_maxNcleavageFamily index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family - traction_d = dot_product(Tstar_v,lattice_Scleavage_v(1:6,1,index_myFamily+i,phase)) - traction_t = dot_product(Tstar_v,lattice_Scleavage_v(1:6,2,index_myFamily+i,phase)) - traction_n = dot_product(Tstar_v,lattice_Scleavage_v(1:6,3,index_myFamily+i,phase)) + traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) + traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) + traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) traction_crit = kinematics_cleavage_opening_critLoad(f,instance)* & damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) udotd = & diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 573fe7d78..33714d573 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -113,10 +113,10 @@ subroutine kinematics_slipplane_opening_init() tempInt = config_phase(p)%getInts('ncleavage') kinematics_slipplane_opening_Nslip(1:size(tempInt),instance) = tempInt - tempFloat = config_phase(p)%getFloats('anisoductile_criticalplasticstrain',requiredShape=shape(tempInt)) + tempFloat = config_phase(p)%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(tempInt)) kinematics_slipplane_opening_critPlasticStrain(1:size(tempInt),instance) = tempFloat - tempFloat = config_phase(p)%getFloats('anisoductile_criticalload',requiredShape=shape(tempInt)) + tempFloat = config_phase(p)%getFloats('anisoductile_criticalload',requiredSize=size(tempInt)) kinematics_slipplane_opening_critLoad(1:size(tempInt),instance) = tempFloat kinematics_slipplane_opening_Nslip(1:lattice_maxNslipFamily,instance) = & @@ -136,9 +136,11 @@ end subroutine kinematics_slipplane_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, ip, el) +subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) use prec, only: & tol_math_check + use math, only: & + math_mul33xx33 use lattice, only: & lattice_maxNslipFamily, & lattice_NslipSystem, & @@ -151,9 +153,6 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, damage, & damageMapping use math, only: & - math_Plain3333to99, & - math_symmetric33, & - math_Mandel33to6, & math_tensorproduct33 implicit none @@ -161,16 +160,14 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, ipc, & !< grain number ip, & !< integration point number el !< element number - real(pReal), intent(in), dimension(6) :: & - Tstar_v !< 2nd Piola-Kirchhoff stress + real(pReal), intent(in), dimension(3,3) :: & + S real(pReal), intent(out), dimension(3,3) :: & Ld !< damage velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) real(pReal), dimension(3,3) :: & projection_d, projection_t, projection_n !< projection modes 3x3 tensor - real(pReal), dimension(6) :: & - projection_d_v, projection_t_v, projection_n_v !< projection modes 3x3 vector integer(pInt) :: & instance, phase, & homog, damageOffset, & @@ -196,13 +193,10 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, Tstar_v, projection_n = math_tensorproduct33(lattice_sn(1:3,index_myFamily+i,phase),& lattice_sn(1:3,index_myFamily+i,phase)) - projection_d_v(1:6) = math_Mandel33to6(math_symmetric33(projection_d(1:3,1:3))) - projection_t_v(1:6) = math_Mandel33to6(math_symmetric33(projection_t(1:3,1:3))) - projection_n_v(1:6) = math_Mandel33to6(math_symmetric33(projection_n(1:3,1:3))) - traction_d = dot_product(Tstar_v,projection_d_v(1:6)) - traction_t = dot_product(Tstar_v,projection_t_v(1:6)) - traction_n = dot_product(Tstar_v,projection_n_v(1:6)) + traction_d = math_mul33xx33(S,projection_d) + traction_t = math_mul33xx33(S,projection_t) + traction_n = math_mul33xx33(S,projection_n) traction_crit = kinematics_slipplane_opening_critLoad(f,instance)* & damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage diff --git a/src/lattice.f90 b/src/lattice.f90 index 9be30a5d3..410c14628 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -31,8 +31,7 @@ module lattice lattice_Scleavage !< Schmid matrices for cleavage systems real(pReal), allocatable, dimension(:,:,:,:), protected, public :: & - lattice_Sslip_v, & !< Mandel notation of lattice_Sslip - lattice_Scleavage_v !< Mandel notation of lattice_Scleavege + lattice_Sslip_v !< Mandel notation of lattice_Sslip real(pReal), allocatable, dimension(:,:,:), protected, public :: & lattice_sn, & !< normal direction of slip system @@ -776,7 +775,6 @@ subroutine lattice_init allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt) ! other:me allocate(lattice_Scleavage(3,3,3,lattice_maxNslip,Nphases),source=0.0_pReal) - allocate(lattice_Scleavage_v(6,3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0_pInt) allocate(CoverA(Nphases),source=0.0_pReal) @@ -1060,13 +1058,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA) enddo enddo - do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure - do j = 1_pInt,3_pInt - lattice_Scleavage_v(1:6,j,i,myPhase) = & - math_sym33to6(math_symmetric33(lattice_Scleavage(1:3,1:3,j,i,myPhase))) - enddo - enddo - end subroutine lattice_initializeStructure diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index b8bd3246d..eabf43799 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -309,7 +309,9 @@ end subroutine source_damage_anisoBrittle_init !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el) +subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) + use math, only: & + math_mul33xx33 use material, only: & phaseAt, phasememberAt, & sourceState, & @@ -317,7 +319,7 @@ subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el) damage, & damageMapping use lattice, only: & - lattice_Scleavage_v, & + lattice_Scleavage, & lattice_maxNcleavageFamily, & lattice_NcleavageSystem @@ -326,8 +328,8 @@ subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), intent(in), dimension(6) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel) + real(pReal), intent(in), dimension(3,3) :: & + S integer(pInt) :: & phase, & constituent, & @@ -350,9 +352,9 @@ subroutine source_damage_anisoBrittle_dotState(Tstar_v, ipc, ip, el) do f = 1_pInt,lattice_maxNcleavageFamily index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family - traction_d = dot_product(Tstar_v,lattice_Scleavage_v(1:6,1,index_myFamily+i,phase)) - traction_t = dot_product(Tstar_v,lattice_Scleavage_v(1:6,2,index_myFamily+i,phase)) - traction_n = dot_product(Tstar_v,lattice_Scleavage_v(1:6,3,index_myFamily+i,phase)) + traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) + traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) + traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) traction_crit = source_damage_anisoBrittle_critLoad(f,instance)* & damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) From 9574dfae2d04957b655fd09172f7c40173efae20 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 06:28:29 +0100 Subject: [PATCH 171/309] avoiding repeated reading of material.config --- src/source_damage_anisoBrittle.f90 | 64 ++++++++++++++++++------------ src/source_damage_anisoDuctile.f90 | 55 ++++++++++++++----------- src/source_damage_isoBrittle.f90 | 54 ++++++++++++------------- src/source_damage_isoDuctile.f90 | 53 ++++++++++++------------- 4 files changed, 123 insertions(+), 103 deletions(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index eabf43799..fc2cade78 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -32,10 +32,7 @@ module source_damage_anisoBrittle source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family real(pReal), dimension(:), allocatable, private :: & - source_damage_anisoBrittle_aTol, & - source_damage_anisoBrittle_sdot_0, & - source_damage_anisoBrittle_N - + source_damage_anisoBrittle_sdot_0 real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_critDisp, & source_damage_anisoBrittle_critLoad @@ -85,6 +82,8 @@ subroutine source_damage_anisoBrittle_init(fileUnit) compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -127,10 +126,13 @@ subroutine source_damage_anisoBrittle_init(fileUnit) integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase,p - integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j + integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j + character(len=pStringLen) :: & + extmsg = '' character(len=65536) :: & tag = '', & line = '' + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoBrittle_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -163,12 +165,30 @@ subroutine source_damage_anisoBrittle_init(fileUnit) allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) allocate(source_damage_anisoBrittle_totalNcleavage(Ninstance), source=0_pInt) - allocate(source_damage_anisoBrittle_aTol(Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_sdot_0(Ninstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_N(Ninstance), source=0.0_pReal) + allocate(param(Ninstance)) + do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_damage_anisoBrittle_ID)) cycle + if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISOBRITTLE_ID)) cycle + associate(prm => param(source_damage_anisoBrittle_instance(p)), & + config => config_phase(p)) + + prm%aTol = config%getFloat('anisobrittle_atol',defaultVal = 1.0e-3_pReal) + + prm%N = config%getFloat('anisobrittle_ratesensitivity') + prm%sdot_0 = config%getFloat('anisobrittle_sdot0') + + ! sanity checks + if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_atol' + + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_ratesensitivity' + if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0' + + prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray) + + end associate + enddo rewind(fileUnit) @@ -201,16 +221,10 @@ subroutine source_damage_anisoBrittle_init(fileUnit) source_damage_anisoBrittle_output(source_damage_anisoBrittle_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select - - case ('anisobrittle_atol') - source_damage_anisoBrittle_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisobrittle_sdot0') source_damage_anisoBrittle_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('anisobrittle_ratesensitivity') - source_damage_anisoBrittle_N(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('ncleavage') ! Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_CleavageFamilies @@ -240,16 +254,14 @@ subroutine source_damage_anisoBrittle_init(fileUnit) min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,phase),& ! limit active cleavage systems per family to min of available and requested source_damage_anisoBrittle_Ncleavage(1:lattice_maxNcleavageFamily,instance)) source_damage_anisoBrittle_totalNcleavage(instance) = sum(source_damage_anisoBrittle_Ncleavage(:,instance)) ! how many cleavage systems altogether - if (source_damage_anisoBrittle_aTol(instance) < 0.0_pReal) & - source_damage_anisoBrittle_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 - if (source_damage_anisoBrittle_sdot_0(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//SOURCE_damage_anisoBrittle_LABEL//')') + + if (any(source_damage_anisoBrittle_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//SOURCE_damage_anisoBrittle_LABEL//')') if (any(source_damage_anisoBrittle_critLoad(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//SOURCE_damage_anisoBrittle_LABEL//')') - if (source_damage_anisoBrittle_N(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//SOURCE_damage_anisoBrittle_LABEL//')') + + endif myPhase enddo sanityChecks @@ -284,7 +296,7 @@ subroutine source_damage_anisoBrittle_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoBrittle_sizePostResults(instance) allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=source_damage_anisoBrittle_aTol(instance)) + source=param(instance)%aTol) allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -350,8 +362,8 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal do f = 1_pInt,lattice_maxNcleavageFamily - index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family - do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family + index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) @@ -361,9 +373,9 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & source_damage_anisoBrittle_sdot_0(instance)* & - ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance) + & - (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance) + & - (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**source_damage_anisoBrittle_N(instance))/ & + ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**param(instance)%N + & + (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**param(instance)%N + & + (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ & source_damage_anisoBrittle_critDisp(f,instance) enddo diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index c52dd4ff4..94d587166 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -31,15 +31,11 @@ module source_damage_anisoDuctile integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_Nslip !< number of slip systems per family - real(pReal), dimension(:), allocatable, private :: & - source_damage_anisoDuctile_aTol - real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_critPlasticStrain real(pReal), dimension(:), allocatable, private :: & - source_damage_anisoDuctile_sdot_0, & - source_damage_anisoDuctile_N + source_damage_anisoDuctile_sdot_0 real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_critLoad @@ -89,6 +85,8 @@ subroutine source_damage_anisoDuctile_init(fileUnit) compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -132,9 +130,12 @@ subroutine source_damage_anisoDuctile_init(fileUnit) integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase,p integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j + character(len=pStringLen) :: & + extmsg = '' character(len=65536) :: & tag = '', & line = '' + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoDuctile_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -166,13 +167,31 @@ subroutine source_damage_anisoDuctile_init(fileUnit) allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,Ninstance),source=0.0_pReal) allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) - allocate(source_damage_anisoDuctile_totalNslip(Ninstance), source=0_pInt) - allocate(source_damage_anisoDuctile_N(Ninstance), source=0.0_pReal) + allocate(source_damage_anisoDuctile_totalNslip(Ninstance), source=0_pInt) allocate(source_damage_anisoDuctile_sdot_0(Ninstance), source=0.0_pReal) - allocate(source_damage_anisoDuctile_aTol(Ninstance), source=0.0_pReal) + allocate(param(Ninstance)) + do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_damage_anisoDuctile_ID)) cycle + if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISODUCTILE_ID)) cycle + associate(prm => param(source_damage_anisoDuctile_instance(p)), & + config => config_phase(p)) + + prm%aTol = config%getFloat('anisoductile_atol',defaultVal = 1.0e-3_pReal) + + prm%N = config%getFloat('anisoductile_ratesensitivity') + prm%sdot_0 = config%getFloat('anisoductile_sdot0') + + ! sanity checks + if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_atol' + + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_ratesensitivity' + if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_sdot0' + + prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) + + end associate + enddo rewind(fileUnit) @@ -205,9 +224,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) source_damage_anisoDuctile_output(source_damage_anisoDuctile_Noutput(instance),instance) = & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select - - case ('anisoductile_atol') - source_damage_anisoDuctile_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('nslip') ! Nchunks_SlipFamilies = chunkPos(1) - 1_pInt @@ -222,9 +238,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) do j = 1_pInt, Nchunks_SlipFamilies source_damage_anisoDuctile_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo - - case ('anisoductile_ratesensitivity') - source_damage_anisoDuctile_N(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisoductile_criticalload') do j = 1_pInt, Nchunks_SlipFamilies @@ -244,14 +257,10 @@ subroutine source_damage_anisoDuctile_init(fileUnit) min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active cleavage systems per family to min of available and requested source_damage_anisoDuctile_Nslip(1:lattice_maxNslipFamily,instance)) source_damage_anisoDuctile_totalNslip(instance) = sum(source_damage_anisoDuctile_Nslip(:,instance)) - if (source_damage_anisoDuctile_aTol(instance) < 0.0_pReal) & - source_damage_anisoDuctile_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 - if (source_damage_anisoDuctile_sdot_0(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//SOURCE_damage_anisoDuctile_LABEL//')') + if (any(source_damage_anisoDuctile_critPlasticStrain(:,instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//SOURCE_damage_anisoDuctile_LABEL//')') - if (source_damage_anisoDuctile_N(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//SOURCE_damage_anisoDuctile_LABEL//')') + endif myPhase enddo sanityChecks @@ -286,7 +295,7 @@ subroutine source_damage_anisoDuctile_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoDuctile_sizePostResults(instance) allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=source_damage_anisoDuctile_aTol(instance)) + source=param(instance)%aTol) allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -349,7 +358,7 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & plasticState(phase)%slipRate(index,constituent)/ & - ((damage(homog)%p(damageOffset))**source_damage_anisoDuctile_N(instance))/ & + ((damage(homog)%p(damageOffset))**param(instance)%N)/ & source_damage_anisoDuctile_critPlasticStrain(f,instance) index = index + 1_pInt diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index cb62bc9f9..5e45b4e4c 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -26,8 +26,6 @@ module source_damage_isoBrittle source_damage_isoBrittle_Noutput !< number of outputs per instance of this damage real(pReal), dimension(:), allocatable, private :: & - source_damage_isoBrittle_aTol, & - source_damage_isoBrittle_N, & source_damage_isoBrittle_critStrainEnergy enum, bind(c) @@ -68,6 +66,8 @@ subroutine source_damage_isoBrittle_init(fileUnit) compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -107,6 +107,8 @@ subroutine source_damage_isoBrittle_init(fileUnit) integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase,p + character(len=pStringLen) :: & + extmsg = '' character(len=65536) :: & tag = '', & line = '' @@ -139,11 +141,27 @@ subroutine source_damage_isoBrittle_init(fileUnit) allocate(source_damage_isoBrittle_Noutput(Ninstance), source=0_pInt) allocate(source_damage_isoBrittle_critStrainEnergy(Ninstance), source=0.0_pReal) - allocate(source_damage_isoBrittle_N(Ninstance), source=1.0_pReal) - allocate(source_damage_isoBrittle_aTol(Ninstance), source=0.0_pReal) + allocate(param(Ninstance)) + do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_damage_isoBrittle_ID)) cycle + if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISOBRITTLE_ID)) cycle + associate(prm => param(source_damage_isoBrittle_instance(p)), & + config => config_phase(p)) + + prm%aTol = config%getFloat('isobrittle_atol',defaultVal = 1.0e-3_pReal) + + prm%N = config%getFloat('isobrittle_n') + prm%critStrainEnergy = config%getFloat('isobrittle_criticalstrainenergy') + + ! sanity checks + if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_atol' + + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_n' + if (prm%critStrainEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_criticalstrainenergy' + + end associate + enddo rewind(fileUnit) @@ -180,29 +198,11 @@ subroutine source_damage_isoBrittle_init(fileUnit) case ('isobrittle_criticalstrainenergy') source_damage_isoBrittle_critStrainEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('isobrittle_n') - source_damage_isoBrittle_N(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('isobrittle_atol') - source_damage_isoBrittle_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) - end select endif; endif enddo parsingFile -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, material_Nphase - myPhase: if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then - instance = source_damage_isoBrittle_instance(phase) - if (source_damage_isoBrittle_aTol(instance) < 0.0_pReal) & - source_damage_isoBrittle_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 - if (source_damage_isoBrittle_critStrainEnergy(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='criticalStrainEnergy ('//SOURCE_damage_isoBrittle_LABEL//')') - endif myPhase - enddo sanityChecks - initializeInstances: do phase = 1_pInt, material_Nphase if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then NofMyPhase=count(material_phase==phase) @@ -231,7 +231,7 @@ subroutine source_damage_isoBrittle_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoBrittle_sizePostResults(instance) allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=source_damage_isoBrittle_aTol(instance)) + source=param(instance)%aTol) allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -330,10 +330,10 @@ subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiD instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) - localphiDot = (1.0_pReal - phi)**(source_damage_isoBrittle_N(instance) - 1.0_pReal) - & + localphiDot = (1.0_pReal - phi)**(param(instance)%N - 1.0_pReal) - & phi*sourceState(phase)%p(sourceOffset)%state(1,constituent) - dLocalphiDot_dPhi = - (source_damage_isoBrittle_N(instance) - 1.0_pReal)* & - (1.0_pReal - phi)**max(0.0_pReal,source_damage_isoBrittle_N(instance) - 2.0_pReal) & + dLocalphiDot_dPhi = - (param(instance)%N - 1.0_pReal)* & + (1.0_pReal - phi)**max(0.0_pReal,param(instance)%N - 2.0_pReal) & - sourceState(phase)%p(sourceOffset)%state(1,constituent) end subroutine source_damage_isoBrittle_getRateAndItsTangent diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index b4ecb53e4..182726fa3 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -26,9 +26,7 @@ module source_damage_isoDuctile source_damage_isoDuctile_Noutput !< number of outputs per instance of this damage real(pReal), dimension(:), allocatable, private :: & - source_damage_isoDuctile_aTol, & - source_damage_isoDuctile_critPlasticStrain, & - source_damage_isoDuctile_N + source_damage_isoDuctile_critPlasticStrain enum, bind(c) enumerator :: undefined_ID, & @@ -68,6 +66,8 @@ subroutine source_damage_isoDuctile_init(fileUnit) compiler_version, & compiler_options #endif + use prec, only: & + pStringLen use debug, only: & debug_level,& debug_constitutive,& @@ -108,6 +108,8 @@ subroutine source_damage_isoDuctile_init(fileUnit) integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o integer(pInt) :: sizeState, sizeDotState, sizeDeltaState integer(pInt) :: NofMyPhase,p + character(len=pStringLen) :: & + extmsg = '' character(len=65536) :: & tag = '', & line = '' @@ -140,11 +142,27 @@ subroutine source_damage_isoDuctile_init(fileUnit) allocate(source_damage_isoDuctile_Noutput(Ninstance), source=0_pInt) allocate(source_damage_isoDuctile_critPlasticStrain(Ninstance), source=0.0_pReal) - allocate(source_damage_isoDuctile_N(Ninstance), source=0.0_pReal) - allocate(source_damage_isoDuctile_aTol(Ninstance), source=0.0_pReal) + allocate(param(Ninstance)) + do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_damage_isoDuctile_ID)) cycle + if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISODUCTILE_ID)) cycle + associate(prm => param(source_damage_isoDuctile_instance(p)), & + config => config_phase(p)) + + prm%aTol = config%getFloat('isoductile_atol',defaultVal = 1.0e-3_pReal) + + prm%N = config%getFloat('isoductile_ratesensitivity') + prm%critPlasticStrain = config%getFloat('isoductile_criticalplasticstrain') + + ! sanity checks + if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' isoductile_atol' + + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_ratesensitivity' + if (prm%critPlasticStrain <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_criticalplasticstrain' + + end associate + enddo rewind(fileUnit) @@ -181,29 +199,10 @@ subroutine source_damage_isoDuctile_init(fileUnit) case ('isoductile_criticalplasticstrain') source_damage_isoDuctile_critPlasticStrain(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('isoductile_ratesensitivity') - source_damage_isoDuctile_N(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('isoductile_atol') - source_damage_isoDuctile_aTol(instance) = IO_floatValue(line,chunkPos,2_pInt) - end select endif; endif enddo parsingFile - -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, material_Nphase - myPhase: if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then - instance = source_damage_isoDuctile_instance(phase) - if (source_damage_isoDuctile_aTol(instance) < 0.0_pReal) & - source_damage_isoDuctile_aTol(instance) = 1.0e-3_pReal ! default absolute tolerance 1e-3 - if (source_damage_isoDuctile_critPlasticStrain(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='critical plastic strain ('//SOURCE_damage_isoDuctile_LABEL//')') - endif myPhase - enddo sanityChecks - initializeInstances: do phase = 1_pInt, material_Nphase if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then NofMyPhase=count(material_phase==phase) @@ -232,7 +231,7 @@ subroutine source_damage_isoDuctile_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoDuctile_sizePostResults(instance) allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=source_damage_isoDuctile_aTol(instance)) + source=param(instance)%aTol) allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -283,7 +282,7 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sum(plasticState(phase)%slipRate(:,constituent))/ & - ((damage(homog)%p(damageOffset))**source_damage_isoDuctile_N(instance))/ & + ((damage(homog)%p(damageOffset))**param(instance)%N)/ & source_damage_isoDuctile_critPlasticStrain(instance) end subroutine source_damage_isoDuctile_dotState From 61baa66c385f6340eb0437bd67e0fb8901fd9576 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 07:22:37 +0100 Subject: [PATCH 172/309] avoid code duplication --- src/material.f90 | 42 ++++++++++++++++++++++++++++++ src/source_damage_anisoBrittle.f90 | 28 +++----------------- src/source_damage_anisoDuctile.f90 | 28 +++----------------- src/source_damage_isoBrittle.f90 | 29 +++------------------ src/source_damage_isoDuctile.f90 | 31 ++++------------------ 5 files changed, 57 insertions(+), 101 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 3ae6c16a4..76753273c 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -235,6 +235,7 @@ module material public :: & material_init, & material_allocatePlasticState, & + material_allocateSourceState, & ELASTICITY_hooke_ID ,& PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & @@ -966,6 +967,47 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,& end subroutine material_allocatePlasticState +!-------------------------------------------------------------------------------------------------- +!> @brief allocates the source state of a phase +!-------------------------------------------------------------------------------------------------- +subroutine material_allocateSourceState(phase,of,NofMyPhase,sizeState) + use numerics, only: & + numerics_integrator2 => numerics_integrator ! compatibility hack + + implicit none + integer(pInt), intent(in) :: & + phase, & + of, & + NofMyPhase, & + sizeState + integer(pInt) :: numerics_integrator ! compatibility hack + numerics_integrator = numerics_integrator2(1) ! compatibility hack + + sourceState(phase)%p(of)%sizeState = sizeState + sourceState(phase)%p(of)%sizeDotState = sizeState + sourceState(phase)%p(of)%sizeDeltaState = 0_pInt + + allocate(sourceState(phase)%p(of)%aTolState (sizeState), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(of)%dotState (sizeState,NofMyPhase), source=0.0_pReal) + if (numerics_integrator == 1_pInt) then + allocate(sourceState(phase)%p(of)%previousDotState (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%previousDotState2 (sizeState,NofMyPhase), source=0.0_pReal) + endif + if (numerics_integrator == 4_pInt) & + allocate(sourceState(phase)%p(of)%RK4dotState (sizeState,NofMyPhase), source=0.0_pReal) + if (numerics_integrator == 5_pInt) & + allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeState,NofMyPhase), source=0.0_pReal) + + allocate(plasticState(phase)%deltaState (0,NofMyPhase), source=0.0_pReal) + +end subroutine material_allocateSourceState + + !-------------------------------------------------------------------------------------------------- !> @brief populates the grains !> @details populates the grains by identifying active microstructure/homogenization pairs, diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index fc2cade78..06e7480eb 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -102,6 +102,7 @@ subroutine source_damage_anisoBrittle_init(fileUnit) IO_timeStamp, & IO_EOF use material, only: & + material_allocateSourceState, & phase_source, & phase_Nsources, & phase_Noutput, & @@ -285,33 +286,10 @@ subroutine source_damage_anisoBrittle_init(fileUnit) endif enddo outputsLoop -!-------------------------------------------------------------------------------------------------- -! Determine size of state array - sizeDotState = 1_pInt - sizeDeltaState = 0_pInt - sizeState = 1_pInt - - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoBrittle_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=param(instance)%aTol) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) endif diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 94d587166..d2a4e8aa1 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -105,6 +105,7 @@ subroutine source_damage_anisoDuctile_init(fileUnit) IO_timeStamp, & IO_EOF use material, only: & + material_allocateSourceState, & phase_source, & phase_Nsources, & phase_Noutput, & @@ -285,32 +286,9 @@ subroutine source_damage_anisoDuctile_init(fileUnit) endif enddo outputsLoop -!-------------------------------------------------------------------------------------------------- -! Determine size of state array - sizeDotState = 1_pInt - sizeDeltaState = 0_pInt - sizeState = 1_pInt - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoDuctile_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=param(instance)%aTol) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol endif diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 5e45b4e4c..7b9f76009 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -86,6 +86,7 @@ subroutine source_damage_isoBrittle_init(fileUnit) IO_timeStamp, & IO_EOF use material, only: & + material_allocateSourceState, & phase_source, & phase_Nsources, & phase_Noutput, & @@ -221,32 +222,10 @@ subroutine source_damage_isoBrittle_init(fileUnit) source_damage_isoBrittle_sizePostResults(instance) = source_damage_isoBrittle_sizePostResults(instance) + mySize endif enddo outputsLoop -! Determine size of state array - sizeDotState = 1_pInt - sizeDeltaState = 1_pInt - sizeState = 1_pInt - - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoBrittle_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=param(instance)%aTol) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol endif diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 182726fa3..3613a29a9 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -86,6 +86,7 @@ subroutine source_damage_isoDuctile_init(fileUnit) IO_timeStamp, & IO_EOF use material, only: & + material_allocateSourceState, & phase_source, & phase_Nsources, & phase_Noutput, & @@ -221,33 +222,11 @@ subroutine source_damage_isoDuctile_init(fileUnit) source_damage_isoDuctile_sizePostResults(instance) = source_damage_isoDuctile_sizePostResults(instance) + mySize endif enddo outputsLoop -! Determine size of state array - sizeDotState = 1_pInt - sizeDeltaState = 0_pInt - sizeState = 1_pInt - - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState + + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoDuctile_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), & - source=param(instance)%aTol) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) - + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + endif enddo initializeInstances From 6a0d739d48ec72150c2f1854ee71b4dc85b0a456 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 07:24:48 +0100 Subject: [PATCH 173/309] use parameters from param structure --- src/source_damage_isoBrittle.f90 | 10 +--------- src/source_damage_isoDuctile.f90 | 9 +-------- 2 files changed, 2 insertions(+), 17 deletions(-) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 7b9f76009..20dc6eaa3 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -25,9 +25,6 @@ module source_damage_isoBrittle integer(pInt), dimension(:), allocatable, target, public :: & source_damage_isoBrittle_Noutput !< number of outputs per instance of this damage - real(pReal), dimension(:), allocatable, private :: & - source_damage_isoBrittle_critStrainEnergy - enum, bind(c) enumerator :: undefined_ID, & damage_drivingforce_ID @@ -141,8 +138,6 @@ subroutine source_damage_isoBrittle_init(fileUnit) allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) allocate(source_damage_isoBrittle_Noutput(Ninstance), source=0_pInt) - allocate(source_damage_isoBrittle_critStrainEnergy(Ninstance), source=0.0_pReal) - allocate(param(Ninstance)) do p=1, size(config_phase) @@ -196,9 +191,6 @@ subroutine source_damage_isoBrittle_init(fileUnit) IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select - case ('isobrittle_criticalstrainenergy') - source_damage_isoBrittle_critStrainEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) - end select endif; endif enddo parsingFile @@ -275,7 +267,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) strain = 0.5_pReal*math_Mandel33to6(math_mul33x33(math_transpose33(Fe),Fe)-math_I3) strainenergy = 2.0_pReal*sum(strain*math_mul66x6(stiffness,strain))/ & - source_damage_isoBrittle_critStrainEnergy(instance) + param(instances)%critStrainEnergy if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 3613a29a9..7186f8749 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -25,8 +25,6 @@ module source_damage_isoDuctile integer(pInt), dimension(:), allocatable, target, public :: & source_damage_isoDuctile_Noutput !< number of outputs per instance of this damage - real(pReal), dimension(:), allocatable, private :: & - source_damage_isoDuctile_critPlasticStrain enum, bind(c) enumerator :: undefined_ID, & @@ -142,8 +140,6 @@ subroutine source_damage_isoDuctile_init(fileUnit) allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) allocate(source_damage_isoDuctile_Noutput(Ninstance), source=0_pInt) - allocate(source_damage_isoDuctile_critPlasticStrain(Ninstance), source=0.0_pReal) - allocate(param(Ninstance)) do p=1, size(config_phase) @@ -197,9 +193,6 @@ subroutine source_damage_isoDuctile_init(fileUnit) IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select - case ('isoductile_criticalplasticstrain') - source_damage_isoDuctile_critPlasticStrain(instance) = IO_floatValue(line,chunkPos,2_pInt) - end select endif; endif enddo parsingFile @@ -262,7 +255,7 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sum(plasticState(phase)%slipRate(:,constituent))/ & ((damage(homog)%p(damageOffset))**param(instance)%N)/ & - source_damage_isoDuctile_critPlasticStrain(instance) + param(instance)%critPlasticStrain end subroutine source_damage_isoDuctile_dotState From aa8d218ce757a0c0b3776f11c6503dc2be3fae42 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 07:28:28 +0100 Subject: [PATCH 174/309] was never used --- src/source_damage_anisoDuctile.f90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index d2a4e8aa1..7abc751d6 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -34,9 +34,6 @@ module source_damage_anisoDuctile real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_critPlasticStrain - real(pReal), dimension(:), allocatable, private :: & - source_damage_anisoDuctile_sdot_0 - real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_critLoad @@ -52,7 +49,6 @@ module source_damage_anisoDuctile type, private :: tParameters !< container type for internal constitutive parameters real(pReal) :: & aTol, & - sdot_0, & N real(pReal), dimension(:), allocatable :: & critPlasticStrain, & @@ -169,7 +165,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,Ninstance),source=0.0_pReal) allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) allocate(source_damage_anisoDuctile_totalNslip(Ninstance), source=0_pInt) - allocate(source_damage_anisoDuctile_sdot_0(Ninstance), source=0.0_pReal) allocate(param(Ninstance)) @@ -181,13 +176,11 @@ subroutine source_damage_anisoDuctile_init(fileUnit) prm%aTol = config%getFloat('anisoductile_atol',defaultVal = 1.0e-3_pReal) prm%N = config%getFloat('anisoductile_ratesensitivity') - prm%sdot_0 = config%getFloat('anisoductile_sdot0') ! sanity checks if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_atol' if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_ratesensitivity' - if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_sdot0' prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) @@ -231,9 +224,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) do j = 1_pInt, Nchunks_SlipFamilies source_damage_anisoDuctile_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo - - case ('anisoductile_sdot0') - source_damage_anisoDuctile_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) case ('anisoductile_criticalplasticstrain') do j = 1_pInt, Nchunks_SlipFamilies From b3e705e628dacf4c37fa7ea027815c6dda9ef963 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 07:34:16 +0100 Subject: [PATCH 175/309] polishing, fixed typo --- src/source_damage_isoBrittle.f90 | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 20dc6eaa3..3a2481639 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -235,10 +235,9 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) phase_NstiffnessDegradations, & phase_stiffnessDegradation use math, only : & + math_sym33to6, & math_mul33x33, & math_mul66x6, & - math_Mandel33to6, & - math_transpose33, & math_I3 implicit none @@ -254,7 +253,6 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) phase, constituent, instance, sourceOffset, mech real(pReal) :: & strain(6), & - stiffness(6,6), & strainenergy phase = phaseAt(ipc,ip,el) !< phase ID at ipc,ip,el @@ -263,11 +261,11 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source sourceOffset = source_damage_isoBrittle_offset(phase) - stiffness = C - strain = 0.5_pReal*math_Mandel33to6(math_mul33x33(math_transpose33(Fe),Fe)-math_I3) + + strain = 0.5_pReal*math_sym33to6(math_mul33x33(transpose(Fe),Fe)-math_I3) - strainenergy = 2.0_pReal*sum(strain*math_mul66x6(stiffness,strain))/ & - param(instances)%critStrainEnergy + strainenergy = 2.0_pReal*sum(strain*math_mul66x6(C,strain))/ & + param(instance)%critStrainEnergy if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) From f34c10a477faaf4686d9c2256ff8437988a53946 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 07:36:36 +0100 Subject: [PATCH 176/309] sdot_0 already available as parameter --- src/source_damage_anisoBrittle.f90 | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 06e7480eb..a8f9de6f6 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -31,8 +31,6 @@ module source_damage_anisoBrittle integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family - real(pReal), dimension(:), allocatable, private :: & - source_damage_anisoBrittle_sdot_0 real(pReal), dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_critDisp, & source_damage_anisoBrittle_critLoad @@ -166,7 +164,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) allocate(source_damage_anisoBrittle_totalNcleavage(Ninstance), source=0_pInt) - allocate(source_damage_anisoBrittle_sdot_0(Ninstance), source=0.0_pReal) allocate(param(Ninstance)) @@ -223,9 +220,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) IO_lc(IO_stringValue(line,chunkPos,2_pInt)) end select - case ('anisobrittle_sdot0') - source_damage_anisoBrittle_sdot_0(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('ncleavage') ! Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_CleavageFamilies @@ -350,7 +344,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & - source_damage_anisoBrittle_sdot_0(instance)* & + param(instance)%sdot_0* & ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**param(instance)%N + & (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**param(instance)%N + & (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ & From a421525d15b843331f8e84947fdc5e63baf975bb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 08:06:22 +0100 Subject: [PATCH 177/309] preparing storage of output parameters --- src/source_damage_anisoBrittle.f90 | 37 ++++++++++++++++++++++------ src/source_damage_anisoDuctile.f90 | 39 ++++++++++++++++++++++++------ src/source_damage_isoBrittle.f90 | 37 ++++++++++++++++++++++------ src/source_damage_isoDuctile.f90 | 38 +++++++++++++++++++++++------ 4 files changed, 121 insertions(+), 30 deletions(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index a8f9de6f6..d9ec6f34c 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -56,6 +56,8 @@ module source_damage_anisoBrittle totalNcleavage integer(pInt), dimension(:), allocatable :: & Ncleavage + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID !< ID of each post result output end type tParameters type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) @@ -112,8 +114,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) config_phase, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - numerics_integrator use lattice, only: & lattice_maxNcleavageFamily, & lattice_NcleavageSystem @@ -123,17 +123,22 @@ subroutine source_damage_anisoBrittle_init(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase,p + integer(pInt) :: NofMyPhase,p ,i integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j - character(len=pStringLen) :: & - extmsg = '' character(len=65536) :: & tag = '', & line = '' integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoBrittle_LABEL//' init -+>>>' + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -185,6 +190,24 @@ subroutine source_damage_anisoBrittle_init(fileUnit) prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray) +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')') + +!-------------------------------------------------------------------------------------------------- +! output pararameters + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case ('anisobrittle_drivingforce') + + end select + + enddo + end associate enddo diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 7abc751d6..925588594 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -57,6 +57,8 @@ module source_damage_anisoDuctile totalNslip integer(pInt), dimension(:), allocatable :: & Nslip + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID end type tParameters type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) @@ -113,8 +115,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) config_phase, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - numerics_integrator use lattice, only: & lattice_maxNslipFamily, & lattice_NslipSystem @@ -124,17 +124,22 @@ subroutine source_damage_anisoDuctile_init(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase,p - integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j - character(len=pStringLen) :: & - extmsg = '' + integer(pInt) :: NofMyPhase,p ,i + integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j character(len=65536) :: & tag = '', & line = '' integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_anisoDuctile_LABEL//' init -+>>>' + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -184,6 +189,24 @@ subroutine source_damage_anisoDuctile_init(fileUnit) prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')') + +!-------------------------------------------------------------------------------------------------- +! output pararameters + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case ('anisoductile_drivingforce') + + end select + + enddo + end associate enddo diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 3a2481639..e09d79056 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -39,6 +39,8 @@ module source_damage_isoBrittle critStrainEnergy, & N, & aTol + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID end type tParameters type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) @@ -95,23 +97,26 @@ subroutine source_damage_isoBrittle_init(fileUnit) config_phase, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - numerics_integrator implicit none integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase,p - character(len=pStringLen) :: & - extmsg = '' + integer(pInt) :: NofMyPhase,p,i character(len=65536) :: & tag = '', & line = '' + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_isoBrittle_label//' init -+>>>' + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -156,6 +161,24 @@ subroutine source_damage_isoBrittle_init(fileUnit) if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_n' if (prm%critStrainEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_criticalstrainenergy' +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')') + +!-------------------------------------------------------------------------------------------------- +! output pararameters + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case ('isobrittle_drivingforce') + + end select + + enddo + end associate enddo diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 7186f8749..3b4b06727 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -40,6 +40,8 @@ module source_damage_isoDuctile critPlasticStrain, & N, & aTol + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID end type tParameters type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) @@ -96,24 +98,26 @@ subroutine source_damage_isoDuctile_init(fileUnit) config_phase, & material_Nphase, & MATERIAL_partPhase - - use numerics,only: & - numerics_integrator implicit none integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase,p - character(len=pStringLen) :: & - extmsg = '' + integer(pInt) :: NofMyPhase,p,i character(len=65536) :: & tag = '', & line = '' + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - write(6,'(/,a)') ' <<<+- source_'//SOURCE_damage_isoDuctile_label//' init -+>>>' + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -157,6 +161,24 @@ subroutine source_damage_isoDuctile_init(fileUnit) if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_ratesensitivity' if (prm%critPlasticStrain <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_criticalplasticstrain' + +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')') + +!-------------------------------------------------------------------------------------------------- +! output pararameters + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case ('isoductile_drivingforce') + + end select + + enddo end associate From 3ca34c8f805b5021fcae20f61917ca9d13a4721d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 09:05:07 +0100 Subject: [PATCH 178/309] simplified --- src/constitutive.f90 | 4 +- src/source_damage_anisoBrittle.f90 | 82 +++++---------------- src/source_damage_anisoDuctile.f90 | 76 +++++-------------- src/source_damage_isoBrittle.f90 | 114 ++++++----------------------- src/source_damage_isoDuctile.f90 | 112 +++++----------------------- 5 files changed, 81 insertions(+), 307 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index ef6004109..66f0cab2f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -163,8 +163,8 @@ subroutine constitutive_init() call IO_checkAndRewind(FILEUNIT) if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init(FILEUNIT) if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init(FILEUNIT) - if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init(FILEUNIT) - if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init(FILEUNIT) + if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init + if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init(FILEUNIT) if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init(FILEUNIT) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index d9ec6f34c..c380e9790 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -12,7 +12,6 @@ module source_damage_anisoBrittle implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - source_damage_anisoBrittle_sizePostResults, & !< cumulative size of post results source_damage_anisoBrittle_offset, & !< which source is my current source mechanism? source_damage_anisoBrittle_instance !< instance of source mechanism @@ -22,12 +21,6 @@ module source_damage_anisoBrittle character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_anisoBrittle_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & - source_damage_anisoBrittle_Noutput !< number of outputs per instance of this source - - integer(pInt), dimension(:), allocatable, private :: & - source_damage_anisoBrittle_totalNcleavage !< total number of cleavage systems - integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family @@ -39,9 +32,6 @@ module source_damage_anisoBrittle enumerator :: undefined_ID, & damage_drivingforce_ID end enum - - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - source_damage_anisoBrittle_outputID !< ID of each post result output type, private :: tParameters !< container type for internal constitutive parameters @@ -157,18 +147,14 @@ subroutine source_damage_anisoBrittle_init(fileUnit) source_damage_anisoBrittle_offset(phase) = source enddo enddo - - allocate(source_damage_anisoBrittle_sizePostResults(Ninstance), source=0_pInt) + allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0_pInt) allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoBrittle_output = '' - allocate(source_damage_anisoBrittle_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) - allocate(source_damage_anisoBrittle_Noutput(Ninstance), source=0_pInt) allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) - allocate(source_damage_anisoBrittle_totalNcleavage(Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -202,7 +188,11 @@ subroutine source_damage_anisoBrittle_init(fileUnit) do i=1_pInt, size(outputs) outputID = undefined_ID select case(outputs(i)) + case ('anisobrittle_drivingforce') + source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1_pInt + source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] end select @@ -210,6 +200,16 @@ subroutine source_damage_anisoBrittle_init(fileUnit) end associate + phase = p + NofMyPhase=count(material_phase==phase) + instance = source_damage_anisoBrittle_instance(phase) + sourceOffset = source_damage_anisoBrittle_offset(phase) + + + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + enddo rewind(fileUnit) @@ -234,15 +234,7 @@ subroutine source_damage_anisoBrittle_init(fileUnit) chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('anisobrittle_drivingforce') - source_damage_anisoBrittle_Noutput(instance) = source_damage_anisoBrittle_Noutput(instance) + 1_pInt - source_damage_anisoBrittle_outputID(source_damage_anisoBrittle_Noutput(instance),instance) = damage_drivingforce_ID - source_damage_anisoBrittle_output(source_damage_anisoBrittle_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - + case ('ncleavage') ! Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt do j = 1_pInt, Nchunks_CleavageFamilies @@ -268,11 +260,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) sanityChecks: do phase = 1_pInt, material_Nphase myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then instance = source_damage_anisoBrittle_instance(phase) - source_damage_anisoBrittle_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & - min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,phase),& ! limit active cleavage systems per family to min of available and requested - source_damage_anisoBrittle_Ncleavage(1:lattice_maxNcleavageFamily,instance)) - source_damage_anisoBrittle_totalNcleavage(instance) = sum(source_damage_anisoBrittle_Ncleavage(:,instance)) ! how many cleavage systems altogether - if (any(source_damage_anisoBrittle_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//SOURCE_damage_anisoBrittle_LABEL//')') @@ -283,34 +270,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) endif myPhase enddo sanityChecks - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_damage_anisoBrittle_instance(phase) - sourceOffset = source_damage_anisoBrittle_offset(phase) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,source_damage_anisoBrittle_Noutput(instance) - select case(source_damage_anisoBrittle_outputID(o,instance)) - case(damage_drivingforce_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - source_damage_anisoBrittle_sizePostResult(o,instance) = mySize - source_damage_anisoBrittle_sizePostResults(instance) = source_damage_anisoBrittle_sizePostResults(instance) + mySize - endif - enddo outputsLoop - - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) - sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoBrittle_sizePostResults(instance) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - - - endif - - enddo initializeInstances end subroutine source_damage_anisoBrittle_init !-------------------------------------------------------------------------------------------------- @@ -417,8 +376,8 @@ function source_damage_anisoBrittle_postResults(phase, constituent) integer(pInt), intent(in) :: & phase, & constituent - real(pReal), dimension(source_damage_anisoBrittle_sizePostResults( & - source_damage_anisoBrittle_instance(phase))) :: & + real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, & + source_damage_anisoBrittle_instance(phase)))) :: & source_damage_anisoBrittle_postResults integer(pInt) :: & @@ -428,10 +387,9 @@ function source_damage_anisoBrittle_postResults(phase, constituent) sourceOffset = source_damage_anisoBrittle_offset(phase) c = 0_pInt - source_damage_anisoBrittle_postResults = 0.0_pReal - do o = 1_pInt,source_damage_anisoBrittle_Noutput(instance) - select case(source_damage_anisoBrittle_outputID(o,instance)) + do o = 1_pInt,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) source_damage_anisoBrittle_postResults(c+1_pInt) = & sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 925588594..46898ecf5 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -12,7 +12,6 @@ module source_damage_anisoDuctile implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - source_damage_anisoDuctile_sizePostResults, & !< cumulative size of post results source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism? source_damage_anisoDuctile_instance !< instance of damage source mechanism @@ -22,11 +21,6 @@ module source_damage_anisoDuctile character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_anisoDuctile_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & - source_damage_anisoDuctile_Noutput !< number of outputs per instance of this damage - - integer(pInt), dimension(:), allocatable, private :: & - source_damage_anisoDuctile_totalNslip !< total number of slip systems integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_Nslip !< number of slip systems per family @@ -41,9 +35,6 @@ module source_damage_anisoDuctile enumerator :: undefined_ID, & damage_drivingforce_ID end enum - - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - source_damage_anisoDuctile_outputID !< ID of each post result output type, private :: tParameters !< container type for internal constitutive parameters @@ -159,17 +150,13 @@ subroutine source_damage_anisoDuctile_init(fileUnit) enddo enddo - allocate(source_damage_anisoDuctile_sizePostResults(Ninstance), source=0_pInt) allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoDuctile_output = '' - allocate(source_damage_anisoDuctile_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) - allocate(source_damage_anisoDuctile_Noutput(Ninstance), source=0_pInt) allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,Ninstance),source=0.0_pReal) allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) - allocate(source_damage_anisoDuctile_totalNslip(Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -201,7 +188,11 @@ subroutine source_damage_anisoDuctile_init(fileUnit) do i=1_pInt, size(outputs) outputID = undefined_ID select case(outputs(i)) + case ('anisoductile_drivingforce') + source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1_pInt + source_damage_anisoDuctile_output(i,source_damage_anisoDuctile_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] end select @@ -209,6 +200,16 @@ subroutine source_damage_anisoDuctile_init(fileUnit) end associate + phase = p + + NofMyPhase=count(material_phase==phase) + instance = source_damage_anisoDuctile_instance(phase) + sourceOffset = source_damage_anisoDuctile_offset(phase) + + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + enddo rewind(fileUnit) @@ -233,14 +234,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('anisoductile_drivingforce') - source_damage_anisoDuctile_Noutput(instance) = source_damage_anisoDuctile_Noutput(instance) + 1_pInt - source_damage_anisoDuctile_outputID(source_damage_anisoDuctile_Noutput(instance),instance) = damage_drivingforce_ID - source_damage_anisoDuctile_output(source_damage_anisoDuctile_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select case ('nslip') ! Nchunks_SlipFamilies = chunkPos(1) - 1_pInt @@ -267,10 +260,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) sanityChecks: do phase = 1_pInt, size(phase_source) myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then instance = source_damage_anisoDuctile_instance(phase) - source_damage_anisoDuctile_Nslip(1:lattice_maxNslipFamily,instance) = & - min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active cleavage systems per family to min of available and requested - source_damage_anisoDuctile_Nslip(1:lattice_maxNslipFamily,instance)) - source_damage_anisoDuctile_totalNslip(instance) = sum(source_damage_anisoDuctile_Nslip(:,instance)) if (any(source_damage_anisoDuctile_critPlasticStrain(:,instance) < 0.0_pReal)) & call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//SOURCE_damage_anisoDuctile_LABEL//')') @@ -278,34 +267,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) endif myPhase enddo sanityChecks - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_damage_anisoDuctile_instance(phase) - sourceOffset = source_damage_anisoDuctile_offset(phase) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,source_damage_anisoDuctile_Noutput(instance) - select case(source_damage_anisoDuctile_outputID(o,instance)) - case(damage_drivingforce_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - source_damage_anisoDuctile_sizePostResult(o,instance) = mySize - source_damage_anisoDuctile_sizePostResults(instance) = source_damage_anisoDuctile_sizePostResults(instance) + mySize - endif - enddo outputsLoop - - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) - sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_anisoDuctile_sizePostResults(instance) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - - endif - - enddo initializeInstances end subroutine source_damage_anisoDuctile_init !-------------------------------------------------------------------------------------------------- @@ -398,8 +359,8 @@ function source_damage_anisoDuctile_postResults(phase, constituent) integer(pInt), intent(in) :: & phase, & constituent - real(pReal), dimension(source_damage_anisoDuctile_sizePostResults( & - source_damage_anisoDuctile_instance(phase))) :: & + real(pReal), dimension(sum(source_damage_anisoDuctile_sizePostResult(:, & + source_damage_anisoDuctile_instance(phase)))) :: & source_damage_anisoDuctile_postResults integer(pInt) :: & @@ -409,10 +370,9 @@ function source_damage_anisoDuctile_postResults(phase, constituent) sourceOffset = source_damage_anisoDuctile_offset(phase) c = 0_pInt - source_damage_anisoDuctile_postResults = 0.0_pReal - do o = 1_pInt,source_damage_anisoDuctile_Noutput(instance) - select case(source_damage_anisoDuctile_outputID(o,instance)) + do o = 1_pInt,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) source_damage_anisoDuctile_postResults(c+1_pInt) = & sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index e09d79056..702ce8833 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -12,7 +12,6 @@ module source_damage_isoBrittle implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - source_damage_isoBrittle_sizePostResults, & !< cumulative size of post results source_damage_isoBrittle_offset, & !< which source is my current damage mechanism? source_damage_isoBrittle_instance !< instance of damage source mechanism @@ -21,17 +20,11 @@ module source_damage_isoBrittle character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_isoBrittle_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - source_damage_isoBrittle_Noutput !< number of outputs per instance of this damage enum, bind(c) enumerator :: undefined_ID, & damage_drivingforce_ID end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo - - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - source_damage_isoBrittle_outputID !< ID of each post result output type, private :: tParameters !< container type for internal constitutive parameters @@ -59,7 +52,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoBrittle_init(fileUnit) +subroutine source_damage_isoBrittle_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -72,14 +65,6 @@ subroutine source_damage_isoBrittle_init(fileUnit) debug_constitutive,& debug_levelBasic use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & IO_timeStamp, & @@ -99,14 +84,9 @@ subroutine source_damage_isoBrittle_init(fileUnit) MATERIAL_partPhase implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset,o integer(pInt) :: NofMyPhase,p,i - character(len=65536) :: & - tag = '', & - line = '' character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -136,12 +116,9 @@ subroutine source_damage_isoBrittle_init(fileUnit) enddo enddo - allocate(source_damage_isoBrittle_sizePostResults(Ninstance), source=0_pInt) allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_isoBrittle_output = '' - allocate(source_damage_isoBrittle_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) - allocate(source_damage_isoBrittle_Noutput(Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -173,78 +150,30 @@ subroutine source_damage_isoBrittle_init(fileUnit) do i=1_pInt, size(outputs) outputID = undefined_ID select case(outputs(i)) + case ('isobrittle_drivingforce') - + source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1_pInt + source_damage_isoBrittle_output(i,source_damage_isoBrittle_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] + end select enddo end associate - enddo - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = source_damage_isoBrittle_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('isobrittle_drivingforce') - source_damage_isoBrittle_Noutput(instance) = source_damage_isoBrittle_Noutput(instance) + 1_pInt - source_damage_isoBrittle_outputID(source_damage_isoBrittle_Noutput(instance),instance) = damage_drivingforce_ID - source_damage_isoBrittle_output(source_damage_isoBrittle_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - end select - endif; endif - enddo parsingFile - - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_damage_isoBrittle_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_damage_isoBrittle_instance(phase) - sourceOffset = source_damage_isoBrittle_offset(phase) -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,source_damage_isoBrittle_Noutput(instance) - select case(source_damage_isoBrittle_outputID(o,instance)) - case(damage_drivingforce_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - source_damage_isoBrittle_sizePostResult(o,instance) = mySize - source_damage_isoBrittle_sizePostResults(instance) = source_damage_isoBrittle_sizePostResults(instance) + mySize - endif - enddo outputsLoop + phase = p + + NofMyPhase=count(material_phase==phase) + instance = source_damage_isoBrittle_instance(phase) + sourceOffset = source_damage_isoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) - sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoBrittle_sizePostResults(instance) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - - endif + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + + enddo - enddo initializeInstances end subroutine source_damage_isoBrittle_init !-------------------------------------------------------------------------------------------------- @@ -341,8 +270,8 @@ function source_damage_isoBrittle_postResults(phase, constituent) integer(pInt), intent(in) :: & phase, & constituent - real(pReal), dimension(source_damage_isoBrittle_sizePostResults( & - source_damage_isoBrittle_instance(phase))) :: & + real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, & + source_damage_isoBrittle_instance(phase)))) :: & source_damage_isoBrittle_postResults integer(pInt) :: & @@ -352,10 +281,9 @@ function source_damage_isoBrittle_postResults(phase, constituent) sourceOffset = source_damage_isoBrittle_offset(phase) c = 0_pInt - source_damage_isoBrittle_postResults = 0.0_pReal - do o = 1_pInt,source_damage_isoBrittle_Noutput(instance) - select case(source_damage_isoBrittle_outputID(o,instance)) + do o = 1_pInt,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) source_damage_isoBrittle_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent) c = c + 1 diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 3b4b06727..4c01f1d9a 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -12,7 +12,6 @@ module source_damage_isoDuctile implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - source_damage_isoDuctile_sizePostResults, & !< cumulative size of post results source_damage_isoDuctile_offset, & !< which source is my current damage mechanism? source_damage_isoDuctile_instance !< instance of damage source mechanism @@ -21,19 +20,12 @@ module source_damage_isoDuctile character(len=64), dimension(:,:), allocatable, target, public :: & source_damage_isoDuctile_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - source_damage_isoDuctile_Noutput !< number of outputs per instance of this damage enum, bind(c) enumerator :: undefined_ID, & damage_drivingforce_ID end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo - - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - source_damage_isoDuctile_outputID !< ID of each post result output - type, private :: tParameters !< container type for internal constitutive parameters real(pReal) :: & @@ -60,7 +52,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_isoDuctile_init(fileUnit) +subroutine source_damage_isoDuctile_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -73,14 +65,6 @@ subroutine source_damage_isoDuctile_init(fileUnit) debug_constitutive,& debug_levelBasic use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & IO_timeStamp, & @@ -100,14 +84,9 @@ subroutine source_damage_isoDuctile_init(fileUnit) MATERIAL_partPhase implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset,o integer(pInt) :: NofMyPhase,p,i - character(len=65536) :: & - tag = '', & - line = '' character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID @@ -137,12 +116,9 @@ subroutine source_damage_isoDuctile_init(fileUnit) enddo enddo - allocate(source_damage_isoDuctile_sizePostResults(Ninstance), source=0_pInt) allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_isoDuctile_output = '' - allocate(source_damage_isoDuctile_outputID(maxval(phase_Noutput),Ninstance), source=undefined_ID) - allocate(source_damage_isoDuctile_Noutput(Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -174,77 +150,30 @@ subroutine source_damage_isoDuctile_init(fileUnit) do i=1_pInt, size(outputs) outputID = undefined_ID select case(outputs(i)) + case ('isoductile_drivingforce') - + source_damage_isoDuctile_sizePostResult(i,source_damage_isoDuctile_instance(p)) = 1_pInt + source_damage_isoDuctile_output(i,source_damage_isoDuctile_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] + end select enddo end associate - enddo + phase = p + NofMyPhase=count(material_phase==phase) + instance = source_damage_isoDuctile_instance(phase) + sourceOffset = source_damage_isoDuctile_offset(phase) - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = source_damage_isoDuctile_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('isoductile_drivingforce') - source_damage_isoDuctile_Noutput(instance) = source_damage_isoDuctile_Noutput(instance) + 1_pInt - source_damage_isoDuctile_outputID(source_damage_isoDuctile_Noutput(instance),instance) = damage_drivingforce_ID - source_damage_isoDuctile_output(source_damage_isoDuctile_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - end select - endif; endif - enddo parsingFile - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_damage_isoDuctile_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_damage_isoDuctile_instance(phase) - sourceOffset = source_damage_isoDuctile_offset(phase) -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,source_damage_isoDuctile_Noutput(instance) - select case(source_damage_isoDuctile_outputID(o,instance)) - case(damage_drivingforce_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - source_damage_isoDuctile_sizePostResult(o,instance) = mySize - source_damage_isoDuctile_sizePostResults(instance) = source_damage_isoDuctile_sizePostResults(instance) + mySize - endif - enddo outputsLoop - - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) - sourceState(phase)%p(sourceOffset)%sizePostResults = source_damage_isoDuctile_sizePostResults(instance) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoDuctile_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - endif - enddo initializeInstances + enddo + end subroutine source_damage_isoDuctile_init !-------------------------------------------------------------------------------------------------- @@ -321,8 +250,8 @@ function source_damage_isoDuctile_postResults(phase, constituent) integer(pInt), intent(in) :: & phase, & constituent - real(pReal), dimension(source_damage_isoDuctile_sizePostResults( & - source_damage_isoDuctile_instance(phase))) :: & + real(pReal), dimension(sum(source_damage_isoDuctile_sizePostResult(:, & + source_damage_isoDuctile_instance(phase)))) :: & source_damage_isoDuctile_postResults integer(pInt) :: & @@ -332,10 +261,9 @@ function source_damage_isoDuctile_postResults(phase, constituent) sourceOffset = source_damage_isoDuctile_offset(phase) c = 0_pInt - source_damage_isoDuctile_postResults = 0.0_pReal - do o = 1_pInt,source_damage_isoDuctile_Noutput(instance) - select case(source_damage_isoDuctile_outputID(o,instance)) + do o = 1_pInt,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) case (damage_drivingforce_ID) source_damage_isoDuctile_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent) c = c + 1 From 47a9d88a15ebeea3dba0ce22c01954a266368b8c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 09:16:06 +0100 Subject: [PATCH 179/309] read vector-parameters --- src/source_damage_anisoBrittle.f90 | 11 ++++++++++- src/source_damage_anisoDuctile.f90 | 9 +++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index c380e9790..4a9ae1f68 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -91,6 +91,8 @@ subroutine source_damage_anisoBrittle_init(fileUnit) IO_error, & IO_timeStamp, & IO_EOF + use math, only: & + math_expand use material, only: & material_allocateSourceState, & phase_source, & @@ -175,7 +177,14 @@ subroutine source_damage_anisoBrittle_init(fileUnit) if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0' prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray) - + + prm%critDisp = config%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(prm%Ncleavage)) + prm%critLoad = config%getFloats('anisobrittle_criticalload', requiredSize=size(prm%Ncleavage)) + + ! expand: family => system + prm%critDisp = math_expand(prm%critDisp, prm%Ncleavage) + prm%critLoad = math_expand(prm%critLoad, prm%Ncleavage) + !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 46898ecf5..94e2b3a4a 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -93,6 +93,8 @@ subroutine source_damage_anisoDuctile_init(fileUnit) IO_error, & IO_timeStamp, & IO_EOF + use math, only: & + math_expand use material, only: & material_allocateSourceState, & phase_source, & @@ -176,6 +178,13 @@ subroutine source_damage_anisoDuctile_init(fileUnit) prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) + prm%critPlasticStrain = config%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(prm%Nslip)) + prm%critLoad = config%getFloats('anisoductile_criticalload', requiredSize=size(prm%Nslip)) + + ! expand: family => system + prm%critPlasticStrain = math_expand(prm%critPlasticStrain, prm%Nslip) + prm%critLoad = math_expand(prm%critLoad, prm%Nslip) + !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & From d36665187397d5cebcc8e6741be66d259230e181 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 09:57:12 +0100 Subject: [PATCH 180/309] file reading not required anymore --- src/constitutive.f90 | 6 +- src/source_damage_anisoBrittle.f90 | 97 ++++------------------------- src/source_damage_anisoDuctile.f90 | 99 ++++-------------------------- 3 files changed, 27 insertions(+), 175 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 66f0cab2f..7a28fd268 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -165,9 +165,9 @@ subroutine constitutive_init() if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init(FILEUNIT) if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init - if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init(FILEUNIT) - if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init(FILEUNIT) - + if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init + if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init + !-------------------------------------------------------------------------------------------------- ! parse kinematic mechanisms from config file call IO_checkAndRewind(FILEUNIT) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 4a9ae1f68..713f63081 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -23,10 +23,6 @@ module source_damage_anisoBrittle integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family - - real(pReal), dimension(:,:), allocatable, private :: & - source_damage_anisoBrittle_critDisp, & - source_damage_anisoBrittle_critLoad enum, bind(c) enumerator :: undefined_ID, & @@ -66,7 +62,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoBrittle_init(fileUnit) +subroutine source_damage_anisoBrittle_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -79,14 +75,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) debug_constitutive,& debug_levelBasic use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & IO_timeStamp, & @@ -107,19 +95,12 @@ subroutine source_damage_anisoBrittle_init(fileUnit) material_Nphase, & MATERIAL_partPhase use lattice, only: & - lattice_maxNcleavageFamily, & - lattice_NcleavageSystem + lattice_maxNcleavageFamily implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset integer(pInt) :: NofMyPhase,p ,i - integer(pInt) :: Nchunks_CleavageFamilies = 0_pInt, j - character(len=65536) :: & - tag = '', & - line = '' integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & @@ -154,8 +135,6 @@ subroutine source_damage_anisoBrittle_init(fileUnit) allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoBrittle_output = '' - allocate(source_damage_anisoBrittle_critDisp(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) - allocate(source_damage_anisoBrittle_critLoad(lattice_maxNcleavageFamily,Ninstance), source=0.0_pReal) allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -185,6 +164,8 @@ subroutine source_damage_anisoBrittle_init(fileUnit) prm%critDisp = math_expand(prm%critDisp, prm%Ncleavage) prm%critLoad = math_expand(prm%critLoad, prm%Ncleavage) + if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticalload' + if (any(prm%critDisp < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticaldisplacement' !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range if (extmsg /= '') & @@ -219,65 +200,10 @@ subroutine source_damage_anisoBrittle_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + + source_damage_anisoBrittle_Ncleavage(1:size(param(instance)%Ncleavage),instance) = param(instance)%Ncleavage enddo - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = source_damage_anisoBrittle_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - - case ('ncleavage') ! - Nchunks_CleavageFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_CleavageFamilies - source_damage_anisoBrittle_Ncleavage(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - - case ('anisobrittle_criticaldisplacement') - do j = 1_pInt, Nchunks_CleavageFamilies - source_damage_anisoBrittle_critDisp(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('anisobrittle_criticalload') - do j = 1_pInt, Nchunks_CleavageFamilies - source_damage_anisoBrittle_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - end select - endif; endif - enddo parsingFile - -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, material_Nphase - myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoBrittle_ID)) then - instance = source_damage_anisoBrittle_instance(phase) - - if (any(source_damage_anisoBrittle_critDisp(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//SOURCE_damage_anisoBrittle_LABEL//')') - if (any(source_damage_anisoBrittle_critLoad(1:Nchunks_CleavageFamilies,instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//SOURCE_damage_anisoBrittle_LABEL//')') - - - endif myPhase - enddo sanityChecks end subroutine source_damage_anisoBrittle_init @@ -312,7 +238,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) sourceOffset, & damageOffset, & homog, & - f, i, index_myFamily + f, i, index_myFamily, index real(pReal) :: & traction_d, traction_t, traction_n, traction_crit @@ -324,6 +250,8 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) damageOffset = damageMapping(homog)%p(ip,el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal + + index = 1_pInt do f = 1_pInt,lattice_maxNcleavageFamily index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family @@ -331,7 +259,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) - traction_crit = source_damage_anisoBrittle_critLoad(f,instance)* & + traction_crit = param(instance)%critLoad(index)* & damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & @@ -339,8 +267,9 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**param(instance)%N + & (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**param(instance)%N + & (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ & - source_damage_anisoBrittle_critDisp(f,instance) + param(instance)%critDisp(index) + index = index + 1_pInt enddo enddo diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 94e2b3a4a..b7a8f4ad2 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -25,12 +25,6 @@ module source_damage_anisoDuctile integer(pInt), dimension(:,:), allocatable, private :: & source_damage_anisoDuctile_Nslip !< number of slip systems per family - real(pReal), dimension(:,:), allocatable, private :: & - source_damage_anisoDuctile_critPlasticStrain - - real(pReal), dimension(:,:), allocatable, private :: & - source_damage_anisoDuctile_critLoad - enum, bind(c) enumerator :: undefined_ID, & damage_drivingforce_ID @@ -42,8 +36,7 @@ module source_damage_anisoDuctile aTol, & N real(pReal), dimension(:), allocatable :: & - critPlasticStrain, & - critLoad + critPlasticStrain integer(pInt) :: & totalNslip integer(pInt), dimension(:), allocatable :: & @@ -68,7 +61,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_damage_anisoDuctile_init(fileUnit) +subroutine source_damage_anisoDuctile_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -81,14 +74,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) debug_constitutive,& debug_levelBasic use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & IO_timeStamp, & @@ -109,19 +94,13 @@ subroutine source_damage_anisoDuctile_init(fileUnit) material_Nphase, & MATERIAL_partPhase use lattice, only: & - lattice_maxNslipFamily, & - lattice_NslipSystem - + lattice_maxNslipFamily + implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Ninstance,mySize=0_pInt,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset integer(pInt) :: NofMyPhase,p ,i - integer(pInt) :: Nchunks_SlipFamilies = 0_pInt, j - character(len=65536) :: & - tag = '', & - line = '' + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & @@ -156,8 +135,6 @@ subroutine source_damage_anisoDuctile_init(fileUnit) allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) source_damage_anisoDuctile_output = '' - allocate(source_damage_anisoDuctile_critLoad(lattice_maxNslipFamily,Ninstance), source=0.0_pReal) - allocate(source_damage_anisoDuctile_critPlasticStrain(lattice_maxNslipFamily,Ninstance),source=0.0_pReal) allocate(source_damage_anisoDuctile_Nslip(lattice_maxNslipFamily,Ninstance), source=0_pInt) allocate(param(Ninstance)) @@ -179,11 +156,11 @@ subroutine source_damage_anisoDuctile_init(fileUnit) prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%critPlasticStrain = config%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(prm%Nslip)) - prm%critLoad = config%getFloats('anisoductile_criticalload', requiredSize=size(prm%Nslip)) ! expand: family => system prm%critPlasticStrain = math_expand(prm%critPlasticStrain, prm%Nslip) - prm%critLoad = math_expand(prm%critLoad, prm%Nslip) + + if (any(prm%critPlasticStrain < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_criticalplasticstrain' !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range @@ -219,62 +196,9 @@ subroutine source_damage_anisoDuctile_init(fileUnit) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + source_damage_anisoDuctile_Nslip(1:size(param(instance)%Nslip),instance) = param(instance)%Nslip + enddo - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = source_damage_anisoDuctile_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - - case ('nslip') ! - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_SlipFamilies - source_damage_anisoDuctile_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - - case ('anisoductile_criticalplasticstrain') - do j = 1_pInt, Nchunks_SlipFamilies - source_damage_anisoDuctile_critPlasticStrain(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('anisoductile_criticalload') - do j = 1_pInt, Nchunks_SlipFamilies - source_damage_anisoDuctile_critLoad(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - end select - endif; endif - enddo parsingFile - -!-------------------------------------------------------------------------------------------------- -! sanity checks - sanityChecks: do phase = 1_pInt, size(phase_source) - myPhase: if (any(phase_source(:,phase) == SOURCE_damage_anisoDuctile_ID)) then - instance = source_damage_anisoDuctile_instance(phase) - - if (any(source_damage_anisoDuctile_critPlasticStrain(:,instance) < 0.0_pReal)) & - call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//SOURCE_damage_anisoDuctile_LABEL//')') - - endif myPhase - enddo sanityChecks end subroutine source_damage_anisoDuctile_init @@ -319,8 +243,7 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & plasticState(phase)%slipRate(index,constituent)/ & - ((damage(homog)%p(damageOffset))**param(instance)%N)/ & - source_damage_anisoDuctile_critPlasticStrain(f,instance) + ((damage(homog)%p(damageOffset))**param(instance)%N)/param(instance)%critPlasticStrain(index) index = index + 1_pInt enddo From dc6f18c3f8497e8aa4ec29c5ab121b2468ce2f49 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 10:03:28 +0100 Subject: [PATCH 181/309] cleaning --- src/source_damage_anisoBrittle.f90 | 6 +----- src/source_damage_anisoDuctile.f90 | 6 +----- src/source_damage_isoBrittle.f90 | 19 ++++++------------- src/source_damage_isoDuctile.f90 | 5 +---- 4 files changed, 9 insertions(+), 27 deletions(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 713f63081..e218730d5 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -75,10 +75,7 @@ subroutine source_damage_anisoBrittle_init debug_constitutive,& debug_levelBasic use IO, only: & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_error use math, only: & math_expand use material, only: & @@ -112,7 +109,6 @@ subroutine source_damage_anisoBrittle_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index b7a8f4ad2..66960ad01 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -74,10 +74,7 @@ subroutine source_damage_anisoDuctile_init debug_constitutive,& debug_levelBasic use IO, only: & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_error use math, only: & math_expand use material, only: & @@ -112,7 +109,6 @@ subroutine source_damage_anisoDuctile_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" Ninstance = int(count(phase_source == SOURCE_damage_anisoDuctile_ID),pInt) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 702ce8833..f94a568c9 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -65,10 +65,7 @@ subroutine source_damage_isoBrittle_init debug_constitutive,& debug_levelBasic use IO, only: & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_error use material, only: & material_allocateSourceState, & phase_source, & @@ -85,7 +82,7 @@ subroutine source_damage_isoBrittle_init implicit none - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset integer(pInt) :: NofMyPhase,p,i character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & @@ -97,7 +94,6 @@ subroutine source_damage_isoBrittle_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt) @@ -182,10 +178,7 @@ end subroutine source_damage_isoBrittle_init subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) use material, only: & phaseAt, phasememberAt, & - sourceState, & - material_homog, & - phase_NstiffnessDegradations, & - phase_stiffnessDegradation + sourceState use math, only : & math_sym33to6, & math_mul33x33, & @@ -202,7 +195,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) real(pReal), intent(in), dimension(6,6) :: & C integer(pInt) :: & - phase, constituent, instance, sourceOffset, mech + phase, constituent, instance, sourceOffset real(pReal) :: & strain(6), & strainenergy @@ -216,8 +209,8 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) strain = 0.5_pReal*math_sym33to6(math_mul33x33(transpose(Fe),Fe)-math_I3) - strainenergy = 2.0_pReal*sum(strain*math_mul66x6(C,strain))/ & - param(instance)%critStrainEnergy + strainenergy = 2.0_pReal*sum(strain*math_mul66x6(C,strain))/param(instance)%critStrainEnergy + if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 4c01f1d9a..ffc4408f8 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -66,9 +66,7 @@ subroutine source_damage_isoDuctile_init debug_levelBasic use IO, only: & IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_error use material, only: & material_allocateSourceState, & phase_source, & @@ -97,7 +95,6 @@ subroutine source_damage_isoDuctile_init outputs write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" Ninstance = int(count(phase_source == SOURCE_damage_isoDuctile_ID),pInt) From 5b0cdf294ddf62069c83bbe66688b1743fc2410d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 10:11:25 +0100 Subject: [PATCH 182/309] delta state is needed not sure if the offset handling is correct --- src/material.f90 | 22 ++++++++++++---------- src/source_damage_anisoBrittle.f90 | 2 +- src/source_damage_anisoDuctile.f90 | 2 +- src/source_damage_isoBrittle.f90 | 2 +- src/source_damage_isoDuctile.f90 | 4 ++-- 5 files changed, 17 insertions(+), 15 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 76753273c..2d3079030 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -970,7 +970,8 @@ end subroutine material_allocatePlasticState !-------------------------------------------------------------------------------------------------- !> @brief allocates the source state of a phase !-------------------------------------------------------------------------------------------------- -subroutine material_allocateSourceState(phase,of,NofMyPhase,sizeState) +subroutine material_allocateSourceState(phase,of,NofMyPhase,& + sizeState,sizeDotState,sizeDeltaState) use numerics, only: & numerics_integrator2 => numerics_integrator ! compatibility hack @@ -979,13 +980,14 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,sizeState) phase, & of, & NofMyPhase, & - sizeState + sizeState, sizeDotState,sizeDeltaState integer(pInt) :: numerics_integrator ! compatibility hack numerics_integrator = numerics_integrator2(1) ! compatibility hack sourceState(phase)%p(of)%sizeState = sizeState - sourceState(phase)%p(of)%sizeDotState = sizeState - sourceState(phase)%p(of)%sizeDeltaState = 0_pInt + sourceState(phase)%p(of)%sizeDotState = sizeDotState + sourceState(phase)%p(of)%sizeDeltaState = sizeDeltaState + plasticState(phase)%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition allocate(sourceState(phase)%p(of)%aTolState (sizeState), source=0.0_pReal) allocate(sourceState(phase)%p(of)%state0 (sizeState,NofMyPhase), source=0.0_pReal) @@ -993,17 +995,17 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,sizeState) allocate(sourceState(phase)%p(of)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) allocate(sourceState(phase)%p(of)%state (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(of)%dotState (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) if (numerics_integrator == 1_pInt) then - allocate(sourceState(phase)%p(of)%previousDotState (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(of)%previousDotState2 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) endif if (numerics_integrator == 4_pInt) & - allocate(sourceState(phase)%p(of)%RK4dotState (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) if (numerics_integrator == 5_pInt) & - allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (0,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) end subroutine material_allocateSourceState diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index e218730d5..5f915c5bc 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -192,7 +192,7 @@ subroutine source_damage_anisoBrittle_init sourceOffset = source_damage_anisoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 66960ad01..c4c26b9f9 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -188,7 +188,7 @@ subroutine source_damage_anisoDuctile_init instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index f94a568c9..ae0f2a0d2 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -164,7 +164,7 @@ subroutine source_damage_isoBrittle_init instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,1_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index ffc4408f8..26d97e1fb 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -83,7 +83,7 @@ subroutine source_damage_isoDuctile_init implicit none - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset,o + integer(pInt) :: Ninstance,phase,instance,source,sourceOffset integer(pInt) :: NofMyPhase,p,i character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & @@ -164,7 +164,7 @@ subroutine source_damage_isoDuctile_init instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt) + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoDuctile_sizePostResult(:,instance)) sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol From bc0bc06aea00debbfe2877f2132eca11b07901a2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Feb 2019 10:16:06 +0100 Subject: [PATCH 183/309] polishing --- src/source_damage_anisoBrittle.f90 | 4 ++-- src/source_damage_anisoDuctile.f90 | 5 ++--- src/source_damage_isoDuctile.f90 | 5 ++--- 3 files changed, 6 insertions(+), 8 deletions(-) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 5f915c5bc..98aec49b3 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -292,8 +292,8 @@ subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalph sourceOffset = source_damage_anisoBrittle_offset(phase) - localphiDot = 1.0_pReal - & - sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi + localphiDot = 1.0_pReal & + - sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index c4c26b9f9..945688e8a 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -268,9 +268,8 @@ subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalph sourceOffset = source_damage_anisoDuctile_offset(phase) - localphiDot = 1.0_pReal - & - sourceState(phase)%p(sourceOffset)%state(1,constituent)* & - phi + localphiDot = 1.0_pReal & + - sourceState(phase)%p(sourceOffset)%state(1,constituent) * phi dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 26d97e1fb..f29d60226 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -228,9 +228,8 @@ subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiD sourceOffset = source_damage_isoDuctile_offset(phase) - localphiDot = 1.0_pReal - & - sourceState(phase)%p(sourceOffset)%state(1,constituent)* & - phi + localphiDot = 1.0_pReal & + - sourceState(phase)%p(sourceOffset)%state(1,constituent) * phi dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) From 889cfc8ba039559f028b24dfeb4b102e33aa1c37 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 01:39:54 +0100 Subject: [PATCH 184/309] vtk script only work with python3 on new testing --- processing/post/vtk_addGridData.py | 2 +- processing/post/vtk_addPointcloudData.py | 2 +- processing/post/vtk_addRectilinearGridData.py | 2 +- processing/post/vtk_pointcloud.py | 2 +- processing/post/vtk_rectilinearGrid.py | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py index e0c274dc7..315071a4b 100755 --- a/processing/post/vtk_addGridData.py +++ b/processing/post/vtk_addGridData.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,vtk diff --git a/processing/post/vtk_addPointcloudData.py b/processing/post/vtk_addPointcloudData.py index 3937413c6..d75eb97b4 100755 --- a/processing/post/vtk_addPointcloudData.py +++ b/processing/post/vtk_addPointcloudData.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,vtk diff --git a/processing/post/vtk_addRectilinearGridData.py b/processing/post/vtk_addRectilinearGridData.py index 9ec384e4d..83a1451a0 100755 --- a/processing/post/vtk_addRectilinearGridData.py +++ b/processing/post/vtk_addRectilinearGridData.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,vtk diff --git a/processing/post/vtk_pointcloud.py b/processing/post/vtk_pointcloud.py index 54f02d300..a9ce1f81f 100755 --- a/processing/post/vtk_pointcloud.py +++ b/processing/post/vtk_pointcloud.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys,vtk diff --git a/processing/post/vtk_rectilinearGrid.py b/processing/post/vtk_rectilinearGrid.py index d01d118cb..c94f44228 100755 --- a/processing/post/vtk_rectilinearGrid.py +++ b/processing/post/vtk_rectilinearGrid.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys,vtk From c36e6cbbf6b9e630fb70b67b7970fb16b5e2c363 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 00:10:24 +0000 Subject: [PATCH 185/309] current software version --- .gitlab-ci.yml | 36 +++++++++++++++++------------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f1af6259f..d80e91654 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -9,7 +9,7 @@ stages: - spectral - compileMarc2018_1 - marc - - compileAbaqus2017 + - compileAbaqus2019 - example - performance - createPackage @@ -51,34 +51,32 @@ variables: # Names of module files to load # =============================================================================================== # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ - IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016" IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4" - IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017" - IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018" - GNUCompiler7_3: "Compiler/GNU/7.3" + IntelCompiler17_8: "Compiler/Intel/17.8 Libraries/IMKL/2017" + IntelCompiler18_4: "Compiler/Intel/18.4 Libraries/IMKL/2018" + GNUCompiler8_2: "Compiler/GNU/8.2" # ------------ Defaults ---------------------------------------------- - IntelCompiler: "$IntelCompiler18_1" - GNUCompiler: "$GNUCompiler7_3" + IntelCompiler: "$IntelCompiler18_4" + GNUCompiler: "$GNUCompiler8_2" # ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++ - MPICH3_2Intel18_1: "MPI/Intel/18.1/MPICH/3.2.1" - MPICH3_2GNU7_3: "MPI/GNU/7.3/MPICH/3.2.1" + IMPI2018Intel18_4: "MPI/Intel/18.4/IntelMPI/2018" + MPICH3_3GNU8_2: "MPI/GNU/8.2/MPICH/3.3" # ------------ Defaults ---------------------------------------------- - MPICH_Intel: "$MPICH3_2Intel18_1" - MPICH_GNU: "$MPICH3_2GNU7_3" + MPICH_Intel: "$IMPI2018Intel18_4" + MPICH_GNU: "$MPICH3_3GNU8_2" # ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++ - PETSc3_10_0MPICH3_2Intel18_1: "Libraries/PETSc/3.10.0/Intel-18.1-MPICH-3.2.1" - PETSc3_10_0MPICH3_2GNU7_3: "Libraries/PETSc/3.10.0/GNU-7.3-MPICH-3.2.1" + PETSc3_10_3IMPI2018Intel18_4: "Libraries/PETSc/3.10.3/Intel-18.4-IntelMPI-2018" + PETSc3_10_3MPICH3_3GNU8_2: "Libraries/PETSc/3.10.3/GNU-8.2-MPICH-3.3" # ------------ Defaults ---------------------------------------------- - PETSc_MPICH_Intel: "$PETSc3_10_0MPICH3_2Intel18_1" - PETSc_MPICH_GNU: "$PETSc3_10_0MPICH3_2GNU7_3" + PETSc_MPICH_Intel: "$PETSc3_10_3IMPI2018Intel18_4" + PETSc_MPICH_GNU: "$PETSc3_10_3MPICH3_3GNU8_2" # ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++ - Abaqus2017: "FEM/Abaqus/2017" + Abaqus2019: "FEM/Abaqus/2019" MSC2018_1: "FEM/MSC/2018.1" - MSC2017: "FEM/MSC/2017" # ------------ Defaults ---------------------------------------------- - Abaqus: "$Abaqus2017" + Abaqus: "$Abaqus2019" MSC: "$MSC2018_1" - IntelMarc: "$IntelCompiler17_0" + IntelMarc: "$IntelCompiler17_8" IntelAbaqus: "$IntelCompiler16_4" # ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++ Doxygen1_8_13: "Documentation/Doxygen/1.8.13" From 535639d933b79418353747aa02a11d4ded7ac828 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 19:08:56 +0000 Subject: [PATCH 186/309] new doxygen --- .gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index d80e91654..62e243505 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -79,9 +79,9 @@ variables: IntelMarc: "$IntelCompiler17_8" IntelAbaqus: "$IntelCompiler16_4" # ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++ - Doxygen1_8_13: "Documentation/Doxygen/1.8.13" + Doxygen1_8_15: "Documentation/Doxygen/1.8.15" # ------------ Defaults ---------------------------------------------- - Doxygen: "$Doxygen1_8_13" + Doxygen: "$Doxygen1_8_15" ################################################################################################### From 415b668e829e036b098d3286cc8859244a489828 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 19:12:31 +0000 Subject: [PATCH 187/309] tests for new server --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index beb9682ff..4909d74e0 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b +Subproject commit 4909d74e08f8f0065e2ad71ab35030e2e104d403 From dd491027486403e6a9eebed6cb41dc7b0e49cdc4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 20:37:39 +0100 Subject: [PATCH 188/309] missing update of stages --- .gitlab-ci.yml | 12 ++++++------ PRIVATE | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 62e243505..1f5536445 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -7,9 +7,9 @@ stages: - compilePETScGNU - prepareSpectral - spectral - - compileMarc2018_1 + - compileMarc - marc - - compileAbaqus2019 + - compileAbaqus - example - performance - createPackage @@ -381,9 +381,9 @@ TextureComponents: ################################################################################################### Marc_compileIfort2018_1: - stage: compileMarc2018_1 + stage: compileMarc script: - - module load $IntelCompiler17_0 $MSC2018_1 + - module load $IntelMarc $MSC - Marc_compileIfort/test.py -m 2018.1 except: - master @@ -429,9 +429,9 @@ J2_plasticBehavior: ################################################################################################### Abaqus_compile2017: - stage: compileAbaqus2017 + stage: compileAbaqus script: - - module load $IntelCompiler16_4 $Abaqus2017 + - module load $IntelCompiler16_4 $Abaqus - Abaqus_compileIfort/test.py -a 2017 except: - master diff --git a/PRIVATE b/PRIVATE index 4909d74e0..406d482f8 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 4909d74e08f8f0065e2ad71ab35030e2e104d403 +Subproject commit 406d482f8059b4459634af729ce85491a9a3245c From 2cda3cd0f9bd325d265111e442dc183e803824ea Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 20:41:37 +0100 Subject: [PATCH 189/309] only test for most recent version anyway --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 1f5536445..621db50ae 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -431,7 +431,7 @@ J2_plasticBehavior: Abaqus_compile2017: stage: compileAbaqus script: - - module load $IntelCompiler16_4 $Abaqus + - module load $IntelAbaqus $Abaqus - Abaqus_compileIfort/test.py -a 2017 except: - master From 6988047df46c8d76b83189203e3260c2aaac463a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 21:22:12 +0100 Subject: [PATCH 190/309] added repository --- README | 1 + 1 file changed, 1 insertion(+) diff --git a/README b/README index 5c5d976b6..7fc372881 100644 --- a/README +++ b/README @@ -10,3 +10,4 @@ Germany Email: DAMASK@mpie.de https://damask.mpie.de +https://magit1.mpie.de From 6abc8e7ebf7f62751ad486370dbbb53ecdc15d4e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 21:53:20 +0100 Subject: [PATCH 191/309] Abaqus 2019 is out --- CONFIG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONFIG b/CONFIG index 13b75a768..31a9c34c8 100644 --- a/CONFIG +++ b/CONFIG @@ -8,6 +8,6 @@ set DAMASK_NUM_THREADS = 4 set MSC_ROOT = /opt/msc set MARC_VERSION = 2018.1 -set ABAQUS_VERSION = 2017 +set ABAQUS_VERSION = 2019 set DAMASK_HDF5 = OFF From c4cb35891cccbed2f2d51f60e5253a8c12ea2757 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 22:56:39 +0100 Subject: [PATCH 192/309] all fine with python3 --- processing/post/addCumulative.py | 2 +- processing/post/addDerivative.py | 2 +- processing/post/blowUp.py | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/processing/post/addCumulative.py b/processing/post/addCumulative.py index 4588d915c..dfa8059dc 100755 --- a/processing/post/addCumulative.py +++ b/processing/post/addCumulative.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/processing/post/addDerivative.py b/processing/post/addDerivative.py index dc97c09ea..35ca7130b 100755 --- a/processing/post/addDerivative.py +++ b/processing/post/addDerivative.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/processing/post/blowUp.py b/processing/post/blowUp.py index 5a0d631e0..22de70d5b 100755 --- a/processing/post/blowUp.py +++ b/processing/post/blowUp.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys From 1adffb0debf3e60277d26d334a0df9432bc4674a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 23:04:28 +0100 Subject: [PATCH 193/309] tests for python3 compatible scripts --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 406d482f8..c6db7cee2 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 406d482f8059b4459634af729ce85491a9a3245c +Subproject commit c6db7cee2d9349e2d463f5ef6284446007fc7915 From 68ebb121eabd08c3afd07e9203be94d8a941c631 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 23:32:30 +0100 Subject: [PATCH 194/309] python3 test --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index c6db7cee2..999c63092 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c6db7cee2d9349e2d463f5ef6284446007fc7915 +Subproject commit 999c63092647de5e951382ba15d64b1a3f1e89be From 742d58cfcedfa3029ec1c2cc0e36f694ebf496e5 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 14 Feb 2019 18:24:09 -0500 Subject: [PATCH 195/309] added ASCIItable tests to CI pipelining --- .gitlab-ci.yml | 7 ++++ PRIVATE | 2 +- processing/post/addLinked.py | 6 +-- processing/post/addTable.py | 2 +- processing/pre/geom_grainGrowth.py | 47 ++++++++++++------------ processing/pre/seeds_fromDistribution.py | 17 +++++---- 6 files changed, 45 insertions(+), 36 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 621db50ae..e883ac986 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -156,6 +156,13 @@ Post_AverageDown: - master - release +Post_ASCIItable: + stage: postprocessing + script: ASCIItable/test.py + except: + - master + - release + Post_General: stage: postprocessing script: PostProcessing/test.py diff --git a/PRIVATE b/PRIVATE index c6db7cee2..3d12562fb 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c6db7cee2d9349e2d463f5ef6284446007fc7915 +Subproject commit 3d12562fbfb3a57dbb3777ac045a12376b3400e8 diff --git a/processing/post/addLinked.py b/processing/post/addLinked.py index d60307bc2..e0569324b 100755 --- a/processing/post/addLinked.py +++ b/processing/post/addLinked.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys @@ -21,7 +21,7 @@ Add data of selected column(s) from (first) row of linked ASCIItable that shares parser.add_option('--link', dest = 'link', nargs = 2, type = 'string', metavar = 'string string', - help = 'column labels containing linked values') + help = 'column labels of table and linked table containing linking values') parser.add_option('-l','--label', dest = 'label', action = 'extend', metavar = '', @@ -105,7 +105,7 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table try: - table.data_append(data[np.argwhere(np.all((map(float,table.data[myLink:myLink+myLinkDim]) - index)==0,axis=1))[0]]) # add data of first matching line + table.data_append(data[np.argwhere(np.all((list(map(float,table.data[myLink:myLink+myLinkDim])) - index)==0,axis=1))[0]]) # add data of first matching line except IndexError: table.data_append(np.nan*np.ones_like(data[0])) # or add NaNs outputAlive = table.data_write() # output processed line diff --git a/processing/post/addTable.py b/processing/post/addTable.py index 82799b4f5..126db6f65 100755 --- a/processing/post/addTable.py +++ b/processing/post/addTable.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/processing/pre/geom_grainGrowth.py b/processing/pre/geom_grainGrowth.py index f1394cb5f..1afb02715 100755 --- a/processing/pre/geom_grainGrowth.py +++ b/processing/pre/geom_grainGrowth.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys,math @@ -49,7 +49,7 @@ parser.set_defaults(d = 1, (options, filenames) = parser.parse_args() -options.immutable = map(int,options.immutable) +options.immutable = list(map(int,options.immutable)) getInterfaceEnergy = lambda A,B: np.float32((A*B != 0)*(A != B)*1.0) # 1.0 if A & B are distinct & nonzero, 0.0 otherwise struc = ndimage.generate_binary_structure(3,1) # 3D von Neumann neighborhood @@ -70,9 +70,9 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))), - 'size x y z: {}'.format(' x '.join(map(str,info['size']))), - 'origin x y z: {}'.format(' : '.join(map(str,info['origin']))), + damask.util.croak(['grid a b c: {}'.format(' x '.join(list(map(str,info['grid'])))), + 'size x y z: {}'.format(' x '.join(list(map(str,info['size'])))), + 'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))), 'homogenization: {}'.format(info['homogenization']), 'microstructures: {}'.format(info['microstructures']), ]) @@ -102,9 +102,9 @@ for name in filenames: gauss = np.exp(-(X*X + Y*Y + Z*Z)/(2.0*options.d*options.d),dtype=np.float32) \ /np.power(2.0*np.pi*options.d*options.d,(3.0 - np.count_nonzero(info['grid'] == 1))/2.,dtype=np.float32) - gauss[:,:,:grid[2]/2:-1] = gauss[:,:,1:(grid[2]+1)/2] # trying to cope with uneven (odd) grid size - gauss[:,:grid[1]/2:-1,:] = gauss[:,1:(grid[1]+1)/2,:] - gauss[:grid[0]/2:-1,:,:] = gauss[1:(grid[0]+1)/2,:,:] + gauss[:,:,:grid[2]//2:-1] = gauss[:,:,1:(grid[2]+1)//2] # trying to cope with uneven (odd) grid size + gauss[:,:grid[1]//2:-1,:] = gauss[:,1:(grid[1]+1)//2,:] + gauss[:grid[0]//2:-1,:,:] = gauss[1:(grid[0]+1)//2,:,:] gauss = np.fft.rfftn(gauss).astype(np.complex64) for smoothIter in range(options.N): @@ -119,9 +119,9 @@ for name in filenames: microstructure,i,axis=0), j,axis=1), k,axis=2))) # periodically extend interfacial energy array by half a grid size in positive and negative directions - periodic_interfaceEnergy = np.tile(interfaceEnergy,(3,3,3))[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] + periodic_interfaceEnergy = np.tile(interfaceEnergy,(3,3,3))[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # transform bulk volume (i.e. where interfacial energy remained zero), store index of closest boundary voxel index = ndimage.morphology.distance_transform_edt(periodic_interfaceEnergy == 0., @@ -148,15 +148,15 @@ for name in filenames: ndimage.morphology.binary_dilation(interfaceEnergy > 0., structure = struc, iterations = int(round(options.d*2.))-1),# fat boundary - periodic_bulkEnergy[grid[0]/2:-grid[0]/2, # retain filled energy on fat boundary... - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2], # ...and zero everywhere else + periodic_bulkEnergy[grid[0]//2:-grid[0]//2, # retain filled energy on fat boundary... + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2], # ...and zero everywhere else 0.)).astype(np.complex64) * gauss).astype(np.float32) - periodic_diffusedEnergy = np.tile(diffusedEnergy,(3,3,3))[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] # periodically extend the smoothed bulk energy + periodic_diffusedEnergy = np.tile(diffusedEnergy,(3,3,3))[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # periodically extend the smoothed bulk energy # transform voxels close to interface region @@ -164,15 +164,15 @@ for name in filenames: return_distances = False, return_indices = True) # want index of closest bulk grain - periodic_microstructure = np.tile(microstructure,(3,3,3))[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] # periodically extend the microstructure + periodic_microstructure = np.tile(microstructure,(3,3,3))[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # periodically extend the microstructure microstructure = periodic_microstructure[index[0], index[1], - index[2]].reshape(2*grid)[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] # extent grains into interface region + index[2]].reshape(2*grid)[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # extent grains into interface region # replace immutable microstructures with closest mutable ones index = ndimage.morphology.distance_transform_edt(np.in1d(microstructure,options.immutable).reshape(grid), @@ -236,3 +236,4 @@ for name in filenames: # --- output finalization -------------------------------------------------------------------------- table.close() + \ No newline at end of file diff --git a/processing/pre/seeds_fromDistribution.py b/processing/pre/seeds_fromDistribution.py index 3b9005032..2e8936f27 100755 --- a/processing/pre/seeds_fromDistribution.py +++ b/processing/pre/seeds_fromDistribution.py @@ -1,10 +1,11 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import threading,time,os,sys,random import numpy as np from optparse import OptionParser -from cStringIO import StringIO +from io import StringIO +import binascii import damask scriptName = os.path.splitext(os.path.basename(__file__))[0] @@ -96,7 +97,7 @@ class myThread (threading.Thread): perturbedGeomVFile = StringIO() perturbedSeedsVFile.reset() perturbedGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+ - ' -g '+' '.join(map(str, options.grid)),streamIn=perturbedSeedsVFile)[0]) + ' -g '+' '.join(list(map(str, options.grid))),streamIn=perturbedSeedsVFile)[0]) perturbedGeomVFile.reset() #--- evaluate current seeds file ---------------------------------------------------------------------- @@ -214,7 +215,7 @@ options = parser.parse_args()[0] damask.util.report(scriptName,options.seedFile) if options.randomSeed is None: - options.randomSeed = int(os.urandom(4).encode('hex'), 16) + options.randomSeed = int(binascii.hexlify(os.urandom(4)),16) damask.util.croak(options.randomSeed) delta = (options.scale/options.grid[0],options.scale/options.grid[1],options.scale/options.grid[2]) baseFile=os.path.splitext(os.path.basename(options.seedFile))[0] @@ -240,17 +241,17 @@ if os.path.isfile(os.path.splitext(options.seedFile)[0]+'.seeds'): for line in initialSeedFile: bestSeedsVFile.write(line) else: bestSeedsVFile.write(damask.util.execute('seeds_fromRandom'+\ - ' -g '+' '.join(map(str, options.grid))+\ + ' -g '+' '.join(list(map(str, options.grid)))+\ ' -r {:d}'.format(options.randomSeed)+\ ' -N '+str(nMicrostructures))[0]) bestSeedsUpdate = time.time() # ----------- tessellate initial seed file to get and evaluate geom file -bestSeedsVFile.reset() +bestSeedsVFile.seek(0) initialGeomVFile = StringIO() initialGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+ - ' -g '+' '.join(map(str, options.grid)),bestSeedsVFile)[0]) -initialGeomVFile.reset() + ' -g '+' '.join(list(map(str, options.grid))),bestSeedsVFile)[0]) +initialGeomVFile.seek(0) initialGeomTable = damask.ASCIItable(initialGeomVFile,None,labeled=False,readonly=True) initialGeomTable.head_read() info,devNull = initialGeomTable.head_getGeom() From dc133344b65537d97372c38a9d493d363e81a169 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 14 Feb 2019 18:43:34 -0500 Subject: [PATCH 196/309] [skip ci] migrated to python3 compatibility --- processing/pre/geom_toTable.py | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/processing/pre/geom_toTable.py b/processing/pre/geom_toTable.py index eb6bdde61..a29ef7afb 100755 --- a/processing/pre/geom_toTable.py +++ b/processing/pre/geom_toTable.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys @@ -48,11 +48,11 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures'], + damask.util.croak(['grid a b c: {}'.format(' x '.join(list(map(str,info['grid'])))), + 'size x y z: {}'.format(' x '.join(list(map(str,info['size'])))), + 'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))), + 'homogenization: {}'.format(info['homogenization']), + 'microstructures: {}'.format(info['microstructures']), ]) errors = [] From 5ef219cdb9420e0b6a6797cebeca88058d727c08 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 06:05:12 +0100 Subject: [PATCH 197/309] module name was renamed --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index e883ac986..bcb0952db 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -51,7 +51,7 @@ variables: # Names of module files to load # =============================================================================================== # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ - IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4" + IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016" IntelCompiler17_8: "Compiler/Intel/17.8 Libraries/IMKL/2017" IntelCompiler18_4: "Compiler/Intel/18.4 Libraries/IMKL/2018" GNUCompiler8_2: "Compiler/GNU/8.2" From 31b3cca1ad825ed4009551bbe8f63e46acb8fc7c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 06:42:19 +0100 Subject: [PATCH 198/309] [skip ci] also python3 compatible --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 3d12562fb..3358be226 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3d12562fbfb3a57dbb3777ac045a12376b3400e8 +Subproject commit 3358be226989780b4969554e688a1bdff3d02c70 From 1567b0ee94ea840987e856e69347618cab0437c3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 07:03:52 +0100 Subject: [PATCH 199/309] was not used --- src/plastic_nonlocal.f90 | 361 +-------------------------------------- 1 file changed, 5 insertions(+), 356 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index cba989cb5..ccb38d0c9 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -43,8 +43,8 @@ module plastic_nonlocal integer(pInt), dimension(:), allocatable, public, protected :: & plastic_nonlocal_sizeDotState, & !< number of dotStates = number of basic state variables plastic_nonlocal_sizeDependentState, & !< number of dependent state variables - plastic_nonlocal_sizeState, & !< total number of state variables - plastic_nonlocal_sizePostResults !< cumulative size of post results + plastic_nonlocal_sizeState !< total number of state variables + integer(pInt), dimension(:,:), allocatable, target, public :: & plastic_nonlocal_sizePostResult !< size of each post result output @@ -204,8 +204,7 @@ module plastic_nonlocal plastic_nonlocal_postResults private :: & - plastic_nonlocal_kinetics, & - plastic_nonlocal_dislocationstress + plastic_nonlocal_kinetics contains @@ -298,7 +297,6 @@ integer(pInt) :: phase, & allocate(plastic_nonlocal_sizeDotState(maxNinstances), source=0_pInt) allocate(plastic_nonlocal_sizeDependentState(maxNinstances), source=0_pInt) allocate(plastic_nonlocal_sizeState(maxNinstances), source=0_pInt) -allocate(plastic_nonlocal_sizePostResults(maxNinstances), source=0_pInt) allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0_pInt) allocate(plastic_nonlocal_Noutput(maxNinstances), source=0_pInt) allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) @@ -924,12 +922,11 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), if (mySize > 0_pInt) then ! any meaningful output found plastic_nonlocal_sizePostResult(o,instance) = mySize - plastic_nonlocal_sizePostResults(instance) = plastic_nonlocal_sizePostResults(instance) + mySize endif enddo outputsLoop - plasticState(phase)%sizePostResults = plastic_nonlocal_sizePostResults(instance) + plasticState(phase)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,instance)) plasticState(phase)%nonlocal = .true. call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & totalNslip(instance),0_pInt,0_pInt) @@ -2785,353 +2782,6 @@ compatibility(1:2,1:ns,1:ns,1:Nneighbors,i,e) = my_compatibility end subroutine plastic_nonlocal_updateCompatibility -!********************************************************************* -!* calculates quantities characterizing the microstructure * -!********************************************************************* -function plastic_nonlocal_dislocationstress(Fe, ip, el) -use prec, only: & - dEq0 -use math, only: math_mul33x33, & - math_mul33x3, & - math_inv33, & - math_transpose33, & - pi -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & - mesh_element, & - mesh_node0, & - mesh_cellCenterCoordinates, & - mesh_ipVolume, & - mesh_periodicSurface, & - FE_Nips, & - FE_geomtype -use material, only: homogenization_maxNgrains, & - material_phase, & - plasticState, & - phaseAt, phasememberAt,& - phase_localPlasticity, & - phase_plasticityInstance -use lattice, only: lattice_mu, & - lattice_nu - -implicit none - -!*** input variables -integer(pInt), intent(in) :: ip, & !< current integration point - el !< current element -real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & - Fe !< elastic deformation gradient - -!*** output variables -real(pReal), dimension(3,3) :: plastic_nonlocal_dislocationstress - -!*** local variables -integer(pInt) neighbor_el, & !< element number of neighbor material point - neighbor_ip, & !< integration point of neighbor material point - instance, & !< my instance of this plasticity - neighbor_instance, & !< instance of this plasticity of neighbor material point - ph, & - neighbor_phase, & - ns, & !< total number of active slip systems at my material point - neighbor_ns, & !< total number of active slip systems at neighbor material point - c, & !< index of dilsocation character (edge, screw) - s, & !< slip system index - o,& !< offset shortcut - no,& !< neighbour offset shortcut - p,& !< phase shortcut - np,& !< neighbour phase shortcut - t, & !< index of dilsocation type (e+, e-, s+, s-, used e+, used e-, used s+, used s-) - dir, & - deltaX, deltaY, deltaZ, & - side, & - j -integer(pInt), dimension(2,3) :: periodicImages -real(pReal) x, y, z, & !< coordinates of connection vector in neighbor lattice frame - xsquare, ysquare, zsquare, & !< squares of respective coordinates - distance, & !< length of connection vector - segmentLength, & !< segment length of dislocations - lambda, & - R, Rsquare, Rcube, & - denominator, & - flipSign, & - neighbor_ipVolumeSideLength -real(pReal), dimension(3) :: connection, & !< connection vector between me and my neighbor in the deformed configuration - connection_neighborLattice, & !< connection vector between me and my neighbor in the lattice configuration of my neighbor - connection_neighborSlip, & !< connection vector between me and my neighbor in the slip system frame of my neighbor - maxCoord, minCoord, & - meshSize, & - coords, & !< x,y,z coordinates of cell center of ip volume - neighbor_coords !< x,y,z coordinates of cell center of neighbor ip volume -real(pReal), dimension(3,3) :: sigma, & !< dislocation stress for one slip system in neighbor material point's slip system frame - Tdislo_neighborLattice, & !< dislocation stress as 2nd Piola-Kirchhoff stress at neighbor material point - invFe, & !< inverse of my elastic deformation gradient - neighbor_invFe, & - neighborLattice2myLattice !< mapping from neighbor MPs lattice configuration to my lattice configuration -real(pReal), dimension(2,2,maxval(totalNslip)) :: & - neighbor_rhoExcess !< excess density at neighbor material point (edge/screw,mobile/dead,slipsystem) -real(pReal), dimension(2,maxval(totalNslip)) :: & - rhoExcessDead -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & - rhoSgl ! single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) - -ph = material_phase(1_pInt,ip,el) -instance = phase_plasticityInstance(ph) -ns = totalNslip(instance) -p = phaseAt(1,ip,el) -o = phasememberAt(1,ip,el) - -!*** get basic states - -forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(plasticState(p)%state(iRhoU(s,t,instance),o), 0.0_pReal) ! ensure positive single mobile densities - rhoSgl(s,t+4_pInt) = plasticState(p)%state(iRhoB(s,t,instance),o) -endforall - - - -!*** calculate the dislocation stress of the neighboring excess dislocation densities -!*** zero for material points of local plasticity - -plastic_nonlocal_dislocationstress = 0.0_pReal - -if (.not. phase_localPlasticity(ph)) then - invFe = math_inv33(Fe(1:3,1:3,1_pInt,ip,el)) - - !* in case of periodic surfaces we have to find out how many periodic images in each direction we need - - do dir = 1_pInt,3_pInt - maxCoord(dir) = maxval(mesh_node0(dir,:)) - minCoord(dir) = minval(mesh_node0(dir,:)) - enddo - meshSize = maxCoord - minCoord - coords = mesh_cellCenterCoordinates(ip,el) - periodicImages = 0_pInt - do dir = 1_pInt,3_pInt - if (mesh_periodicSurface(dir)) then - periodicImages(1,dir) = floor((coords(dir) - cutoffRadius(instance) - minCoord(dir)) / meshSize(dir), pInt) - periodicImages(2,dir) = ceiling((coords(dir) + cutoffRadius(instance) - maxCoord(dir)) / meshSize(dir), pInt) - endif - enddo - - - !* loop through all material points (also through their periodic images if present), - !* but only consider nonlocal neighbors within a certain cutoff radius R - - do neighbor_el = 1_pInt,mesh_NcpElems - ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))) - neighbor_phase = material_phase(1_pInt,neighbor_ip,neighbor_el) - np = phaseAt(1,neighbor_ip,neighbor_el) - no = phasememberAt(1,neighbor_ip,neighbor_el) - - if (phase_localPlasticity(neighbor_phase)) cycle - neighbor_instance = phase_plasticityInstance(neighbor_phase) - neighbor_ns = totalNslip(neighbor_instance) - neighbor_invFe = math_inv33(Fe(1:3,1:3,1,neighbor_ip,neighbor_el)) - neighbor_ipVolumeSideLength = mesh_ipVolume(neighbor_ip,neighbor_el) ** (1.0_pReal/3.0_pReal) ! reference volume used here - - forall (s = 1_pInt:neighbor_ns, c = 1_pInt:2_pInt) - neighbor_rhoExcess(c,1,s) = plasticState(np)%state(iRhoU(s,2*c-1,neighbor_instance),no) & ! positive mobiles - - plasticState(np)%state(iRhoU(s,2*c,neighbor_instance),no) ! negative mobiles - neighbor_rhoExcess(c,2,s) = abs(plasticState(np)%state(iRhoB(s,2*c-1,neighbor_instance),no)) & ! positive deads - - abs(plasticState(np)%state(iRhoB(s,2*c,neighbor_instance),no)) ! negative deads - - endforall - Tdislo_neighborLattice = 0.0_pReal - do deltaX = periodicImages(1,1),periodicImages(2,1) - do deltaY = periodicImages(1,2),periodicImages(2,2) - do deltaZ = periodicImages(1,3),periodicImages(2,3) - - - !* regular case - - if (neighbor_el /= el .or. neighbor_ip /= ip & - .or. deltaX /= 0_pInt .or. deltaY /= 0_pInt .or. deltaZ /= 0_pInt) then - - neighbor_coords = mesh_cellCenterCoordinates(neighbor_ip,neighbor_el) & - + [real(deltaX,pReal), real(deltaY,pReal), real(deltaZ,pReal)] * meshSize - connection = neighbor_coords - coords - distance = sqrt(sum(connection * connection)) - if (distance > cutoffRadius(instance)) cycle - - - !* the segment length is the minimum of the third root of the control volume and the ip distance - !* this ensures, that the central MP never sits on a neighbor dislocation segment - - connection_neighborLattice = math_mul33x3(neighbor_invFe, connection) - segmentLength = min(neighbor_ipVolumeSideLength, distance) - - - !* loop through all slip systems of the neighbor material point - !* and add up the stress contributions from egde and screw excess on these slip systems (if significant) - - do s = 1_pInt,neighbor_ns - if (all(abs(neighbor_rhoExcess(:,:,s)) < significantRho(instance))) cycle ! not significant - - - !* map the connection vector from the lattice into the slip system frame - - connection_neighborSlip = math_mul33x3(lattice2slip(1:3,1:3,s,neighbor_instance), & - connection_neighborLattice) - - - !* edge contribution to stress - sigma = 0.0_pReal - - x = connection_neighborSlip(1) - y = connection_neighborSlip(2) - z = connection_neighborSlip(3) - xsquare = x * x - ysquare = y * y - zsquare = z * z - - do j = 1_pInt,2_pInt - if (abs(neighbor_rhoExcess(1,j,s)) < significantRho(instance)) then - cycle - elseif (j > 1_pInt) then - x = connection_neighborSlip(1) & - + sign(0.5_pReal * segmentLength, & - plasticState(np)%state(iRhoB(s,1,neighbor_instance),no) & - - plasticState(np)%state(iRhoB(s,2,neighbor_instance),no)) - - xsquare = x * x - endif - - flipSign = sign(1.0_pReal, -y) - do side = 1_pInt,-1_pInt,-2_pInt - lambda = real(side,pReal) * 0.5_pReal * segmentLength - y - R = sqrt(xsquare + zsquare + lambda * lambda) - Rsquare = R * R - Rcube = Rsquare * R - denominator = R * (R + flipSign * lambda) - if (dEq0(denominator)) exit ipLoop - - sigma(1,1) = sigma(1,1) - real(side,pReal) & - * flipSign * z / denominator & - * (1.0_pReal + xsquare / Rsquare + xsquare / denominator) & - * neighbor_rhoExcess(1,j,s) - sigma(2,2) = sigma(2,2) - real(side,pReal) & - * (flipSign * 2.0_pReal * lattice_nu(ph) * z / denominator + z * lambda / Rcube) & - * neighbor_rhoExcess(1,j,s) - sigma(3,3) = sigma(3,3) + real(side,pReal) & - * flipSign * z / denominator & - * (1.0_pReal - zsquare / Rsquare - zsquare / denominator) & - * neighbor_rhoExcess(1,j,s) - sigma(1,2) = sigma(1,2) + real(side,pReal) & - * x * z / Rcube * neighbor_rhoExcess(1,j,s) - sigma(1,3) = sigma(1,3) + real(side,pReal) & - * flipSign * x / denominator & - * (1.0_pReal - zsquare / Rsquare - zsquare / denominator) & - * neighbor_rhoExcess(1,j,s) - sigma(2,3) = sigma(2,3) - real(side,pReal) & - * (lattice_nu(ph) / R - zsquare / Rcube) * neighbor_rhoExcess(1,j,s) - enddo - enddo - - !* screw contribution to stress - - x = connection_neighborSlip(1) ! have to restore this value, because position might have been adapted for edge deads before - do j = 1_pInt,2_pInt - if (abs(neighbor_rhoExcess(2,j,s)) < significantRho(instance)) then - cycle - elseif (j > 1_pInt) then - y = connection_neighborSlip(2) & - + sign(0.5_pReal * segmentLength, & - plasticState(np)%state(iRhoB(s,3,neighbor_instance),no) & - - plasticState(np)%state(iRhoB(s,4,neighbor_instance),no)) - ysquare = y * y - endif - - flipSign = sign(1.0_pReal, x) - do side = 1_pInt,-1_pInt,-2_pInt - lambda = x + real(side,pReal) * 0.5_pReal * segmentLength - R = sqrt(ysquare + zsquare + lambda * lambda) - Rsquare = R * R - Rcube = Rsquare * R - denominator = R * (R + flipSign * lambda) - if (dEq0(denominator)) exit ipLoop - - sigma(1,2) = sigma(1,2) - real(side,pReal) * flipSign * z & - * (1.0_pReal - lattice_nu(ph)) / denominator & - * neighbor_rhoExcess(2,j,s) - sigma(1,3) = sigma(1,3) + real(side,pReal) * flipSign * y & - * (1.0_pReal - lattice_nu(ph)) / denominator & - * neighbor_rhoExcess(2,j,s) - enddo - enddo - - if (all(abs(sigma) < 1.0e-10_pReal)) cycle ! SIGMA IS NOT A REAL STRESS, THATS WHY WE NEED A REALLY SMALL VALUE HERE - - !* copy symmetric parts - - sigma(2,1) = sigma(1,2) - sigma(3,1) = sigma(1,3) - sigma(3,2) = sigma(2,3) - - - !* scale stresses and map them into the neighbor material point's lattice configuration - - sigma = sigma * lattice_mu(neighbor_phase) * burgers(s,neighbor_instance) & - / (4.0_pReal * pi * (1.0_pReal - lattice_nu(neighbor_phase))) & - * mesh_ipVolume(neighbor_ip,neighbor_el) / segmentLength ! reference volume is used here (according to the segment length calculation) - Tdislo_neighborLattice = Tdislo_neighborLattice & - + math_mul33x33(math_transpose33(lattice2slip(1:3,1:3,s,neighbor_instance)), & - math_mul33x33(sigma, lattice2slip(1:3,1:3,s,neighbor_instance))) - - enddo ! slip system loop - - - !* special case of central ip volume - !* only consider dead dislocations - !* we assume that they all sit at a distance equal to half the third root of V - !* in direction of the according slip direction - - else - - forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & - - rhoExcessDead(c,s) = plasticState(p)%state(iRhoB(s,2*c-1,instance),o) & ! positive deads (here we use symmetry: if this has negative sign it is - !treated as negative density at positive position instead of positive - !density at negative position) - + plasticState(p)%state(iRhoB(s,2*c,instance),o) ! negative deads (here we use symmetry: if this has negative sign it is - !treated as positive density at positive position instead of negative - !density at negative position) - do s = 1_pInt,ns - if (all(abs(rhoExcessDead(:,s)) < significantRho(instance))) cycle ! not significant - sigma = 0.0_pReal ! all components except for sigma13 are zero - sigma(1,3) = - (rhoExcessDead(1,s) + rhoExcessDead(2,s) * (1.0_pReal - lattice_nu(ph))) & - * neighbor_ipVolumeSideLength * lattice_mu(ph) * burgers(s,instance) & - / (sqrt(2.0_pReal) * pi * (1.0_pReal - lattice_nu(ph))) - sigma(3,1) = sigma(1,3) - - Tdislo_neighborLattice = Tdislo_neighborLattice & - + math_mul33x33(math_transpose33(lattice2slip(1:3,1:3,s,instance)), & - math_mul33x33(sigma, lattice2slip(1:3,1:3,s,instance))) - - enddo ! slip system loop - - endif - - enddo ! deltaZ loop - enddo ! deltaY loop - enddo ! deltaX loop - - - !* map the stress from the neighbor MP's lattice configuration into the deformed configuration - !* and back into my lattice configuration - - neighborLattice2myLattice = math_mul33x33(invFe, Fe(1:3,1:3,1,neighbor_ip,neighbor_el)) - plastic_nonlocal_dislocationstress = plastic_nonlocal_dislocationstress & - + math_mul33x33(neighborLattice2myLattice, & - math_mul33x33(Tdislo_neighborLattice, & - math_transpose33(neighborLattice2myLattice))) - - enddo ipLoop - enddo ! element loop - -endif - -end function plastic_nonlocal_dislocationstress - !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results @@ -3170,8 +2820,7 @@ function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) ip, & !< integration point el !< element - real(pReal), dimension(plastic_nonlocal_sizePostResults(& - phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & + real(pReal), dimension(sum(plastic_nonlocal_sizePostResult(:,phase_plasticityInstance(material_phase(1_pInt,ip,el))))) :: & plastic_nonlocal_postResults integer(pInt) :: & From d78bf18483e3ba2b91fa6d0ebd83e46f1c0a58c2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 07:25:25 +0100 Subject: [PATCH 200/309] simplified output --- src/plastic_nonlocal.f90 | 408 ++++++++++++++++++--------------------- 1 file changed, 192 insertions(+), 216 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index ccb38d0c9..f095caeeb 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -189,6 +189,82 @@ module plastic_nonlocal maximumdipoleheight_screw_ID, & accumulatedshear_ID end enum + + type, private :: tParameters !< container type for internal constitutive parameters + + real(pReal) :: & + atomicVolume, & !< atomic volume + Dsd0, & !< prefactor for self-diffusion coefficient + selfDiffusionEnergy, & !< activation enthalpy for diffusion + aTolRho, & !< absolute tolerance for dislocation density in state integration + aTolShear, & !< absolute tolerance for accumulated shear in state integration + significantRho, & !< density considered significant + significantN, & !< number of dislocations considered significant + cutoffRadius, & !< cutoff radius for dislocation stress + doublekinkwidth, & !< width of a doubkle kink in multiples of the burgers vector length b + solidSolutionEnergy, & !< activation energy for solid solution in J + solidSolutionSize, & !< solid solution obstacle size in multiples of the burgers vector length + solidSolutionConcentration, & !< concentration of solid solution in atomic parts + p, & !< parameter for kinetic law (Kocks,Argon,Ashby) + q, & !< parameter for kinetic law (Kocks,Argon,Ashby) + viscosity, & !< viscosity for dislocation glide in Pa s + fattack, & !< attack frequency in Hz + rhoSglScatter, & !< standard deviation of scatter in initial dislocation density + surfaceTransmissivity, & !< transmissivity at free surface + grainboundaryTransmissivity, & !< transmissivity at grain boundary (identified by different texture) + CFLfactor, & !< safety factor for CFL flux condition + fEdgeMultiplication, & !< factor that determines how much edge dislocations contribute to multiplication (0...1) + rhoSglRandom, & + rhoSglRandomBinning, & + linetensionEffect, & + edgeJogFactor, & + mu, & + nu + + real(pReal), dimension(:), allocatable :: & + + rhoSglEdgePos0, & !< initial edge_pos dislocation density per slip system for each family and instance + rhoSglEdgeNeg0, & !< initial edge_neg dislocation density per slip system for each family and instance + rhoSglScrewPos0, & !< initial screw_pos dislocation density per slip system for each family and instance + rhoSglScrewNeg0, & !< initial screw_neg dislocation density per slip system for each family and instance + rhoDipEdge0, & !< initial edge dipole dislocation density per slip system for each family and instance + rhoDipScrew0,& !< initial screw dipole dislocation density per slip system for each family and instance + lambda0, & !< mean free path prefactor for each slip system and instance + burgers !< absolute length of burgers vector [m] for each slip system and instance + + real(pReal), dimension(:,:), allocatable :: & + interactionSlipSlip ,& !< coefficients for slip-slip interaction for each interaction type and instance + forestProjectionEdge, & !< matrix of forest projections of edge dislocations for each instance + forestProjectionScrew !< matrix of forest projections of screw dislocations for each instance + integer(pInt), dimension(:), allocatable, private :: & + iGamma, & !< state indices for accumulated shear + iRhoF !< state indices for forest density + real(pReal), dimension(:), allocatable, private :: & + nonSchmidCoeff + integer(pInt) :: totalNslip + + real(pReal), dimension(:,:,:), allocatable, private :: & + Schmid, & !< Schmid contribution + nonSchmid_pos, & + nonSchmid_neg !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) + + integer(pInt) , dimension(:) ,allocatable , public:: & + Nslip,& + slipFamily, & !< lookup table relating active slip system to slip family for each instance + slipSystemLattice, & !< lookup table relating active slip system index to lattice slip system index for each instance + colinearSystem !< colinear system to the active slip system (only valid for fcc!) + + logical, private :: & + shortRangeStressCorrection, & !< flag indicating the use of the short range stress correction by a excess density gradient term + probabilisticMultiplication + + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID !< ID of each post result output + end type tParameters + + type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance) + + integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & plastic_nonlocal_outputID !< ID of each post result output @@ -245,7 +321,7 @@ use material, only: phase_plasticity, & plasticState, & material_phase, & material_allocatePlasticState -use config, only: MATERIAL_partPhase +use config use lattice @@ -253,11 +329,14 @@ use lattice implicit none integer(pInt), intent(in) :: fileUnit + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] + real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] !*** local variables integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: phase, & maxNinstances, & - maxTotalNslip, & + maxTotalNslip, p, i, & f, & ! index of my slip family instance, & ! index of my instance of this plasticity l, & @@ -278,7 +357,10 @@ integer(pInt) :: phase, & line = '' integer(pInt) :: sizeState, sizeDotState,sizeDependentState, sizeDeltaState + integer(kind(undefined_ID)) :: & + outputID !< ID of each post result output + character(len=65536), dimension(:), allocatable :: outputs integer(pInt) :: NofMyPhase @@ -293,6 +375,7 @@ integer(pInt) :: phase, & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances !*** memory allocation for global variables +allocate(param(maxNinstances)) allocate(plastic_nonlocal_sizeDotState(maxNinstances), source=0_pInt) allocate(plastic_nonlocal_sizeDependentState(maxNinstances), source=0_pInt) @@ -347,7 +430,6 @@ allocate(minDipoleHeightPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=0.0_pReal) allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), source=0.0_pReal) - rewind(fileUnit) phase = 0_pInt do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to @@ -375,199 +457,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('rho_sgl_edge_pos_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_neg_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_pos_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_neg_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_pos_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_edge_neg_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_pos_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_sgl_screw_neg_immobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_immobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dip_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dip_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_forest') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_forest_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shearrate') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = shearrate_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resolvedstress') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resolvedstress_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resolvedstress_external') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resolvedstress_external_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resolvedstress_back') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resolvedstress_back_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resistance') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resistance_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_sgl') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_sgl_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_dip') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_dip_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_gen') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_gen_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_gen_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_sgl2dip_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_sgl2dip_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_ann_ath') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_ath_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_ann_the_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_ann_the_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_edgejogs') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_edgejogs_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_flux_mobile') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_mobile_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_flux_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rho_dot_flux_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('velocity_edge_pos') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_edge_pos_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('velocity_edge_neg') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_edge_neg_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('velocity_screw_pos') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_screw_pos_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('velocity_screw_neg') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_screw_neg_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('maximumdipoleheight_edge') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = maximumdipoleheight_edge_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('maximumdipoleheight_screw') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = maximumdipoleheight_screw_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('accumulatedshear','accumulated_shear') - plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt - plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = accumulatedshear_ID - plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select case ('nslip') if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) & call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_LABEL//')') @@ -698,10 +587,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s instance = phase_plasticityInstance(phase) if (sum(Nslip(:,instance)) <= 0_pInt) & call IO_error(211_pInt,ext_msg='Nslip ('//PLASTICITY_NONLOCAL_label//')') - do o = 1_pInt,maxval(phase_Noutput) - if(len(plastic_nonlocal_output(o,instance)) > 64_pInt) & - call IO_error(666_pInt) - enddo do f = 1_pInt,lattice_maxNslipFamily if (Nslip(f,instance) > 0_pInt) then if (rhoSglEdgePos0(f,instance) < 0.0_pReal) & @@ -911,22 +796,9 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), if (iD(ns,2,instance) /= sizeState) & ! check if last index is equal to size of state call IO_error(0_pInt, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') - - !*** determine size of postResults array - - outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) - select case(plastic_nonlocal_outputID(o,instance)) - case default - mySize = totalNslip(instance) - end select - - if (mySize > 0_pInt) then ! any meaningful output found - plastic_nonlocal_sizePostResult(o,instance) = mySize - endif - enddo outputsLoop - plasticState(phase)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,instance)) + plasticState(phase)%nonlocal = .true. call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & totalNslip(instance),0_pInt,0_pInt) @@ -1011,6 +883,110 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), endif myPhase2 enddo initializeInstances + + + do p=1_pInt, size(config_phase) + if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle + instance = phase_plasticityInstance(p) + associate(prm => param(instance), & + config => config_phase(p)) + + + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(trim(outputs(i))) + case ('rho_sgl_edge_pos_mobile') + outputID = rho_sgl_edge_pos_mobile_ID + case ('rho_sgl_edge_neg_mobile') + outputID = rho_sgl_edge_neg_mobile_ID + case ('rho_sgl_screw_pos_mobile') + outputID = rho_sgl_screw_pos_mobile_ID + case ('rho_sgl_screw_neg_mobile') + outputID = rho_sgl_screw_neg_mobile_ID + case ('rho_sgl_edge_pos_immobile') + outputID = rho_sgl_edge_pos_immobile_ID + case ('rho_sgl_edge_neg_immobile') + outputID = rho_sgl_edge_neg_immobile_ID + case ('rho_sgl_screw_pos_immobile') + outputID = rho_sgl_screw_pos_immobile_ID + case ('rho_sgl_screw_neg_immobile') + outputID = rho_sgl_screw_neg_immobile_ID + case ('rho_dip_edge') + outputID = rho_dip_edge_ID + case ('rho_dip_screw') + outputID = rho_dip_screw_ID + case ('rho_forest') + outputID = rho_forest_ID + case ('shearrate') + outputID = shearrate_ID + case ('resolvedstress') + outputID = resolvedstress_ID + case ('resolvedstress_external') + outputID = resolvedstress_external_ID + case ('resolvedstress_back') + outputID = resolvedstress_back_ID + case ('resistance') + outputID = resistance_ID + case ('rho_dot_sgl') + outputID = rho_dot_sgl_ID + case ('rho_dot_sgl_mobile') + outputID = rho_dot_sgl_mobile_ID + case ('rho_dot_dip') + outputID = rho_dot_dip_ID + case ('rho_dot_gen') + outputID = rho_dot_gen_ID + case ('rho_dot_gen_edge') + outputID = rho_dot_gen_edge_ID + case ('rho_dot_gen_screw') + outputID = rho_dot_gen_screw_ID + case ('rho_dot_sgl2dip_edge') + outputID = rho_dot_sgl2dip_edge_ID + case ('rho_dot_sgl2dip_screw') + outputID = rho_dot_sgl2dip_screw_ID + case ('rho_dot_ann_ath') + outputID = rho_dot_ann_ath_ID + case ('rho_dot_ann_the_edge') + outputID = rho_dot_ann_the_edge_ID + case ('rho_dot_ann_the_screw') + outputID = rho_dot_ann_the_screw_ID + case ('rho_dot_edgejogs') + outputID = rho_dot_edgejogs_ID + case ('rho_dot_flux_mobile') + outputID = rho_dot_flux_mobile_ID + case ('rho_dot_flux_edge') + outputID = rho_dot_flux_edge_ID + case ('rho_dot_flux_screw') + outputID = rho_dot_flux_screw_ID + case ('velocity_edge_pos') + outputID = velocity_edge_pos_ID + case ('velocity_edge_neg') + outputID = velocity_edge_neg_ID + case ('velocity_screw_pos') + outputID = velocity_screw_pos_ID + case ('velocity_screw_neg') + outputID = velocity_screw_neg_ID + case ('maximumdipoleheight_edge') + outputID = maximumdipoleheight_edge_ID + case ('maximumdipoleheight_screw') + outputID = maximumdipoleheight_screw_ID + case ('accumulatedshear','accumulated_shear') + outputID = accumulatedshear_ID + end select + + if (outputID /= undefined_ID) then + plastic_nonlocal_output(i,instance) = outputs(i) + plastic_nonlocal_sizePostResult(i,instance) = totalNslip(instance) + prm%outputID = [prm%outputID , outputID] + endif + + enddo + end associate + + plasticState(p)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,instance)) + + enddo end subroutine plastic_nonlocal_init @@ -2924,8 +2900,8 @@ forall (s = 1_pInt:ns) & lattice_sn(1:3,slipSystemLattice(s,instance),ph)) -outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) - select case(plastic_nonlocal_outputID(o,instance)) + outputsLoop: do o = 1_pInt,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) case (rho_sgl_edge_pos_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) From c50078bafceec285354d88adadf817dd3f2d949a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 14:22:26 +0100 Subject: [PATCH 201/309] short version not needed any more Abaqus version is year --- python/damask/solver/abaqus.py | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/python/damask/solver/abaqus.py b/python/damask/solver/abaqus.py index bf8691533..6826ad24b 100644 --- a/python/damask/solver/abaqus.py +++ b/python/damask/solver/abaqus.py @@ -15,14 +15,13 @@ class Abaqus(Solver): def return_run_command(self,model): env=damask.Environment() - shortVersion = re.sub('[\.,-]', '',self.version) try: - cmd='abq'+shortVersion - subprocess.check_output(['abq'+shortVersion,'information=release']) + cmd='abq'+self.version + subprocess.check_output([cmd,'information=release']) except OSError: # link to abqXXX not existing cmd='abaqus' process = subprocess.Popen(['abaqus','information=release'],stdout = subprocess.PIPE,stderr = subprocess.PIPE) detectedVersion = process.stdout.readlines()[1].split()[1] if self.version != detectedVersion: - raise Exception('found Abaqus version %s, but requested %s'%(detectedVersion,self.version)) - return '%s -job %s -user %s/src/DAMASK_abaqus interactive'%(cmd,model,env.rootDir()) + raise Exception('found Abaqus version {}, but requested {}'.format(detectedVersion,self.version)) + return '{} -job {} -user {}/src/DAMASK_abaqus interactive'.format(cmd,model,env.rootDir()) From 8b829410142d6f0f50e67dce25cac5d9ba0bdc6a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 14:23:16 +0100 Subject: [PATCH 202/309] only Abaqus 2019 is available --- .gitlab-ci.yml | 4 ++-- python/damask/solver/abaqus.py | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index bcb0952db..25616cc99 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -435,11 +435,11 @@ J2_plasticBehavior: - release ################################################################################################### -Abaqus_compile2017: +Abaqus_compile: stage: compileAbaqus script: - module load $IntelAbaqus $Abaqus - - Abaqus_compileIfort/test.py -a 2017 + - Abaqus_compileIfort/test.py except: - master - release diff --git a/python/damask/solver/abaqus.py b/python/damask/solver/abaqus.py index 6826ad24b..305e5cbe1 100644 --- a/python/damask/solver/abaqus.py +++ b/python/damask/solver/abaqus.py @@ -2,7 +2,7 @@ from .solver import Solver import damask -import subprocess,re +import subprocess class Abaqus(Solver): From 88fc37d8a7c723cf529e30cdbda406734ba7db43 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 16:22:52 +0100 Subject: [PATCH 203/309] some more work on python3 compatible scripts --- PRIVATE | 2 +- python/damask/solver/abaqus.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index 3358be226..5d43a56aa 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3358be226989780b4969554e688a1bdff3d02c70 +Subproject commit 5d43a56aa25e90462660056a45648caedd99dac6 diff --git a/python/damask/solver/abaqus.py b/python/damask/solver/abaqus.py index 305e5cbe1..22dbab045 100644 --- a/python/damask/solver/abaqus.py +++ b/python/damask/solver/abaqus.py @@ -21,7 +21,7 @@ class Abaqus(Solver): except OSError: # link to abqXXX not existing cmd='abaqus' process = subprocess.Popen(['abaqus','information=release'],stdout = subprocess.PIPE,stderr = subprocess.PIPE) - detectedVersion = process.stdout.readlines()[1].split()[1] + detectedVersion = process.stdout.readlines()[1].split()[1].decode('utf-8') if self.version != detectedVersion: raise Exception('found Abaqus version {}, but requested {}'.format(detectedVersion,self.version)) return '{} -job {} -user {}/src/DAMASK_abaqus interactive'.format(cmd,model,env.rootDir()) From 566099ad810ec6d3821d25dcb93fcb36dde661d5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 18:52:47 +0100 Subject: [PATCH 204/309] automatic documentation for some post processing scripts --- .gitlab-ci.yml | 21 +++++++++++++++++++++ PRIVATE | 2 +- processing/post/addAPS34IDEstrainCoords.py | 13 ++++--------- processing/post/addCurl.py | 2 +- processing/post/addDivergence.py | 2 +- processing/post/addGradient.py | 2 +- 6 files changed, 29 insertions(+), 13 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f1af6259f..6ee973092 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -496,6 +496,27 @@ Spectral: only: - development +Processing: + stage: createDocumentation + script: + - cd $DAMASKROOT/processing/post + - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py + addAPS34IDEstrainCoords.py + addCauchy.py addCumulative.py addCurl.py + addDerivative.py addDeterminant.py addDeviator.py addDivergence.py + addEhkl.py + addGradient.py + addIndexed.py + addInfo.py + addLinked.py + addMises.py + addNorm.py + addPK2.py + addSpectralDecomposition.py addStrainTensors.py > post.html + except: + - master + - release + ################################################################################################## backupData: stage: saveDocumentation diff --git a/PRIVATE b/PRIVATE index beb9682ff..30434a528 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b +Subproject commit 30434a528f69d77eef1be91e8a2f2fc5e0f85054 diff --git a/processing/post/addAPS34IDEstrainCoords.py b/processing/post/addAPS34IDEstrainCoords.py index 1071baa91..78202d9a9 100755 --- a/processing/post/addAPS34IDEstrainCoords.py +++ b/processing/post/addAPS34IDEstrainCoords.py @@ -19,15 +19,10 @@ Transform X,Y,Z,F APS BeamLine 34 coordinates to x,y,z APS strain coordinates. """, version = scriptID) -parser.add_option('-f', - '--frame', - dest='frame', - metavar='string', - help='APS X,Y,Z coords') -parser.add_option('--depth', - dest='depth', - metavar='string', - help='depth') +parser.add_option('-f','--frame',dest='frame', nargs=3, metavar='string string string', + help='APS X,Y,Z coords') +parser.add_option('--depth', dest='depth', metavar='string', + help='depth') (options,filenames) = parser.parse_args() diff --git a/processing/post/addCurl.py b/processing/post/addCurl.py index 2716849b4..cae1ef8b0 100755 --- a/processing/post/addCurl.py +++ b/processing/post/addCurl.py @@ -49,7 +49,7 @@ def curlFFT(geomdim,field): curl_fourier = np.einsum(einsums[n],e,k_s,field_fourier)*TWOPIIMG - return np.fft.irfftn(curl_fourier,s=shapeFFT,axes=(0,1,2)).reshape([N,n]) + return np.fft.irfftn(curl_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n]) # -------------------------------------------------------------------- diff --git a/processing/post/addDivergence.py b/processing/post/addDivergence.py index 0aa4b05ae..73eb4ed9e 100755 --- a/processing/post/addDivergence.py +++ b/processing/post/addDivergence.py @@ -45,7 +45,7 @@ def divFFT(geomdim,field): div_fourier = np.einsum(einsums[n],k_s,field_fourier)*TWOPIIMG - return np.fft.irfftn(div_fourier,s=shapeFFT,axes=(0,1,2)).reshape([N,n//3]) + return np.fft.irfftn(div_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n/3]) # -------------------------------------------------------------------- diff --git a/processing/post/addGradient.py b/processing/post/addGradient.py index 83cb54064..676efb27e 100755 --- a/processing/post/addGradient.py +++ b/processing/post/addGradient.py @@ -45,7 +45,7 @@ def gradFFT(geomdim,field): k_s = np.concatenate((ki[:,:,:,None],kj[:,:,:,None],kk[:,:,:,None]),axis = 3).astype('c16') grad_fourier = np.einsum(einsums[n],field_fourier,k_s)*TWOPIIMG - return np.fft.irfftn(grad_fourier,s=shapeFFT,axes=(0,1,2)).reshape([N,3*n]) + return np.fft.irfftn(grad_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,3*n]) # -------------------------------------------------------------------- From d53d1224b8d56bf5b5c6e5b006a6d08d2b84919e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 19:01:11 +0100 Subject: [PATCH 205/309] python3 compatible test --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 5d43a56aa..18ba1ba6a 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 5d43a56aa25e90462660056a45648caedd99dac6 +Subproject commit 18ba1ba6a5e9ba446dc9311acf2acf2781614db1 From 787fc9583dd73dfec4974b1d234d9534ebd1dee6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 19:17:16 +0100 Subject: [PATCH 206/309] documenting most post processing scripts --- .gitlab-ci.yml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 6ee973092..b98d5ba5e 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -512,7 +512,13 @@ Processing: addMises.py addNorm.py addPK2.py - addSpectralDecomposition.py addStrainTensors.py > post.html + addSpectralDecomposition.py addStrainTensors.py + addTable.py + filterTable.py + perceptualUniformColorMap.py + reLabel.py + scaleData.py shiftData.py sortTable.py + viewTable.py > post.html except: - master - release From cced449dd3c0b2b270682c43436734c08ec64208 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 20:43:48 +0100 Subject: [PATCH 207/309] more scripts for autodocumentation --- .gitlab-ci.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index b98d5ba5e..47a7ca94e 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -502,10 +502,10 @@ Processing: - cd $DAMASKROOT/processing/post - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py addAPS34IDEstrainCoords.py - addCauchy.py addCumulative.py addCurl.py - addDerivative.py addDeterminant.py addDeviator.py addDivergence.py - addEhkl.py - addGradient.py + addCauchy.py addCalculation.py addCompatibilityMismatch.py addCumulative.py addCurl.py + addDerivative.py addDeterminant.py addDeviator.py addDisplacement.py addDivergence.py + addEhkl.py addEuclideanDistance.py + addGaussian.py addGradient.py addGrainID.py addIndexed.py addInfo.py addLinked.py From afdaac47af4f4675a594cd219b354c61aa82bca9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 22:54:38 +0100 Subject: [PATCH 208/309] avoid disturbing reporting --- src/DAMASK_abaqus.f | 29 ++++++++++++++++++---------- src/DAMASK_interface.f90 | 41 ++++++++++++++++++++++++++-------------- src/DAMASK_marc.f90 | 31 +++++++++++++++++++----------- src/compilation_info.f90 | 14 -------------- 4 files changed, 66 insertions(+), 49 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index 9072de95d..f17b5bb25 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -40,16 +40,25 @@ subroutine DAMASK_interface_init character(len=256) :: wd call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' + write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>' + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' + write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(a,/)') ' Version: '//DAMASKVERSION + +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md +#if __INTEL_COMPILER >= 1800 + write(6,*) 'Compiled with: ', compiler_version() + write(6,*) 'Compiler options: ', compiler_options() +#else + write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE +#endif + + write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) call getoutdir(wd, lenOutDir) ierr = CHDIR(wd) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index 7a8e77f62..630b5b921 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -143,16 +143,27 @@ subroutine DAMASK_interface_init() call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' - write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize -#include "compilation_info.f90" + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' + write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(a,/)') ' Version: '//DAMASKVERSION + +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + write(6,*) 'Compiled with: ', compiler_version() + write(6,*) 'Compiler options: ', compiler_options() +#elif defined(__INTEL_COMPILER) + write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE +#elif defined(__PGI) + write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version :', __PGIC__,& + '.', __PGIC_MINOR__ +#endif + + write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) call get_command(commandLine) chunkPos = IIO_stringPos(commandLine) @@ -219,9 +230,11 @@ subroutine DAMASK_interface_init() call get_environment_variable('USER',userName) ! ToDo: https://stackoverflow.com/questions/8953424/how-to-get-the-username-in-c-c-in-linux - write(6,'(a,a)') ' Host name: ', trim(getHostName()) - write(6,'(a,a)') ' User name: ', trim(userName) - write(6,'(a,a)') ' Command line call: ', trim(commandLine) + write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize + write(6,'(a,a)') ' Host name: ', trim(getHostName()) + write(6,'(a,a)') ' User name: ', trim(userName) + + write(6,'(/a,a)') ' Command line call: ', trim(commandLine) if (len(trim(workingDirArg)) > 0) & write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) @@ -514,4 +527,4 @@ pure function IIO_stringPos(string) end function IIO_stringPos -end module \ No newline at end of file +end module diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0c7d1adeb..845441e57 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -53,17 +53,26 @@ subroutine DAMASK_interface_init character(len=1024) :: wd call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' -#include "compilation_info.f90" + write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>' + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' + write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(a,/)') ' Version: '//DAMASKVERSION + +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md +#if __INTEL_COMPILER >= 1800 + write(6,*) 'Compiled with: ', compiler_version() + write(6,*) 'Compiler options: ', compiler_options() +#else + write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE +#endif + + write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) + inquire(5, name=wd) ! determine inputputfile wd = wd(1:scan(wd,'/',back=.true.)) ierr = CHDIR(wd) diff --git a/src/compilation_info.f90 b/src/compilation_info.f90 index 77d181a38..e69de29bb 100644 --- a/src/compilation_info.f90 +++ b/src/compilation_info.f90 @@ -1,14 +0,0 @@ -! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - write(6,*) 'Compiled with ', compiler_version() - write(6,*) 'With options ', compiler_options() -#elif defined(__INTEL_COMPILER) - write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,& - ', build date ', __INTEL_COMPILER_BUILD_DATE -#elif defined(__PGI) - write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version ', __PGIC__,& - '.', __PGIC_MINOR__ -#endif -write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ -write(6,*) -flush(6) From 4ce151c96715c0c2a3f9414e9e1204698d383b52 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 23:22:51 +0100 Subject: [PATCH 209/309] camel casing (easer for foswiki) --- processing/post/{vtk_pointcloud.py => vtk_pointCloud.py} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename processing/post/{vtk_pointcloud.py => vtk_pointCloud.py} (100%) diff --git a/processing/post/vtk_pointcloud.py b/processing/post/vtk_pointCloud.py similarity index 100% rename from processing/post/vtk_pointcloud.py rename to processing/post/vtk_pointCloud.py From 0fd547688301fda63597f402c45a225af7e89fd5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 06:42:08 +0100 Subject: [PATCH 210/309] doxygen interprets comment as doc string --- src/kinematics_thermal_expansion.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 3d1de3d0a..3696593ad 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -24,10 +24,10 @@ module kinematics_thermal_expansion integer(pInt), dimension(:), allocatable, target, public :: & kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage -! enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult -! enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output -! thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... -! end enum + enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult + enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output + thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... + end enum public :: & kinematics_thermal_expansion_init, & kinematics_thermal_expansion_initialStrain, & From 73235ab64a296164e8faaa17191fd65dc8efe2b4 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 16 Feb 2019 08:16:37 +0000 Subject: [PATCH 211/309] [skip ci] updated version information after successful test of v2.0.2-1713-g0fd54768 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6e1ce244f..c778e617c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1689-g1a471bcd +v2.0.2-1713-g0fd54768 From 9a3921ea84c16d2516ea4aaf10b13ea0416222cd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 10:20:53 +0100 Subject: [PATCH 212/309] ifdef statements grouped together unless they belong to a group of functions, like opening files or interpreting lines --- src/IO.f90 | 103 ++++++++++++++++++++++++----------------------------- 1 file changed, 47 insertions(+), 56 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index b5868fa48..04b32d396 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -68,20 +68,14 @@ contains !-------------------------------------------------------------------------------------------------- -!> @brief only outputs revision number +!> @brief does nothing. +! ToDo: needed? !-------------------------------------------------------------------------------------------------- subroutine IO_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif implicit none write(6,'(/,a)') ' <<<+- IO init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" end subroutine IO_init @@ -816,52 +810,6 @@ pure function IO_lc(string) end function IO_lc -#ifdef Marc4DAMASK -!-------------------------------------------------------------------------------------------------- -!> @brief reads file to skip (at least) N chunks (may be over multiple lines) -!-------------------------------------------------------------------------------------------------- -subroutine IO_skipChunks(fileUnit,N) - - implicit none - integer(pInt), intent(in) :: fileUnit, & !< file handle - N !< minimum number of chunks to skip - - integer(pInt) :: remainingChunks - character(len=65536) :: line - - line = '' - remainingChunks = N - - do while (trim(line) /= IO_EOF .and. remainingChunks > 0) - line = IO_read(fileUnit) - remainingChunks = remainingChunks - (size(IO_stringPos(line))-1_pInt)/2_pInt - enddo -end subroutine IO_skipChunks -#endif - - -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief extracts string value from key=value pair and check whether key matches -!-------------------------------------------------------------------------------------------------- -character(len=300) pure function IO_extractValue(pair,key) - - implicit none - character(len=*), intent(in) :: pair, & !< key=value pair - key !< key to be expected - - character(len=*), parameter :: SEP = achar(61) ! '=' - - integer :: myChunk !< position number of desired chunk - - IO_extractValue = '' - - myChunk = scan(pair,SEP) - if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches - -end function IO_extractValue -# endif - !-------------------------------------------------------------------------------------------------- !> @brief returns format string for integer values without leading zeros !-------------------------------------------------------------------------------------------------- @@ -1251,7 +1199,30 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) end subroutine IO_warning +#if defined(Abaqus) || defined(Marc4DAMASK) + #ifdef Abaqus +!-------------------------------------------------------------------------------------------------- +!> @brief extracts string value from key=value pair and check whether key matches +!-------------------------------------------------------------------------------------------------- +character(len=300) pure function IO_extractValue(pair,key) + + implicit none + character(len=*), intent(in) :: pair, & !< key=value pair + key !< key to be expected + + character(len=*), parameter :: SEP = achar(61) ! '=' + + integer :: myChunk !< position number of desired chunk + + IO_extractValue = '' + + myChunk = scan(pair,SEP) + if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches + +end function IO_extractValue + + !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- @@ -1316,10 +1287,31 @@ integer(pInt) function IO_countNumericalDataLines(fileUnit) backspace(fileUnit) end function IO_countNumericalDataLines + + +!-------------------------------------------------------------------------------------------------- +!> @brief reads file to skip (at least) N chunks (may be over multiple lines) +!-------------------------------------------------------------------------------------------------- +subroutine IO_skipChunks(fileUnit,N) + + implicit none + integer(pInt), intent(in) :: fileUnit, & !< file handle + N !< minimum number of chunks to skip + + integer(pInt) :: remainingChunks + character(len=65536) :: line + + line = '' + remainingChunks = N + + do while (trim(line) /= IO_EOF .and. remainingChunks > 0) + line = IO_read(fileUnit) + remainingChunks = remainingChunks - (size(IO_stringPos(line))-1_pInt)/2_pInt + enddo +end subroutine IO_skipChunks #endif -#if defined(Abaqus) || defined(Marc4DAMASK) !-------------------------------------------------------------------------------------------------- !> @brief count items in consecutive lines depending on lines !> @details Marc: ints concatenated by "c" as last char or range of values a "to" b @@ -1490,7 +1482,6 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) 100 end function IO_continuousIntValues #endif - !-------------------------------------------------------------------------------------------------- ! internal helper functions From 61032b5fd8d2a7fc2ada7ef89b5d5648acdce4f5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 10:24:12 +0100 Subject: [PATCH 213/309] wrong jump position probably a copy and paste error --- src/mesh_marc.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 0e0336f99..f9ba0378b 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -926,17 +926,17 @@ subroutine mesh_marc_build_elements(fileUnit) enddo 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,'(A300)',END=620) line - do !ToDo: the jumps to 620 in below code might result in a never ending loop + read (fileUnit,'(A300)',END=630) line + do chunkPos = IO_stringPos(line) if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then - if (initialcondTableStyle == 2_pInt) read (fileUnit,'(A300)',END=620) line ! read extra line for new style + if (initialcondTableStyle == 2_pInt) read (fileUnit,'(A300)',END=630) line ! read extra line for new style read (fileUnit,'(A300)',END=630) line ! read line with index of state var chunkPos = IO_stringPos(line) sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest - read (fileUnit,'(A300)',END=620) line ! read line with value of state var + read (fileUnit,'(A300)',END=630) line ! read line with value of state var chunkPos = IO_stringPos(line) do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value @@ -950,7 +950,7 @@ subroutine mesh_marc_build_elements(fileUnit) e = mesh_FEasCP('elem',contInts(1_pInt+i)) mesh_element(1_pInt+sv,e) = myVal enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=620) line ! ignore IP range for old table style + if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=630) line ! ignore IP range for old table style read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) enddo From efe9823e620ddc92fbd48f07f7843ab8b3cccca3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 10:43:02 +0100 Subject: [PATCH 214/309] clearer logic for preprocessor statements --- src/IO.f90 | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 04b32d396..42ba479cd 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -45,20 +45,19 @@ module IO IO_timeStamp #if defined(Marc4DAMASK) || defined(Abaqus) public :: & -#ifdef Abaqus - IO_extractValue, & - IO_countDataLines, & -#endif -#ifdef Marc4DAMASK - IO_skipChunks, & - IO_fixedNoEFloatValue, & - IO_fixedIntValue, & - IO_countNumericalDataLines, & -#endif IO_open_inputFile, & IO_open_logFile, & IO_countContinuousIntValues, & - IO_continuousIntValues + IO_continuousIntValues, & +#if defined(Abaqus) + IO_extractValue, & + IO_countDataLines +#elif defined(Marc4DAMASK) + IO_skipChunks, & + IO_fixedNoEFloatValue, & + IO_fixedIntValue, & + IO_countNumericalDataLines +#endif #endif private :: & IO_verifyFloatValue, & @@ -356,7 +355,7 @@ subroutine IO_open_inputFile(fileUnit,modelName) integer(pInt) :: myStat character(len=1024) :: path -#ifdef Abaqus +#if defined(Abaqus) integer(pInt) :: fileType fileType = 1_pInt ! assume .pes @@ -427,8 +426,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) 200 createSuccess =.false. end function abaqus_assembleInputFile -#endif -#ifdef Marc4DAMASK +#elif defined(Marc4DAMASK) path = trim(modelName)//inputFileExtension open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) From 77d60be1279299c3f5d113be7eef31b30c325646 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 11:30:56 +0100 Subject: [PATCH 215/309] avoid superfluous reporting --- src/DAMASK_abaqus.f | 5 +++++ src/DAMASK_marc.f90 | 5 +++++ src/mesh_abaqus.f90 | 8 -------- src/mesh_grid.f90 | 8 -------- src/mesh_marc.f90 | 9 --------- 5 files changed, 10 insertions(+), 25 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index f17b5bb25..8cd3a4930 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -30,6 +30,11 @@ contains !> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init +#if __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use ifport, only: & CHDIR diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 9b1427d78..892b2cbc4 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -43,6 +43,11 @@ contains !> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init +#if __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use ifport, only: & CHDIR diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 60b1484c1..4e923606e 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -6,7 +6,6 @@ !> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver !-------------------------------------------------------------------------------------------------- module mesh - use, intrinsic :: iso_c_binding use prec, only: pReal, pInt use mesh_base @@ -425,11 +424,6 @@ end subroutine tMesh_abaqus_init !! Order and routines strongly depend on type of solver !-------------------------------------------------------------------------------------------------- subroutine mesh_init(ip,el) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use DAMASK_interface use IO, only: & IO_open_InputFile, & @@ -458,8 +452,6 @@ subroutine mesh_init(ip,el) logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index d55c1cded..424456e3a 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -169,11 +169,6 @@ end subroutine tMesh_grid_init !! Order and routines strongly depend on type of solver !-------------------------------------------------------------------------------------------------- subroutine mesh_init(ip,el) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif #include use PETScsys @@ -206,9 +201,6 @@ subroutine mesh_init(ip,el) logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index f9ba0378b..0c7d332c9 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -6,7 +6,6 @@ !> @brief Sets up the mesh for the solver MSC.Marc !-------------------------------------------------------------------------------------------------- module mesh - use, intrinsic :: iso_c_binding use prec, only: pReal, pInt use mesh_base @@ -284,11 +283,6 @@ end subroutine tMesh_marc_init !! Order and routines strongly depend on type of solver !-------------------------------------------------------------------------------------------------- subroutine mesh_init(ip,el) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use DAMASK_interface use IO, only: & IO_open_InputFile, & @@ -322,9 +316,6 @@ subroutine mesh_init(ip,el) logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh From 63e2ea7d8f5eac38ae3ac095c8cb5eb9ed201dbe Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 12:49:28 +0100 Subject: [PATCH 216/309] was not use (anymore) --- src/IO.f90 | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 42ba479cd..3d330a2df 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -27,7 +27,6 @@ module IO IO_open_file_stat, & IO_open_jobFile_stat, & IO_open_file, & - IO_open_jobFile, & IO_write_jobFile, & IO_write_jobRealFile, & IO_read_realFile, & @@ -291,30 +290,6 @@ logical function IO_open_file_stat(fileUnit,path) end function IO_open_file_stat -!-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. File is named after solver job name -!! plus given extension and located in current working directory -!> @details like IO_open_jobFile_stat, but error is handled via call to IO_error and not via return -!! value -!-------------------------------------------------------------------------------------------------- -subroutine IO_open_jobFile(fileUnit,ext) - use DAMASK_interface, only: & - getSolverJobName - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext !< extension of file - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(getSolverJobName())//'.'//ext - open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - -end subroutine IO_open_jobFile - - !-------------------------------------------------------------------------------------------------- !> @brief opens existing file for reading to given unit. File is named after solver job name !! plus given extension and located in current working directory From fa003e8077043352181bd0f2b1f3541f4ffa0c9b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 14:53:56 +0100 Subject: [PATCH 217/309] small adjustments for autodoc --- processing/post/addCalculation.py | 17 +++++++---------- processing/post/addCumulative.py | 5 +---- processing/post/addDisplacement.py | 1 - processing/post/addGaussian.py | 5 ++--- processing/post/addGrainID.py | 6 +++--- processing/post/addInfo.py | 5 +++-- processing/post/addMises.py | 6 +----- processing/post/addNorm.py | 7 ++++++- processing/post/addOrientations.py | 5 ++--- processing/post/addPole.py | 1 - processing/post/addSchmidfactors.py | 2 +- processing/post/addStrainTensors.py | 9 ++++----- processing/post/addTable.py | 4 ++++ processing/post/averageDown.py | 8 +++----- processing/post/binXY.py | 9 +++------ processing/post/blowUp.py | 4 ++-- processing/post/rotateData.py | 2 +- 17 files changed, 43 insertions(+), 53 deletions(-) diff --git a/processing/post/addCalculation.py b/processing/post/addCalculation.py index d19855753..ebc0d95a4 100755 --- a/processing/post/addCalculation.py +++ b/processing/post/addCalculation.py @@ -41,10 +41,7 @@ parser.add_option('-f','--formula', parser.add_option('-c','--condition', dest = 'condition', metavar='string', - help = 'condition to alter existing column data') - -parser.set_defaults(condition = None, - ) + help = 'condition to alter existing column data (optional)') (options,filenames) = parser.parse_args() @@ -80,7 +77,7 @@ for name in filenames: condition = options.condition # copy per file, since might be altered inline breaker = False - for position,(all,marker,column) in enumerate(set(re.findall(r'#(([s]#)?(.+?))#',condition))): # find three groups + for position,(all,marker,column) in enumerate(set(re.findall(r'#(([s]#)?(.+?))#',condition))): # find three groups idx = table.label_index(column) dim = table.label_dimension(column) if idx < 0 and column not in specials: @@ -89,15 +86,15 @@ for name in filenames: else: if column in specials: replacement = 'specials["{}"]'.format(column) - elif dim == 1: # scalar input + elif dim == 1: # scalar input replacement = '{}(table.data[{}])'.format({ '':'float', - 's#':'str'}[marker],idx) # take float or string value of data column - elif dim > 1: # multidimensional input (vector, tensor, etc.) - replacement = 'np.array(table.data[{}:{}],dtype=float)'.format(idx,idx+dim) # use (flat) array representation + 's#':'str'}[marker],idx) # take float or string value of data column + elif dim > 1: # multidimensional input (vector, tensor, etc.) + replacement = 'np.array(table.data[{}:{}],dtype=float)'.format(idx,idx+dim) # use (flat) array representation condition = condition.replace('#'+all+'#',replacement) - if breaker: continue # found mistake in condition evaluation --> next file + if breaker: continue # found mistake in condition evaluation --> next file # ------------------------------------------ build formulas ---------------------------------------- diff --git a/processing/post/addCumulative.py b/processing/post/addCumulative.py index dfa8059dc..37ad6e0ce 100755 --- a/processing/post/addCumulative.py +++ b/processing/post/addCumulative.py @@ -22,12 +22,9 @@ parser.add_option('-l','--label', action = 'extend', metavar = '', help = 'columns to cumulate') -parser.set_defaults(label = [], - ) - (options,filenames) = parser.parse_args() -if len(options.label) == 0: +if options.label is None: parser.error('no data column(s) specified.') # --- loop over input files ------------------------------------------------------------------------- diff --git a/processing/post/addDisplacement.py b/processing/post/addDisplacement.py index ff9d251f7..76b044106 100755 --- a/processing/post/addDisplacement.py +++ b/processing/post/addDisplacement.py @@ -111,7 +111,6 @@ parser.add_option('--nodal', parser.set_defaults(defgrad = 'f', pos = 'pos', - nodal = False, ) (options,filenames) = parser.parse_args() diff --git a/processing/post/addGaussian.py b/processing/post/addGaussian.py index f468790ef..cb610ba67 100755 --- a/processing/post/addGaussian.py +++ b/processing/post/addGaussian.py @@ -34,12 +34,12 @@ parser.add_option('-o','--order', dest = 'order', type = int, metavar = 'int', - help = 'order of the filter') + help = 'order of the filter [%default]') parser.add_option('--sigma', dest = 'sigma', type = float, metavar = 'float', - help = 'standard deviation') + help = 'standard deviation [%default]') parser.add_option('--periodic', dest = 'periodic', action = 'store_true', @@ -50,7 +50,6 @@ parser.add_option('--periodic', parser.set_defaults(pos = 'pos', order = 0, sigma = 1, - periodic = False, ) (options,filenames) = parser.parse_args() diff --git a/processing/post/addGrainID.py b/processing/post/addGrainID.py index 3c4eaf4fa..6493736d8 100755 --- a/processing/post/addGrainID.py +++ b/processing/post/addGrainID.py @@ -28,9 +28,9 @@ parser.add_option('-d', help = 'disorientation threshold in degrees [%default]') parser.add_option('-s', '--symmetry', - dest = 'symmetry', + dest = 'symmetry', type = 'choice', choices = damask.Symmetry.lattices[1:], metavar = 'string', - help = 'crystal symmetry [%default]') + help = 'crystal symmetry [%default] {{{}}} '.format(', '.join(damask.Symmetry.lattices[1:]))) parser.add_option('-o', '--orientation', dest = 'quaternion', @@ -49,7 +49,7 @@ parser.add_option('--quiet', parser.set_defaults(disorientation = 5, verbose = True, quaternion = 'orientation', - symmetry = 'cubic', + symmetry = damask.Symmetry.lattices[-1], pos = 'pos', ) diff --git a/processing/post/addInfo.py b/processing/post/addInfo.py index 59efcd973..feb316f45 100755 --- a/processing/post/addInfo.py +++ b/processing/post/addInfo.py @@ -23,11 +23,12 @@ parser.add_option('-i', dest = 'info', action = 'extend', metavar = '', help = 'items to add') -parser.set_defaults(info = [], - ) (options,filenames) = parser.parse_args() +if options.info is None: + parser.error('no info specified.') + # --- loop over input files ------------------------------------------------------------------------ if filenames == []: filenames = [None] diff --git a/processing/post/addMises.py b/processing/post/addMises.py index 7e757ed9d..789540072 100755 --- a/processing/post/addMises.py +++ b/processing/post/addMises.py @@ -38,13 +38,9 @@ parser.add_option('-s','--stress', action = 'extend', metavar = '', help = 'heading(s) of columns containing stress tensors') -parser.set_defaults(strain = [], - stress = [], - ) - (options,filenames) = parser.parse_args() -if len(options.stress+options.strain) == 0: +if options.stress is None and options.strain is None: parser.error('no data column specified...') # --- loop over input files ------------------------------------------------------------------------- diff --git a/processing/post/addNorm.py b/processing/post/addNorm.py index f90cd4b31..6f879e935 100755 --- a/processing/post/addNorm.py +++ b/processing/post/addNorm.py @@ -9,6 +9,7 @@ scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) # definition of element-wise p-norms for matrices +# ToDo: better use numpy.linalg.norm def norm(which,object): @@ -18,6 +19,8 @@ def norm(which,object): return math.sqrt(sum([x*x for x in object])) elif which == 'Max': # p = inf return max(map(abs, object)) + else: + return -1 # -------------------------------------------------------------------- # MAIN @@ -43,6 +46,8 @@ parser.set_defaults(norm = 'frobenius', (options,filenames) = parser.parse_args() +if options.norm.lower() not in normChoices: + parser.error('invalid norm ({}) specified.'.format(options.norm)) if options.label is None: parser.error('no data column specified.') @@ -74,7 +79,7 @@ for name in filenames: else: dims.append(dim) columns.append(table.label_index(what)) - table.labels_append('norm{}({})'.format(options.norm.capitalize(),what)) # extend ASCII header with new labels + table.labels_append('norm{}({})'.format(options.norm.capitalize(),what)) # extend ASCII header with new labels if remarks != []: damask.util.croak(remarks) if errors != []: diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index a33f96b91..41fa7a5df 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -68,12 +68,12 @@ parser.add_option('-R', '--labrotation', dest='labrotation', type = 'float', nargs = 4, metavar = ' '.join(['float']*4), - help = 'angle and axis of additional lab frame rotation') + help = 'angle and axis of additional lab frame rotation [%default]') parser.add_option('-r', '--crystalrotation', dest='crystalrotation', type = 'float', nargs = 4, metavar = ' '.join(['float']*4), - help = 'angle and axis of additional crystal frame rotation') + help = 'angle and axis of additional crystal frame rotation [%default]') parser.add_option('--eulers', dest = 'eulers', metavar = 'string', @@ -106,7 +106,6 @@ parser.add_option('-z', parser.set_defaults(output = [], labrotation = (0.,1.,1.,1.), # no rotation about 1,1,1 crystalrotation = (0.,1.,1.,1.), # no rotation about 1,1,1 - degrees = False, ) (options, filenames) = parser.parse_args() diff --git a/processing/post/addPole.py b/processing/post/addPole.py index 3098effc7..27e44e2a1 100755 --- a/processing/post/addPole.py +++ b/processing/post/addPole.py @@ -35,7 +35,6 @@ parser.add_option('-o', parser.set_defaults(pole = (1.0,0.0,0.0), quaternion = 'orientation', - polar = False, ) (options, filenames) = parser.parse_args() diff --git a/processing/post/addSchmidfactors.py b/processing/post/addSchmidfactors.py index 6335b419e..6ef6a71a0 100755 --- a/processing/post/addSchmidfactors.py +++ b/processing/post/addSchmidfactors.py @@ -115,7 +115,7 @@ parser.add_option('-l', help = 'type of lattice structure [%default] {}'.format(latticeChoices)) parser.add_option('--covera', dest = 'CoverA', type = 'float', metavar = 'float', - help = 'C over A ratio for hexagonal systems') + help = 'C over A ratio for hexagonal systems [%default]') parser.add_option('-f', '--force', dest = 'force', diff --git a/processing/post/addStrainTensors.py b/processing/post/addStrainTensors.py index bffc92f9a..7e16d976c 100755 --- a/processing/post/addStrainTensors.py +++ b/processing/post/addStrainTensors.py @@ -56,16 +56,15 @@ parser.add_option('-f','--defgrad', metavar = '', help = 'heading(s) of columns containing deformation tensor values [%default]') -parser.set_defaults(right = False, - left = False, - logarithmic = False, - biot = False, - green = False, +parser.set_defaults( defgrad = ['f'], ) (options,filenames) = parser.parse_args() +if len(options.defgrad) > 1: + options.defgrad = options.defgrad[1:] + stretches = [] strains = [] diff --git a/processing/post/addTable.py b/processing/post/addTable.py index 126db6f65..8bcb43d70 100755 --- a/processing/post/addTable.py +++ b/processing/post/addTable.py @@ -24,6 +24,10 @@ parser.add_option('-a', '--add','--table', (options,filenames) = parser.parse_args() +if options.table is None: + parser.error('no table specified.') + + # --- loop over input files ------------------------------------------------------------------------- if filenames == []: filenames = [None] diff --git a/processing/post/averageDown.py b/processing/post/averageDown.py index 96520a789..ac7cc00dd 100755 --- a/processing/post/averageDown.py +++ b/processing/post/averageDown.py @@ -34,16 +34,14 @@ parser.add_option('--shift', parser.add_option('-g', '--grid', dest = 'grid', type = 'int', nargs = 3, metavar = 'int int int', - help = 'grid in x,y,z [autodetect]') + help = 'grid in x,y,z (optional)') parser.add_option('-s', '--size', dest = 'size', type = 'float', nargs = 3, metavar = 'float float float', - help = 'size in x,y,z [autodetect]') + help = 'size in x,y,z (optional)') parser.set_defaults(pos = 'pos', packing = (2,2,2), shift = (0,0,0), - grid = (0,0,0), - size = (0.0,0.0,0.0), ) (options,filenames) = parser.parse_args() @@ -92,7 +90,7 @@ for name in filenames: table.data_readArray() - if (any(options.grid) == 0 or any(options.size) == 0.0): + if (options.grid is None or options.size is None): grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) else: grid = np.array(options.grid,'i') diff --git a/processing/post/binXY.py b/processing/post/binXY.py index ea73d13b9..2c148e69a 100755 --- a/processing/post/binXY.py +++ b/processing/post/binXY.py @@ -37,15 +37,15 @@ parser.add_option('-t','--type', parser.add_option('-x','--xrange', dest = 'xrange', type = 'float', nargs = 2, metavar = 'float float', - help = 'min max value in x direction [autodetect]') + help = 'min max limits in x direction (optional)') parser.add_option('-y','--yrange', dest = 'yrange', type = 'float', nargs = 2, metavar = 'float float', - help = 'min max value in y direction [autodetect]') + help = 'min max limits in y direction (optional)') parser.add_option('-z','--zrange', dest = 'zrange', type = 'float', nargs = 2, metavar = 'float float', - help = 'min max value in z direction [autodetect]') + help = 'min max limits in z direction (optional)') parser.add_option('-i','--invert', dest = 'invert', action = 'store_true', @@ -64,9 +64,6 @@ parser.set_defaults(bins = (10,10), xrange = (0.0,0.0), yrange = (0.0,0.0), zrange = (0.0,0.0), - invert = False, - normRow = False, - normCol = False, ) (options,filenames) = parser.parse_args() diff --git a/processing/post/blowUp.py b/processing/post/blowUp.py index 22de70d5b..e06791afe 100755 --- a/processing/post/blowUp.py +++ b/processing/post/blowUp.py @@ -27,10 +27,10 @@ parser.add_option('-p','--packing', help = 'dimension of packed group [%default]') parser.add_option('-g','--grid', dest = 'resolution', type = 'int', nargs = 3, metavar = 'int int int', - help = 'resolution in x,y,z [autodetect]') + help = 'grid in x,y,z (optional)') parser.add_option('-s','--size', dest = 'dimension', type = 'float', nargs = 3, metavar = 'int int int', - help = 'dimension in x,y,z [autodetect]') + help = 'size in x,y,z (optional)') parser.set_defaults(pos = 'pos', packing = (2,2,2), grid = (0,0,0), diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 95102345b..1ac4a9354 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -29,7 +29,7 @@ parser.add_option('-r', '--rotation', parser.add_option('--degrees', dest = 'degrees', action = 'store_true', - help = 'angles are given in degrees [%default]') + help = 'angles are given in degrees') parser.set_defaults(rotation = (0.,1.,1.,1.), # no rotation about 1,1,1 degrees = False, From aaf243b3daf19a138d45d0c2fcad54436dab8ace Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 15:27:01 +0100 Subject: [PATCH 218/309] simpler logic: define exceptions --- .gitlab-ci.yml | 21 ++------------------- PRIVATE | 2 +- 2 files changed, 3 insertions(+), 20 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 58e74a0fd..a021455e1 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -505,25 +505,8 @@ Processing: stage: createDocumentation script: - cd $DAMASKROOT/processing/post - - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py - addAPS34IDEstrainCoords.py - addCauchy.py addCalculation.py addCompatibilityMismatch.py addCumulative.py addCurl.py - addDerivative.py addDeterminant.py addDeviator.py addDisplacement.py addDivergence.py - addEhkl.py addEuclideanDistance.py - addGaussian.py addGradient.py addGrainID.py - addIndexed.py - addInfo.py - addLinked.py - addMises.py - addNorm.py - addPK2.py - addSpectralDecomposition.py addStrainTensors.py - addTable.py - filterTable.py - perceptualUniformColorMap.py - reLabel.py - scaleData.py shiftData.py sortTable.py - viewTable.py > post.html + - rm marc_to_vtk.py vtk2ang.py + - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py * except: - master - release diff --git a/PRIVATE b/PRIVATE index 18ba1ba6a..6b968ff1c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 18ba1ba6a5e9ba446dc9311acf2acf2781614db1 +Subproject commit 6b968ff1ce03333c2db386167f9740ce6e22443b From 29fc53fdcbda6071061d6711ae813a5bc09d828d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 17:41:56 +0100 Subject: [PATCH 219/309] more specific about invocation --- processing/post/addAPS34IDEstrainCoords.py | 2 +- processing/post/addCalculation.py | 2 +- processing/post/addCauchy.py | 4 ++-- processing/post/addCompatibilityMismatch.py | 2 +- processing/post/addCumulative.py | 2 +- processing/post/addCurl.py | 2 +- processing/post/addDerivative.py | 2 +- processing/post/addDeterminant.py | 2 +- processing/post/addDeviator.py | 2 +- processing/post/addDisplacement.py | 2 +- processing/post/addEhkl.py | 2 +- processing/post/addEuclideanDistance.py | 2 +- processing/post/addGaussian.py | 2 +- processing/post/addGradient.py | 2 +- processing/post/addIPFcolor.py | 2 +- processing/post/addIndexed.py | 2 +- processing/post/addInfo.py | 2 +- processing/post/reLabel.py | 2 +- processing/post/viewTable.py | 2 +- processing/post/vtk_pointCloud.py | 2 +- processing/post/vtk_rectilinearGrid.py | 2 +- 21 files changed, 22 insertions(+), 22 deletions(-) diff --git a/processing/post/addAPS34IDEstrainCoords.py b/processing/post/addAPS34IDEstrainCoords.py index 78202d9a9..8bfca35d3 100755 --- a/processing/post/addAPS34IDEstrainCoords.py +++ b/processing/post/addAPS34IDEstrainCoords.py @@ -14,7 +14,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Transform X,Y,Z,F APS BeamLine 34 coordinates to x,y,z APS strain coordinates. """, version = scriptID) diff --git a/processing/post/addCalculation.py b/processing/post/addCalculation.py index ebc0d95a4..73edde9e8 100755 --- a/processing/post/addCalculation.py +++ b/processing/post/addCalculation.py @@ -18,7 +18,7 @@ def listify(x): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add or alter column(s) with derived values according to user-defined arithmetic operation between column(s). Column labels are tagged by '#label#' in formulas. Use ';' for ',' in functions. Numpy is available as 'np'. diff --git a/processing/post/addCauchy.py b/processing/post/addCauchy.py index 3c873f2aa..c7b95f562 100755 --- a/processing/post/addCauchy.py +++ b/processing/post/addCauchy.py @@ -13,8 +13,8 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ -Add column(s) containing Cauchy stress based on given column(s) of deformation gradient and first Piola--Kirchhoff stress. +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ +Add column containing Cauchy stress based on deformation gradient and first Piola--Kirchhoff stress. """, version = scriptID) diff --git a/processing/post/addCompatibilityMismatch.py b/processing/post/addCompatibilityMismatch.py index 7d2a89fa0..1fe84bf2b 100755 --- a/processing/post/addCompatibilityMismatch.py +++ b/processing/post/addCompatibilityMismatch.py @@ -209,7 +209,7 @@ def shapeMismatch(size,F,nodes,centres): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options file[s]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing the shape and volume mismatch resulting from given deformation gradient. Operates on periodic three-dimensional x,y,z-ordered data sets. diff --git a/processing/post/addCumulative.py b/processing/post/addCumulative.py index 37ad6e0ce..392cbd69e 100755 --- a/processing/post/addCumulative.py +++ b/processing/post/addCumulative.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add cumulative (sum of first to current row) values for given label(s). """, version = scriptID) diff --git a/processing/post/addCurl.py b/processing/post/addCurl.py index cae1ef8b0..5c9d46e2f 100755 --- a/processing/post/addCurl.py +++ b/processing/post/addCurl.py @@ -56,7 +56,7 @@ def curlFFT(geomdim,field): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing curl of requested column(s). Operates on periodic ordered three-dimensional data sets of vector and tensor fields. diff --git a/processing/post/addDerivative.py b/processing/post/addDerivative.py index 35ca7130b..7967af4b2 100755 --- a/processing/post/addDerivative.py +++ b/processing/post/addDerivative.py @@ -34,7 +34,7 @@ def derivative(coordinates,what): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing numerical derivative of requested column(s) with respect to given coordinates. """, version = scriptID) diff --git a/processing/post/addDeterminant.py b/processing/post/addDeterminant.py index b8b177e37..897f2364b 100755 --- a/processing/post/addDeterminant.py +++ b/processing/post/addDeterminant.py @@ -20,7 +20,7 @@ def determinant(m): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing determinant of requested tensor column(s). """, version = scriptID) diff --git a/processing/post/addDeviator.py b/processing/post/addDeviator.py index 1f97ca467..220b29ec8 100755 --- a/processing/post/addDeviator.py +++ b/processing/post/addDeviator.py @@ -23,7 +23,7 @@ def deviator(m,spherical = False): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(2)]', description = """ Add column(s) containing deviator of requested tensor column(s). """, version = scriptID) diff --git a/processing/post/addDisplacement.py b/processing/post/addDisplacement.py index 76b044106..aa12ba2b1 100755 --- a/processing/post/addDisplacement.py +++ b/processing/post/addDisplacement.py @@ -87,7 +87,7 @@ def displacementFluctFFT(F,grid,size,nodal=False,transformed=False): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog [options] [ASCIItable(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add displacments resulting from deformation gradient field. Operates on periodic three-dimensional x,y,z-ordered data sets. Outputs at cell centers or cell nodes (into separate file). diff --git a/processing/post/addEhkl.py b/processing/post/addEhkl.py index 3cfec69af..573484617 100755 --- a/processing/post/addEhkl.py +++ b/processing/post/addEhkl.py @@ -30,7 +30,7 @@ def E_hkl(stiffness,vec): # stiffness = (c11,c12,c44) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing directional stiffness based on given cubic stiffness values C11, C12, and C44 in consecutive columns. """, version = scriptID) diff --git a/processing/post/addEuclideanDistance.py b/processing/post/addEuclideanDistance.py index f759b7a8f..b11f46fd8 100755 --- a/processing/post/addEuclideanDistance.py +++ b/processing/post/addEuclideanDistance.py @@ -83,7 +83,7 @@ neighborhoods = { ]) } -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing Euclidean distance to grain structural features: boundaries, triple lines, and quadruple points. """, version = scriptID) diff --git a/processing/post/addGaussian.py b/processing/post/addGaussian.py index cb610ba67..3f237a3e6 100755 --- a/processing/post/addGaussian.py +++ b/processing/post/addGaussian.py @@ -15,7 +15,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog option [ASCIItable(s)]', description = """ Add column(s) containing Gaussian filtered values of requested column(s). Operates on periodic and non-periodic ordered three-dimensional data sets. For details see scipy.ndimage documentation. diff --git a/processing/post/addGradient.py b/processing/post/addGradient.py index 676efb27e..d3910d2ad 100755 --- a/processing/post/addGradient.py +++ b/processing/post/addGradient.py @@ -52,7 +52,7 @@ def gradFFT(geomdim,field): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog option [ASCIItable(s)]', description = """ Add column(s) containing gradient of requested column(s). Operates on periodic ordered three-dimensional data sets of vector and scalar fields. diff --git a/processing/post/addIPFcolor.py b/processing/post/addIPFcolor.py index c5a59a63a..9c191b3ad 100755 --- a/processing/post/addIPFcolor.py +++ b/processing/post/addIPFcolor.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add RGB color value corresponding to TSL-OIM scheme for inverse pole figures. """, version = scriptID) diff --git a/processing/post/addIndexed.py b/processing/post/addIndexed.py index 63206d329..9a73f5572 100755 --- a/processing/post/addIndexed.py +++ b/processing/post/addIndexed.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add data in column(s) of mapped ASCIItable selected from the row indexed by the value in a mapping column. Row numbers start at 1. diff --git a/processing/post/addInfo.py b/processing/post/addInfo.py index feb316f45..fbfa8c3dd 100755 --- a/processing/post/addInfo.py +++ b/processing/post/addInfo.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options file[s]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add info lines to ASCIItable header. """, version = scriptID) diff --git a/processing/post/reLabel.py b/processing/post/reLabel.py index 0c6ef8dc9..a8d0e1556 100755 --- a/processing/post/reLabel.py +++ b/processing/post/reLabel.py @@ -12,7 +12,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog [options] dfile[s]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Rename scalar, vectorial, and/or tensorial data header labels. """, version = scriptID) diff --git a/processing/post/viewTable.py b/processing/post/viewTable.py index d661e4727..514ea40d9 100755 --- a/processing/post/viewTable.py +++ b/processing/post/viewTable.py @@ -12,7 +12,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(usage='%prog [options] [file[s]]', description = """ +parser = OptionParser(usage='%prog options [ASCIItable(s)]', description = """ Show components of given ASCIItable(s). """, version = scriptID) diff --git a/processing/post/vtk_pointCloud.py b/processing/post/vtk_pointCloud.py index a9ce1f81f..44168fb60 100755 --- a/processing/post/vtk_pointCloud.py +++ b/processing/post/vtk_pointCloud.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Produce a VTK point cloud dataset based on coordinates given in an ASCIItable. """, version = scriptID) diff --git a/processing/post/vtk_rectilinearGrid.py b/processing/post/vtk_rectilinearGrid.py index c94f44228..36218d68d 100755 --- a/processing/post/vtk_rectilinearGrid.py +++ b/processing/post/vtk_rectilinearGrid.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Create regular voxel grid from points in an ASCIItable. """, version = scriptID) From e1525cc529aa1ed0b09ec1d2b5842499c4be724f Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 16 Feb 2019 16:58:23 +0000 Subject: [PATCH 220/309] [skip ci] updated version information after successful test of v2.0.2-1789-g524bfb8c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index c778e617c..e1be2bda8 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1713-g0fd54768 +v2.0.2-1789-g524bfb8c From 97460692972bc864f40fe4eb5a96ede52b3ef487 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 17:59:57 +0100 Subject: [PATCH 221/309] updated script for documentation generation --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 6b968ff1c..3e1467f13 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 6b968ff1ce03333c2db386167f9740ce6e22443b +Subproject commit 3e1467f13ace5bf9002b211d1302c80e6f85cec3 From c3e3fe14004749aaaf3119d23e9855d972624db0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 18:00:53 +0100 Subject: [PATCH 222/309] allow non-confirming scripts at the moment --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index a021455e1..f64b1bb13 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -506,7 +506,7 @@ Processing: script: - cd $DAMASKROOT/processing/post - rm marc_to_vtk.py vtk2ang.py - - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py * + - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug \*.py except: - master - release From 0b1bfdfd4e5dc29169d347629f14a42eb02997c6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 18:17:05 +0100 Subject: [PATCH 223/309] was only working with python2 --- PRIVATE | 2 +- processing/post/addDivergence.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index 3e1467f13..a76f03d99 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3e1467f13ace5bf9002b211d1302c80e6f85cec3 +Subproject commit a76f03d99492ff14b7942124d76952c675aa85c3 diff --git a/processing/post/addDivergence.py b/processing/post/addDivergence.py index 73eb4ed9e..f579a0a49 100755 --- a/processing/post/addDivergence.py +++ b/processing/post/addDivergence.py @@ -45,7 +45,7 @@ def divFFT(geomdim,field): div_fourier = np.einsum(einsums[n],k_s,field_fourier)*TWOPIIMG - return np.fft.irfftn(div_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n/3]) + return np.fft.irfftn(div_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n//3]) # -------------------------------------------------------------------- From c6781e415af80518f07a39519ae41153b872a09e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 18:23:00 +0100 Subject: [PATCH 224/309] using default notation for vector access --- processing/post/addAPS34IDEstrainCoords.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/processing/post/addAPS34IDEstrainCoords.py b/processing/post/addAPS34IDEstrainCoords.py index 8bfca35d3..67231a368 100755 --- a/processing/post/addAPS34IDEstrainCoords.py +++ b/processing/post/addAPS34IDEstrainCoords.py @@ -19,8 +19,8 @@ Transform X,Y,Z,F APS BeamLine 34 coordinates to x,y,z APS strain coordinates. """, version = scriptID) -parser.add_option('-f','--frame',dest='frame', nargs=3, metavar='string string string', - help='APS X,Y,Z coords') +parser.add_option('-f','--frame',dest='frame', metavar='string', + help='label of APS X,Y,Z coords') parser.add_option('--depth', dest='depth', metavar='string', help='depth') From 802ef6fe5c28aebea7b1eae10c780400a856cb12 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 18:25:41 +0100 Subject: [PATCH 225/309] more precise help --- processing/post/addNorm.py | 2 +- processing/post/addPK2.py | 2 +- processing/post/addSchmidfactors.py | 2 +- processing/post/addTable.py | 2 +- processing/post/groupTable.py | 2 +- processing/post/permuteData.py | 2 +- processing/post/sortTable.py | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/processing/post/addNorm.py b/processing/post/addNorm.py index 6f879e935..efadc0f52 100755 --- a/processing/post/addNorm.py +++ b/processing/post/addNorm.py @@ -26,7 +26,7 @@ def norm(which,object): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing norm of requested column(s) being either vectors or tensors. """, version = scriptID) diff --git a/processing/post/addPK2.py b/processing/post/addPK2.py index 3c615295d..cddcd7002 100755 --- a/processing/post/addPK2.py +++ b/processing/post/addPK2.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing Second Piola--Kirchhoff stress based on given column(s) of deformation gradient and first Piola--Kirchhoff stress. diff --git a/processing/post/addSchmidfactors.py b/processing/post/addSchmidfactors.py index 6ef6a71a0..056d4d678 100755 --- a/processing/post/addSchmidfactors.py +++ b/processing/post/addSchmidfactors.py @@ -103,7 +103,7 @@ slipSystems = { # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add columns listing Schmid factors (and optional trace vector of selected system) for given Euler angles. """, version = scriptID) diff --git a/processing/post/addTable.py b/processing/post/addTable.py index 8bcb43d70..eb61b43dc 100755 --- a/processing/post/addTable.py +++ b/processing/post/addTable.py @@ -12,7 +12,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Append data of ASCIItable(s). """, version = scriptID) diff --git a/processing/post/groupTable.py b/processing/post/groupTable.py index f78566304..d97861495 100755 --- a/processing/post/groupTable.py +++ b/processing/post/groupTable.py @@ -20,7 +20,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Apply a user-specified function to condense into a single row all those rows for which columns 'label' have identical values. Output table will contain as many rows as there are different (unique) values in the grouping column(s). Periodic domain averaging of coordinate values is supported. diff --git a/processing/post/permuteData.py b/processing/post/permuteData.py index 1843c9f57..d263e42b8 100755 --- a/processing/post/permuteData.py +++ b/processing/post/permuteData.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Permute all values in given column(s). """, version = scriptID) diff --git a/processing/post/sortTable.py b/processing/post/sortTable.py index 92fa81672..bf23193bb 100755 --- a/processing/post/sortTable.py +++ b/processing/post/sortTable.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Sort rows by given (or all) column label(s). Examples: From 2584f8576045ad4543b8dd80c9fe8bc9892fee7c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 18:38:13 +0100 Subject: [PATCH 226/309] parameters are stored in parameter structure --- src/plastic_nonlocal.f90 | 163 ++++++++++++++++++++++++++++++--------- 1 file changed, 127 insertions(+), 36 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 76b9339fa..287de8dd5 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -11,32 +11,6 @@ module plastic_nonlocal implicit none private - character(len=22), dimension(11), parameter, private :: & - BASICSTATES = ['rhoSglEdgePosMobile ', & - 'rhoSglEdgeNegMobile ', & - 'rhoSglScrewPosMobile ', & - 'rhoSglScrewNegMobile ', & - 'rhoSglEdgePosImmobile ', & - 'rhoSglEdgeNegImmobile ', & - 'rhoSglScrewPosImmobile', & - 'rhoSglScrewNegImmobile', & - 'rhoDipEdge ', & - 'rhoDipScrew ', & - 'accumulatedshear ' ] !< list of "basic" microstructural state variables that are independent from other state variables - - character(len=16), dimension(3), parameter, private :: & - DEPENDENTSTATES = ['rhoForest ', & - 'tauThreshold ', & - 'tauBack ' ] !< list of microstructural state variables that depend on other state variables - - character(len=20), dimension(6), parameter, private :: & - OTHERSTATES = ['velocityEdgePos ', & - 'velocityEdgeNeg ', & - 'velocityScrewPos ', & - 'velocityScrewNeg ', & - 'maxDipoleHeightEdge ', & - 'maxDipoleHeightScrew' ] !< list of other dependent state variables that are not updated by microstructure - real(pReal), parameter, private :: & KB = 1.38e-23_pReal !< Physical parameter, Boltzmann constant in J/Kelvin @@ -293,7 +267,8 @@ subroutine plastic_nonlocal_init(fileUnit) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use math, only: math_Voigt66to3333, & math_mul3x3, & - math_transpose33 + math_transpose33, & + math_expand use IO, only: IO_read, & IO_lc, & IO_getTag, & @@ -357,7 +332,9 @@ integer(pInt) :: phase, & integer(pInt) :: sizeState, sizeDotState,sizeDependentState, sizeDeltaState integer(kind(undefined_ID)) :: & outputID !< ID of each post result output - + character(len=512) :: & + extmsg = '', & + structure character(len=65536), dimension(:), allocatable :: outputs integer(pInt) :: NofMyPhase @@ -737,11 +714,32 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), ns = totalNslip(instance) - sizeDotState = int(size(BASICSTATES),pInt) * ns - sizeDependentState = int(size(DEPENDENTSTATES),pInt) * ns - sizeState = sizeDotState + sizeDependentState & - + int(size(OTHERSTATES),pInt) * ns - sizeDeltaState = sizeDotState + sizeDotState = int(size(& + ['rhoSglEdgePosMobile ', & + 'rhoSglEdgeNegMobile ', & + 'rhoSglScrewPosMobile ', & + 'rhoSglScrewNegMobile ', & + 'rhoSglEdgePosImmobile ', & + 'rhoSglEdgeNegImmobile ', & + 'rhoSglScrewPosImmobile', & + 'rhoSglScrewNegImmobile', & + 'rhoDipEdge ', & + 'rhoDipScrew ', & + 'accumulatedshear ' ] & !< list of "basic" microstructural state variables that are independent from other state variables + &),pInt) * ns + sizeDependentState = int(size(& + ['rhoForest '] & !< list of microstructural state variables that depend on other state variables + &),pInt) * ns + sizeState = sizeDotState + sizeDependentState & + + int(size(& + ['velocityEdgePos ', & + 'velocityEdgeNeg ', & + 'velocityScrewPos ', & + 'velocityScrewNeg ', & + 'maxDipoleHeightEdge ', & + 'maxDipoleHeightScrew' ] & !< list of other dependent state variables that are not updated by microstructure + &),pInt) * ns + sizeDeltaState = sizeDotState !*** determine indices to state array @@ -889,7 +887,100 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), associate(prm => param(instance), & config => config_phase(p)) + prm%mu = lattice_mu(p) + prm%nu = lattice_nu(p) + structure = config_phase(p)%getString('lattice_structure') +param(instance)%shortRangeStressCorrection = .false. +param(instance)%probabilisticMultiplication = .false. + + prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyInt) + prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + if(structure=='bcc') then + prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray) + prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) + prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) + else + prm%nonSchmid_pos = prm%Schmid + prm%nonSchmid_neg = prm%Schmid + endif + prm%interactionSlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & + config%getFloats('interaction_slipslip'), & + structure(1:3)) + + + + prm%rhoSglEdgePos0 = config_phase(p)%getFloats('rhosgledgepos0') + prm%rhoSglEdgeNeg0 = config_phase(p)%getFloats('rhosgledgeneg0') + prm%rhoSglScrewPos0 = config_phase(p)%getFloats('rhosglscrewpos0') + prm%rhoSglScrewNeg0 = config_phase(p)%getFloats('rhosglscrewneg0') + + prm%rhoDipEdge0 = config_phase(p)%getFloats('rhodipedge0') + prm%rhoDipScrew0 = config_phase(p)%getFloats('rhodipscrew0') + prm%lambda0 = config_phase(p)%getFloats('lambda0') + + if(size(prm%lambda0)/= size(prm%Nslip)) call IO_error(211_pInt,ext_msg='lambda0') + prm%lambda0 = math_expand(prm%lambda0,prm%Nslip) + + + prm%burgers = config_phase(p)%getFloats('burgers') + + if (size(prm%burgers) /= size(prm%Nslip)) call IO_error(150_pInt,ext_msg='burgers') + prm%burgers = math_expand(prm%burgers,prm%Nslip) + + + minDipoleHeightPerSlipFamily(:,1_pInt,instance) = config_phase(p)%getFloats('minimumdipoleheightedge')!,'ddipminedge') + minDipoleHeightPerSlipFamily(:,2_pInt,instance) = config_phase(p)%getFloats('minimumdipoleheightscrew')!,'ddipminscrew') + peierlsStressPerSlipFamily(:,1_pInt,instance) = config_phase(p)%getFloat('peierlsstressedge')!,'peierlsstress_edge') + peierlsStressPerSlipFamily(:,2_pInt,instance) = config_phase(p)%getFloat('peierlsstressscrew')!,'peierlsstress_screw') + + prm%atomicVolume = config_phase(p)%getFloat('atomicvolume') + prm%cutoffRadius = config_phase(p)%getFloat('r')!,cutoffradius') + prm%Dsd0 = config_phase(p)%getFloat('selfdiffusionprefactor') !,'dsd0') + prm%selfDiffusionEnergy = config_phase(p)%getFloat('selfdiffusionenergy') !,'qsd') + + prm%aTolRho = config_phase(p)%getFloat('atol_rho') !,'atol_density','absolutetolerancedensity','absolutetolerance_density') + prm%aTolShear = config_phase(p)%getFloat('atol_shear') !,'atol_plasticshear','atol_accumulatedshear','absolutetoleranceshear','absolutetolerance_shear') + + + prm%significantRho = config_phase(p)%getFloat('significantrho')!,'significant_rho','significantdensity','significant_density') + prm%significantN = config_phase(p)%getFloat('significantn', 0.0_pReal)!,'significant_n','significantdislocations','significant_dislcations') + + + + prm%linetensionEffect = config_phase(p)%getFloat('linetension')!,'linetensioneffect','linetension_effect') + prm%edgeJogFactor = config_phase(p)%getFloat('edgejog')!,'edgejogs','edgejogeffect','edgejog_effect') + prm%doublekinkwidth = config_phase(p)%getFloat('doublekinkwidth') + + prm%solidSolutionEnergy = config_phase(p)%getFloat('solidsolutionenergy') + prm%solidSolutionSize = config_phase(p)%getFloat('solidsolutionsize') + prm%solidSolutionConcentration = config_phase(p)%getFloat('solidsolutionconcentration') + + + prm%p = config_phase(p)%getFloat('p') + prm%q = config_phase(p)%getFloat('q') + + + prm%viscosity = config_phase(p)%getFloat('viscosity')!,'glideviscosity') + prm%fattack = config_phase(p)%getFloat('attackfrequency')!,'fattack') + + prm%rhoSglScatter = config_phase(p)%getFloat('rhosglscatter') + prm%rhoSglRandom = config_phase(p)%getFloat('rhosglrandom',0.0_pReal) + + if (config_phase(p)%keyExists('rhosglrandom')) & + prm%rhoSglRandomBinning = config_phase(p)%getFloat('rhosglrandombinning',0.0_pReal) !ToDo: useful default? + + + prm%surfaceTransmissivity = config_phase(p)%getFloat('surfacetransmissivity') + prm%grainboundaryTransmissivity = config_phase(p)%getFloat('grainboundarytransmissivity') + prm%CFLfactor = config_phase(p)%getFloat('cflfactor') + + prm%fEdgeMultiplication = config_phase(p)%getFloat('edgemultiplication')!,'edgemultiplicationfactor','fedgemultiplication') + prm%shortRangeStressCorrection = config_phase(p)%getInt('shortrangestresscorrection' ) > 0_pInt + prm%probabilisticMultiplication = config_phase(p)%keyExists('/probabilisticmultiplication/' )!,'randomsources','randommultiplication','discretesources') + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) @@ -2389,7 +2480,7 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then !* FLUX FROM ME TO MY NEIGHBOR - !* This is not considered, if my opposite neighbor has a different constitutive law than nonlocal (still considered for nonlocal law with lcal properties). + !* This is not considered, if my opposite neighbor has a different constitutive law than nonlocal (still considered for nonlocal law with local properties). !* Then, we assume, that the opposite(!) neighbor sends an equal amount of dislocations to me. !* So the net flux in the direction of my neighbor is equal to zero: !* leaving flux to neighbor == entering flux from opposite neighbor @@ -2423,9 +2514,9 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then endif normal_me2neighbor_defConf = math_det33(Favg) & - * math_mul33x3(math_inv33(math_transpose33(Favg)), & + * math_mul33x3(math_inv33(transpose(Favg)), & mesh_ipAreaNormal(1:3,n,ip,el)) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!) - normal_me2neighbor = math_mul33x3(math_transpose33(my_Fe), normal_me2neighbor_defConf) & + normal_me2neighbor = math_mul33x3(transpose(my_Fe), normal_me2neighbor_defConf) & / math_det33(my_Fe) ! interface normal in my lattice configuration area = mesh_ipArea(n,ip,el) * norm2(normal_me2neighbor) normal_me2neighbor = normal_me2neighbor / norm2(normal_me2neighbor) ! normalize the surface normal to unit length From c7abe559447d79ef26bc68a68291396dd5bd7f2f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 22:09:06 +0100 Subject: [PATCH 227/309] was not needed --- src/plastic_nonlocal.f90 | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 287de8dd5..341f7c9cc 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -264,10 +264,8 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_init(fileUnit) -use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use math, only: math_Voigt66to3333, & math_mul3x3, & - math_transpose33, & math_expand use IO, only: IO_read, & IO_lc, & @@ -340,8 +338,6 @@ integer(pInt) :: phase, & integer(pInt) :: NofMyPhase write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" maxNinstances = int(count(phase_plasticity == PLASTICITY_NONLOCAL_ID),pInt) if (maxNinstances == 0) return ! we don't have to do anything if there's no instance for this constitutive law @@ -848,7 +844,7 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), !*** rotation matrix from lattice configuration to slip system lattice2slip(1:3,1:3,s1,instance) & - = math_transpose33( reshape([ lattice_sd(1:3, slipSystemLattice(s1,instance), phase), & + = transpose( reshape([ lattice_sd(1:3, slipSystemLattice(s1,instance), phase), & -lattice_st(1:3, slipSystemLattice(s1,instance), phase), & lattice_sn(1:3, slipSystemLattice(s1,instance), phase)], [3,3])) enddo @@ -1231,8 +1227,7 @@ use math, only: & pi, & math_mul33x3, & math_mul3x3, & - math_inv33, & - math_transpose33 + math_inv33 use debug, only: & debug_level, & debug_constitutive, & @@ -1422,7 +1417,7 @@ if (.not. phase_localPlasticity(ph) .and. shortRangeStressCorrection(instance)) connection_latticeConf(1:3,n) = & math_mul33x3(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) & - mesh_ipCoordinates(1:3,ip,el)) - normal_latticeConf = math_mul33x3(math_transpose33(invFp), mesh_ipAreaNormal(1:3,n,ip,el)) + normal_latticeConf = math_mul33x3(transpose(invFp), mesh_ipAreaNormal(1:3,n,ip,el)) if (math_mul3x3(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pReal) then ! neighboring connection points in opposite direction to face normal: must be periodic image connection_latticeConf(1:3,n) = normal_latticeConf * mesh_ipVolume(ip,el) & / mesh_ipArea(n,ip,el) ! instead take the surface normal scaled with the diameter of the cell @@ -1745,7 +1740,8 @@ Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal instance = phase_plasticityInstance(ph) -ns = totalNslip(instance) +associate(prm => param(instance)) +ns = prm%totalNslip !*** shortcut to state variables @@ -1864,7 +1860,7 @@ dLp_dTstar99 = math_3333to99(dLp_dTstar3333) write(6,'(a,/,3(12x,3(f12.7,1x),/))') '<< CONST >> Lp',transpose(Lp) endif #endif - +end associate end subroutine plastic_nonlocal_LpAndItsTangent @@ -2077,7 +2073,6 @@ use math, only: math_mul6x6, & math_mul33x33, & math_inv33, & math_det33, & - math_transpose33, & pi use mesh, only: theMesh, & mesh_element, & From 5c20609e81a4783ca390964c8f3f56740f42bec3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 22:20:10 +0100 Subject: [PATCH 228/309] more verbose help, drop support for really old vtk --- PRIVATE | 2 +- processing/post/addLinked.py | 2 +- processing/post/addMises.py | 2 +- processing/post/addOrientations.py | 2 +- processing/post/addPole.py | 2 +- processing/post/addSpectralDecomposition.py | 2 +- processing/post/addStrainTensors.py | 2 +- processing/post/averageDown.py | 2 +- processing/post/binXY.py | 2 +- processing/post/blowUp.py | 2 +- processing/post/filterTable.py | 2 +- processing/post/vtk_addGridData.py | 5 ++--- processing/post/vtk_addPointcloudData.py | 8 ++------ processing/post/vtk_pointCloud.py | 5 ++--- processing/post/vtk_rectilinearGrid.py | 3 +-- 15 files changed, 18 insertions(+), 25 deletions(-) diff --git a/PRIVATE b/PRIVATE index a76f03d99..7e51c3e08 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit a76f03d99492ff14b7942124d76952c675aa85c3 +Subproject commit 7e51c3e08655261ec9bd43c6841575e323927de7 diff --git a/processing/post/addLinked.py b/processing/post/addLinked.py index 097f8f2c5..bed3da30a 100755 --- a/processing/post/addLinked.py +++ b/processing/post/addLinked.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add data of selected column(s) from (first) row of linked ASCIItable that shares the linking column value. """, version = scriptID) diff --git a/processing/post/addMises.py b/processing/post/addMises.py index 789540072..35a6922c3 100755 --- a/processing/post/addMises.py +++ b/processing/post/addMises.py @@ -24,7 +24,7 @@ def Mises(what,tensor): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add vonMises equivalent values for symmetric part of requested strains and/or stresses. """, version = scriptID) diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index 41fa7a5df..bcb292ef9 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -38,7 +38,7 @@ def check_matrix(M): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add quaternion and/or Bunge Euler angle representation of crystal lattice orientation. Orientation is given by quaternion, Euler angles, rotation matrix, or crystal frame coordinates (i.e. component vectors of rotation matrix). diff --git a/processing/post/addPole.py b/processing/post/addPole.py index 27e44e2a1..628d64d5e 100755 --- a/processing/post/addPole.py +++ b/processing/post/addPole.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add coordinates of stereographic projection of given direction (pole) in crystal frame. """, version = scriptID) diff --git a/processing/post/addSpectralDecomposition.py b/processing/post/addSpectralDecomposition.py index e7d552c70..f3c25b117 100755 --- a/processing/post/addSpectralDecomposition.py +++ b/processing/post/addSpectralDecomposition.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing eigenvalues and eigenvectors of requested symmetric tensor column(s). """, version = scriptID) diff --git a/processing/post/addStrainTensors.py b/processing/post/addStrainTensors.py index 7e16d976c..375b0b5e8 100755 --- a/processing/post/addStrainTensors.py +++ b/processing/post/addStrainTensors.py @@ -25,7 +25,7 @@ def operator(stretch,strain,eigenvalues): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Add column(s) containing given strains based on given stretches of requested deformation gradient column(s). """, version = scriptID) diff --git a/processing/post/averageDown.py b/processing/post/averageDown.py index ac7cc00dd..3a70cf314 100755 --- a/processing/post/averageDown.py +++ b/processing/post/averageDown.py @@ -14,7 +14,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Average each data block of size 'packing' into single values thus reducing the former grid to grid/packing. """, version = scriptID) diff --git a/processing/post/binXY.py b/processing/post/binXY.py index 2c148e69a..dc286b7ac 100755 --- a/processing/post/binXY.py +++ b/processing/post/binXY.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Produces a binned grid of two columns from an ASCIItable, i.e. a two-dimensional probability density map. """, version = scriptID) diff --git a/processing/post/blowUp.py b/processing/post/blowUp.py index e06791afe..d596bb751 100755 --- a/processing/post/blowUp.py +++ b/processing/post/blowUp.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Blows up each value to a surrounding data block of size 'packing' thus increasing the former resolution to resolution*packing. diff --git a/processing/post/filterTable.py b/processing/post/filterTable.py index 865df6c03..2703ea274 100755 --- a/processing/post/filterTable.py +++ b/processing/post/filterTable.py @@ -30,7 +30,7 @@ def sortingList(labels,whitelistitems): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Filter rows according to condition and columns by either white or black listing. Examples: diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py index 315071a4b..a1713afb1 100755 --- a/processing/post/vtk_addGridData.py +++ b/processing/post/vtk_addGridData.py @@ -17,7 +17,7 @@ scriptID = ' '.join([scriptName,damask.version]) msg = "Add scalars, vectors, and/or an RGB tuple from" msg += "an ASCIItable to existing VTK grid (.vtr/.vtk/.vtu)." parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', + usage='%prog options [ASCIItable(s)]', description = msg, version = scriptID) @@ -172,8 +172,7 @@ for name in filenames: writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() - if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid) - else: writer.SetInputData(rGrid) + writer.SetInputData(rGrid) writer.Write() # ------------------------------------------ render result --------------------------------------- diff --git a/processing/post/vtk_addPointcloudData.py b/processing/post/vtk_addPointcloudData.py index d75eb97b4..369320d3d 100755 --- a/processing/post/vtk_addPointcloudData.py +++ b/processing/post/vtk_addPointcloudData.py @@ -15,7 +15,7 @@ scriptID = ' '.join([scriptName,damask.version]) # -------------------------------------------------------------------- parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', + usage='%prog options [ASCIItable(s)]', description = """Add scalar and RGB tuples from ASCIItable to existing VTK point cloud (.vtp).""", version = scriptID) @@ -46,8 +46,6 @@ parser.add_option('-c', '--color', dest='color', action='extend', parser.set_defaults(data = [], tensor = [], color = [], - inplace = False, - render = False, ) (options, filenames) = parser.parse_args() @@ -151,14 +149,12 @@ for name in filenames: # ------------------------------------------ output result --------------------------------------- Polydata.Modified() - if vtk.VTK_MAJOR_VERSION <= 5: Polydata.Update() writer = vtk.vtkXMLPolyDataWriter() writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtp' if options.inplace else '_added.vtp')) - if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(Polydata) - else: writer.SetInputData(Polydata) + writer.SetInputData(Polydata) writer.Write() # ------------------------------------------ render result --------------------------------------- diff --git a/processing/post/vtk_pointCloud.py b/processing/post/vtk_pointCloud.py index 44168fb60..2aad22479 100755 --- a/processing/post/vtk_pointCloud.py +++ b/processing/post/vtk_pointCloud.py @@ -78,7 +78,6 @@ for name in filenames: Polydata.SetPoints(Points) Polydata.SetVerts(Vertices) Polydata.Modified() - if vtk.VTK_MAJOR_VERSION <= 5: Polydata.Update() # ------------------------------------------ output result --------------------------------------- @@ -94,8 +93,8 @@ for name in filenames: writer.SetHeader('# powered by '+scriptID) writer.WriteToOutputStringOn() - if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(Polydata) - else: writer.SetInputData(Polydata) + + writer.SetInputData(Polydata) writer.Write() diff --git a/processing/post/vtk_rectilinearGrid.py b/processing/post/vtk_rectilinearGrid.py index 36218d68d..2e7c66ad5 100755 --- a/processing/post/vtk_rectilinearGrid.py +++ b/processing/post/vtk_rectilinearGrid.py @@ -125,8 +125,7 @@ for name in filenames: writer.SetHeader('# powered by '+scriptID) writer.WriteToOutputStringOn() - if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid) - else: writer.SetInputData(rGrid) + writer.SetInputData(rGrid) writer.Write() From 0f319e2cf63a3864660bad78e41c08598c3f3569 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 23:18:53 +0100 Subject: [PATCH 229/309] fixed state size and output size --- src/plastic_nonlocal.f90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 341f7c9cc..28d79df68 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -26,8 +26,6 @@ module plastic_nonlocal character(len=64), dimension(:,:), allocatable, target, public :: & plastic_nonlocal_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_nonlocal_Noutput !< number of outputs per instance of this plasticity integer(pInt), dimension(:,:), allocatable, private :: & iGamma, & !< state indices for accumulated shear @@ -352,7 +350,6 @@ allocate(plastic_nonlocal_sizeDotState(maxNinstances), allocate(plastic_nonlocal_sizeDependentState(maxNinstances), source=0_pInt) allocate(plastic_nonlocal_sizeState(maxNinstances), source=0_pInt) allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0_pInt) -allocate(plastic_nonlocal_Noutput(maxNinstances), source=0_pInt) allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) plastic_nonlocal_output = '' allocate(plastic_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID) @@ -724,7 +721,9 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), 'accumulatedshear ' ] & !< list of "basic" microstructural state variables that are independent from other state variables &),pInt) * ns sizeDependentState = int(size(& - ['rhoForest '] & !< list of microstructural state variables that depend on other state variables + ['rhoForest ', & + 'tauThreshold ', & + 'tauBack ' ]& !< list of microstructural state variables that depend on other state variables &),pInt) * ns sizeState = sizeDotState + sizeDependentState & + int(size(& @@ -891,6 +890,7 @@ param(instance)%shortRangeStressCorrection = .false. param(instance)%probabilisticMultiplication = .false. prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyInt) + prm%totalNslip = sum(prm%Nslip) prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& config%getFloat('c/a',defaultVal=0.0_pReal)) if(structure=='bcc') then @@ -1743,12 +1743,10 @@ instance = phase_plasticityInstance(ph) associate(prm => param(instance)) ns = prm%totalNslip - !*** shortcut to state variables forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) endforall @@ -2970,8 +2968,8 @@ forall (s = 1_pInt:ns) & lattice_sn(1:3,slipSystemLattice(s,instance),ph)) -outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) - select case(plastic_nonlocal_outputID(o,instance)) +outputsLoop: do o = 1_pInt,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) case (rho_sgl_edge_pos_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) From 27ebe1f665bd8f01663ef6de3919abb87fd41dd8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 08:00:26 +0100 Subject: [PATCH 230/309] improved documentation --- .gitlab-ci.yml | 20 +++++++++++++------- PRIVATE | 2 +- processing/post/rotateData.py | 2 +- processing/post/scaleData.py | 2 +- processing/post/shiftData.py | 2 +- processing/pre/geom_addPrimitive.py | 2 +- processing/pre/geom_clean.py | 2 +- processing/pre/seeds_fromRandom.py | 2 +- 8 files changed, 20 insertions(+), 14 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f64b1bb13..ce822fea1 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -482,31 +482,37 @@ AbaqusStd: script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT abaqus - only: - - development + except: + - master + - release Marc: stage: createDocumentation script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT marc - only: - - development + except: + - master + - release Spectral: stage: createDocumentation script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT spectral - only: - - development + except: + - master + - release Processing: stage: createDocumentation script: + - cd $DAMASKROOT/processing/pre + - rm 3DRVEfrom2Dang.py abq_addUserOutput.py marc_addUserOutput.py + - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py - cd $DAMASKROOT/processing/post - rm marc_to_vtk.py vtk2ang.py - - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug \*.py + - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py except: - master - release diff --git a/PRIVATE b/PRIVATE index 7e51c3e08..ddb0dae72 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 7e51c3e08655261ec9bd43c6841575e323927de7 +Subproject commit ddb0dae72af9012cca45d9fa5665da41815e88f7 diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 1ac4a9354..41783636c 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Rotate vector and/or tensor column data by given angle around given axis. """, version = scriptID) diff --git a/processing/post/scaleData.py b/processing/post/scaleData.py index 381485a8a..368180f93 100755 --- a/processing/post/scaleData.py +++ b/processing/post/scaleData.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Uniformly scale column values by given factor. """, version = scriptID) diff --git a/processing/post/shiftData.py b/processing/post/shiftData.py index 4ad1cbd0d..f490ee66e 100755 --- a/processing/post/shiftData.py +++ b/processing/post/shiftData.py @@ -13,7 +13,7 @@ scriptID = ' '.join([scriptName,damask.version]) # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ Uniformly shift column values by given offset. """, version = scriptID) diff --git a/processing/pre/geom_addPrimitive.py b/processing/pre/geom_addPrimitive.py index 54de558f7..a013cbb84 100755 --- a/processing/pre/geom_addPrimitive.py +++ b/processing/pre/geom_addPrimitive.py @@ -25,7 +25,7 @@ mappings = { 'microstructures': lambda x: int(x), } -parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [geomfile(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog option [geomfile(s)]', description = """ Positions a geometric object within the (three-dimensional) canvas of a spectral geometry description. Depending on the sign of the dimension parameters, these objects can be boxes, cylinders, or ellipsoids. diff --git a/processing/pre/geom_clean.py b/processing/pre/geom_clean.py index e3fa59dd8..907431146 100755 --- a/processing/pre/geom_clean.py +++ b/processing/pre/geom_clean.py @@ -18,7 +18,7 @@ def mostFrequent(arr): # MAIN #-------------------------------------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [geomfile(s)]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [geomfile(s)]', description = """ Smooth geometry by selecting most frequent microstructure index within given stencil at each location. """, version=scriptID) diff --git a/processing/pre/seeds_fromRandom.py b/processing/pre/seeds_fromRandom.py index 6ec221e25..b17335e03 100755 --- a/processing/pre/seeds_fromRandom.py +++ b/processing/pre/seeds_fromRandom.py @@ -28,7 +28,7 @@ def kdtree_search(cloud, queryPoints): # MAIN # -------------------------------------------------------------------- -parser = OptionParser(option_class=damask.extendableOption, usage='%prog [options]', description = """ +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options', description = """ Distribute given number of points randomly within (a fraction of) the three-dimensional cube [0.0,0.0,0.0]--[1.0,1.0,1.0]. Reports positions with random crystal orientations in seeds file format to STDOUT. From db9d5c898a5dae2505831d4b7aabb422a305cbd1 Mon Sep 17 00:00:00 2001 From: Franz Roters Date: Sun, 17 Feb 2019 10:08:02 +0100 Subject: [PATCH 231/309] [skip ci] typo --- src/kinematics_cleavage_opening.f90 | 2 +- src/kinematics_slipplane_opening.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 89c2f6ff0..7a3677ec1 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -22,7 +22,7 @@ module kinematics_cleavage_opening sdot0, & n real(pReal), dimension(:), allocatable :: & - critDip, & + critDisp, & critLoad end type diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 33714d573..86be20c9d 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -22,7 +22,7 @@ module kinematics_slipplane_opening sdot0, & n real(pReal), dimension(:), allocatable :: & - critDip, & + critDisp, & critPlasticStrain end type From cf32e7d1f5e214a7e224891316ff255245cc6e55 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 12:15:46 +0100 Subject: [PATCH 232/309] use parameter structure and avoid conversion 33<->6 --- src/constitutive.f90 | 42 +++++----- src/crystallite.f90 | 25 +++--- src/plastic_nonlocal.f90 | 169 ++++++++++++++------------------------- 3 files changed, 90 insertions(+), 146 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index ac8ee0484..88d521af9 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -402,15 +402,15 @@ end subroutine constitutive_microstructure !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient +! ToDo: Discuss wheter it makes sense if crystallite handles the configuration conversion, i.e. +! Mp in, dLp_dMp out !-------------------------------------------------------------------------------------------------- -subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, el) +subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & + S, Fi, ipc, ip, el) use prec, only: & pReal use math, only: & - math_mul33x33, & - math_6toSym33, & - math_sym33to6, & - math_99to3333 + math_mul33x33 use material, only: & phasememberAt, & phase_plasticity, & @@ -444,9 +444,8 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), intent(in), dimension(6) :: & - S6 !< 2nd Piola-Kirchhoff stress (vector notation) real(pReal), intent(in), dimension(3,3) :: & + S, & !< 2nd Piola-Kirchhoff stress Fi !< intermediate deformation gradient real(pReal), intent(out), dimension(3,3) :: & Lp !< plastic velocity gradient @@ -455,11 +454,8 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e dLp_dFi !< derivative of Lp with respect to Fi real(pReal), dimension(3,3,3,3) :: & dLp_dMp !< derivative of Lp with respect to Mandel stress - real(pReal), dimension(9,9) :: & - dLp_dMp99 !< derivative of Lp with respect to Mstar (matrix notation) real(pReal), dimension(3,3) :: & - Mp, & !< Mandel stress work conjugate with Lp - S !< 2nd Piola-Kirchhoff stress + Mp !< Mandel stress work conjugate with Lp integer(pInt) :: & ho, & !< homogenization tme !< thermal member position @@ -469,7 +465,6 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) - S = math_6toSym33(S6) Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) @@ -491,12 +486,11 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e case (PLASTICITY_KINEHARDENING_ID) plasticityType of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of) + call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp99, math_sym33to6(Mp), & + call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp,Mp, & temperature(ho)%p(tme),ip,el) - dLp_dMp = math_99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget case (PLASTICITY_DISLOTWIN_ID) plasticityType of = phasememberAt(ipc,ip,el) @@ -993,7 +987,7 @@ end subroutine constitutive_collectDeltaState !-------------------------------------------------------------------------------------------------- !> @brief returns array of constitutive results !-------------------------------------------------------------------------------------------------- -function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) +function constitutive_postResults(S, Fi, FeArray, ipc, ip, el) use prec, only: & pReal use math, only: & @@ -1058,8 +1052,8 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) Fi !< intermediate deformation gradient real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & FeArray !< elastic deformation gradient - real(pReal), intent(in), dimension(6) :: & - S6 !< 2nd Piola Kirchhoff stress (vector notation) + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola Kirchhoff stress real(pReal), dimension(3,3) :: & Mp !< Mandel stress integer(pInt) :: & @@ -1067,11 +1061,11 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) integer(pInt) :: & ho, & !< homogenization tme, & !< thermal member position - s, of, instance !< counter in source loop + i, of, instance !< counter in source loop constitutive_postResults = 0.0_pReal - Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_6toSym33(S6)) + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S) ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) @@ -1112,13 +1106,13 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) case (PLASTICITY_NONLOCAL_ID) plasticityType constitutive_postResults(startPos:endPos) = & - plastic_nonlocal_postResults (S6,FeArray,ip,el) + plastic_nonlocal_postResults (Mp,FeArray,ip,el) end select plasticityType - SourceLoop: do s = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) + SourceLoop: do i = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) startPos = endPos + 1_pInt - endPos = endPos + sourceState(material_phase(ipc,ip,el))%p(s)%sizePostResults - sourceType: select case (phase_source(s,material_phase(ipc,ip,el))) + endPos = endPos + sourceState(material_phase(ipc,ip,el))%p(i)%sizePostResults + sourceType: select case (phase_source(i,material_phase(ipc,ip,el))) case (SOURCE_damage_isoBrittle_ID) sourceType constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(ipc, ip, el) case (SOURCE_damage_isoDuctile_ID) sourceType diff --git a/src/crystallite.f90 b/src/crystallite.f90 index c272abd07..f049cd400 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -286,7 +286,7 @@ subroutine crystallite_init crystallite_outputID(o,c) = grainrotation_ID case ('eulerangles') outputName crystallite_outputID(o,c) = eulerangles_ID - case ('defgrad','f') outputName + case ('defgrad','f') outputName ! ToDo: no alias (f only) crystallite_outputID(o,c) = defgrad_ID case ('fe') outputName crystallite_outputID(o,c) = fe_ID @@ -298,15 +298,15 @@ subroutine crystallite_init crystallite_outputID(o,c) = lp_ID case ('li') outputName crystallite_outputID(o,c) = li_ID - case ('p','firstpiola','1stpiola') outputName + case ('p','firstpiola','1stpiola') outputName ! ToDo: no alias (p only) crystallite_outputID(o,c) = p_ID - case ('s','tstar','secondpiola','2ndpiola') outputName + case ('s','tstar','secondpiola','2ndpiola') outputName ! ToDo: no alias (s only) crystallite_outputID(o,c) = s_ID case ('elasmatrix') outputName crystallite_outputID(o,c) = elasmatrix_ID - case ('neighboringip') outputName + case ('neighboringip') outputName ! ToDo: this is not a result, it is static. Should be written out by mesh crystallite_outputID(o,c) = neighboringip_ID - case ('neighboringelement') outputName + case ('neighboringelement') outputName ! ToDo: this is not a result, it is static. Should be written out by mesh crystallite_outputID(o,c) = neighboringelement_ID case default outputName call IO_error(105_pInt,ext_msg=trim(str(o))//' (Crystallite)') @@ -426,7 +426,7 @@ end subroutine crystallite_init !-------------------------------------------------------------------------------------------------- !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- -function crystallite_stress(a) +function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) use prec, only: & tol_math_check, & dNeq0 @@ -462,14 +462,11 @@ function crystallite_stress(a) sourceState, & phase_Nsources, & phaseAt, phasememberAt - use constitutive, only: & - constitutive_SandItsTangents, & - constitutive_LpAndItsTangents, & - constitutive_LiAndItsTangents implicit none logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress - real(pReal), intent(in), optional :: a !ToDo: for some reason this prevents an internal compiler error in GNU. Very strange + real(pReal), intent(in), optional :: & + dummyArgumentToPreventInternalCompilerErrorWithGCC real(pReal) :: & formerSubStep integer(pInt) :: & @@ -793,7 +790,7 @@ subroutine crystallite_stressTangent() endif call constitutive_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - crystallite_Tstar_v(1:6,c,i,e), & + math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS @@ -1078,7 +1075,7 @@ function crystallite_postResults(ipc, ip, el) c = c + 1_pInt if (size(crystallite_postResults)-c > 0_pInt) & crystallite_postResults(c+1:size(crystallite_postResults)) = & - constitutive_postResults(crystallite_Tstar_v(1:6,ipc,ip,el), crystallite_Fi(1:3,1:3,ipc,ip,el), & + constitutive_postResults(math_6toSym33(crystallite_Tstar_v(1:6,ipc,ip,el)), crystallite_Fi(1:3,1:3,ipc,ip,el), & crystallite_Fe, ipc, ip, el) end function crystallite_postResults @@ -1289,7 +1286,7 @@ logical function integrateStress(& !* calculate plastic velocity gradient and its tangent from constitutive law call constitutive_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & - math_sym33to6(S), Fi_new, ipc, ip, el) + S, Fi_new, ipc, ip, el) #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 28d79df68..4a2d6b42f 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -107,14 +107,11 @@ module plastic_nonlocal rhoDotMultiplicationOutput, & rhoDotSingle2DipoleGlideOutput, & rhoDotAthermalAnnihilationOutput, & - rhoDotThermalAnnihilationOutput, & - nonSchmidProjection !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) + rhoDotThermalAnnihilationOutput !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & compatibility !< slip system compatibility between me and my neighbors - real(pReal), dimension(:,:), allocatable, private :: & - nonSchmidCoeff logical, dimension(:), allocatable, private :: & shortRangeStressCorrection, & !< flag indicating the use of the short range stress correction by a excess density gradient term @@ -275,7 +272,6 @@ use IO, only: IO_read, & IO_intValue, & IO_warning, & IO_error, & - IO_timeStamp, & IO_EOF use debug, only: debug_level, & debug_constitutive, & @@ -319,7 +315,6 @@ integer(pInt) :: phase, & c, & ! index of dislocation character Nchunks_SlipSlip = 0_pInt, & Nchunks_SlipFamilies = 0_pInt, & - Nchunks_nonSchmid = 0_pInt, & mySize = 0_pInt ! to suppress warnings, safe as init is called only once character(len=65536) :: & tag = '', & @@ -396,7 +391,6 @@ allocate(lambda0PerSlipFamily(lattice_maxNslipFamily,maxNinstances), s allocate(interactionSlipSlip(lattice_maxNinteraction,maxNinstances), source=0.0_pReal) allocate(minDipoleHeightPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=-1.0_pReal) allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=0.0_pReal) -allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), source=0.0_pReal) rewind(fileUnit) @@ -417,7 +411,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) Nchunks_SlipSlip = maxval(lattice_InteractionSlipSlip(:,:,phase)) - Nchunks_nonSchmid = lattice_NnonSchmid(phase) endif cycle endif @@ -539,12 +532,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), s fEdgeMultiplication(instance) = IO_floatValue(line,chunkPos,2_pInt) case('shortrangestresscorrection') shortRangeStressCorrection(instance) = IO_floatValue(line,chunkPos,2_pInt) > 0.0_pReal - case ('nonschmid_coefficients') - if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_label//')') - do f = 1_pInt,Nchunks_nonSchmid - nonSchmidCoeff(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo case('probabilisticmultiplication','randomsources','randommultiplication','discretesources') probabilisticMultiplication(instance) = IO_floatValue(line,chunkPos,2_pInt) > 0.0_pReal end select @@ -686,7 +673,6 @@ allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,t source=0.0_pReal) allocate(peierlsStress(maxTotalNslip,2,maxNinstances), source=0.0_pReal) allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) -allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), source=0.0_pReal) initializeInstances: do phase = 1_pInt, size(phase_plasticity) NofMyPhase=count(material_phase==phase) @@ -856,19 +842,6 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), !* 3) negative screw at positive resolved stress !* 4) negative screw at negative resolved stress - do s = 1_pInt,ns - do l = 1_pInt,lattice_NnonSchmid(phase) - nonSchmidProjection(1:3,1:3,1,s,instance) = nonSchmidProjection(1:3,1:3,1,s,instance) & - + nonSchmidCoeff(l,instance) * lattice_Sslip(1:3,1:3,2*l,slipSystemLattice(s,instance),phase) - nonSchmidProjection(1:3,1:3,2,s,instance) = nonSchmidProjection(1:3,1:3,2,s,instance) & - + nonSchmidCoeff(l,instance) * lattice_Sslip(1:3,1:3,2*l+1,slipSystemLattice(s,instance),phase) - enddo - nonSchmidProjection(1:3,1:3,3,s,instance) = -nonSchmidProjection(1:3,1:3,2,s,instance) - nonSchmidProjection(1:3,1:3,4,s,instance) = -nonSchmidProjection(1:3,1:3,1,s,instance) - forall (t = 1:4) & - nonSchmidProjection(1:3,1:3,t,s,instance) = nonSchmidProjection(1:3,1:3,t,s,instance) & - + lattice_Sslip(1:3,1:3,1,slipSystemLattice(s,instance),phase) - enddo call plastic_nonlocal_aTolState(phase,instance) endif myPhase2 @@ -1322,7 +1295,9 @@ real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pI ph = phaseAt(1,ip,el) of = phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) -ns = totalNslip(instance) +associate(prm => param(instance)) + +ns = prm%totalNslip !*** get basic states @@ -1334,11 +1309,11 @@ endforall forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & rhoDip(s,c) = max(plasticState(ph)%state(iRhoD(s,c,instance),of), 0.0_pReal) ! ensure positive dipole densities -where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & - .or. abs(rhoSgl) < significantRho(instance)) & +where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & + .or. abs(rhoSgl) < prm%significantRho) & rhoSgl = 0.0_pReal -where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & - .or. abs(rhoDip) < significantRho(instance)) & +where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & + .or. abs(rhoDip) < prm%significantRho) & rhoDip = 0.0_pReal !*** calculate the forest dislocation density @@ -1377,7 +1352,7 @@ forall (s = 1_pInt:ns) & tauBack = 0.0_pReal -if (.not. phase_localPlasticity(ph) .and. shortRangeStressCorrection(instance)) then +if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then invFe = math_inv33(Fe) invFp = math_inv33(Fp) rhoExcess(1,1:ns) = rhoSgl(1:ns,1) - rhoSgl(1:ns,2) @@ -1418,10 +1393,9 @@ if (.not. phase_localPlasticity(ph) .and. shortRangeStressCorrection(instance)) math_mul33x3(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) & - mesh_ipCoordinates(1:3,ip,el)) normal_latticeConf = math_mul33x3(transpose(invFp), mesh_ipAreaNormal(1:3,n,ip,el)) - if (math_mul3x3(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pReal) then ! neighboring connection points in opposite direction to face normal: must be periodic image + if (math_mul3x3(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pReal) & ! neighboring connection points in opposite direction to face normal: must be periodic image connection_latticeConf(1:3,n) = normal_latticeConf * mesh_ipVolume(ip,el) & / mesh_ipArea(n,ip,el) ! instead take the surface normal scaled with the diameter of the cell - endif else ! different number of active slip systems call IO_error(-1_pInt,ext_msg='different number of active slip systems in neighboring IPs of same crystal structure') @@ -1507,7 +1481,7 @@ plasticState(ph)%state(iTauB(1:ns,instance),of) = tauBack write(6,'(a,/,12x,12(f10.5,1x),/)') '<< CONST >> tauBack / MPa', tauBack*1e-6 endif #endif - + end associate end subroutine plastic_nonlocal_microstructure @@ -1671,7 +1645,7 @@ end subroutine plastic_nonlocal_kinetics !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature, ip, el) +subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, Mp, Temperature, ip, el) use math, only: math_3333to99, & math_mul6x6, & @@ -1687,9 +1661,6 @@ use material, only: material_phase, & plasticState, & phaseAt, phasememberAt,& phase_plasticityInstance -use lattice, only: lattice_Sslip, & - lattice_Sslip_v, & - lattice_NnonSchmid use mesh, only: mesh_ipVolume implicit none @@ -1698,12 +1669,12 @@ implicit none integer(pInt), intent(in) :: ip, & !< current integration point el !< current element number real(pReal), intent(in) :: Temperature !< temperature -real(pReal), dimension(6), intent(in) :: Tstar_v !< 2nd Piola-Kirchhoff stress in Mandel notation +real(pReal), dimension(3,3), intent(in) :: Mp !*** output variables real(pReal), dimension(3,3), intent(out) :: Lp !< plastic velocity gradient -real(pReal), dimension(9,9), intent(out) :: dLp_dTstar99 !< derivative of Lp with respect to Tstar (9x9 matrix) +real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp !< derivative of Lp with respect to Tstar (9x9 matrix) !*** local variables integer(pInt) instance, & !< current instance of this plasticity @@ -1717,7 +1688,6 @@ integer(pInt) instance, & t, & !< dislocation type s, & !< index of my current slip system sLattice !< index of my current slip system according to lattice order -real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 !< derivative of Lp with respect to Tstar (3x3x3x3 matrix) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & rhoSgl !< single dislocation densities (including blocked) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & @@ -1737,7 +1707,7 @@ of = phasememberAt(1_pInt,ip,el) !*** initialize local variables Lp = 0.0_pReal -dLp_dTstar3333 = 0.0_pReal +dLp_dMp = 0.0_pReal instance = phase_plasticityInstance(ph) associate(prm => param(instance)) @@ -1762,16 +1732,15 @@ tauThreshold = plasticState(ph)%state(iTauF(1:ns,instance),of) !*** for screws possible non-schmid contributions are also taken into account do s = 1_pInt,ns - sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) tauNS(s,1) = tau(s) tauNS(s,2) = tau(s) if (tau(s) > 0.0_pReal) then - tauNS(s,3) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,1,s,instance)) - tauNS(s,4) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,3,s,instance)) + tauNS(s,3) = math_mul33xx33(Mp, +prm%nonSchmid_pos(1:3,1:3,s)) + tauNS(s,4) = math_mul33xx33(Mp, -prm%nonSchmid_neg(1:3,1:3,s)) else - tauNS(s,3) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,2,s,instance)) - tauNS(s,4) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,4,s,instance)) + tauNS(s,3) = math_mul33xx33(Mp, +prm%nonSchmid_neg(1:3,1:3,s)) + tauNS(s,4) = math_mul33xx33(Mp, -prm%nonSchmid_pos(1:3,1:3,s)) endif enddo forall (t = 1_pInt:4_pInt) & @@ -1790,7 +1759,7 @@ dv_dtau(1:ns,2) = dv_dtau(1:ns,1) dv_dtauNS(1:ns,2) = dv_dtauNS(1:ns,1) !screws -if (lattice_NnonSchmid(ph) == 0_pInt) then ! no non-Schmid contributions +if (size(prm%nonSchmidCoeff) == 0_pInt) then ! no non-Schmid contributions forall(t = 3_pInt:4_pInt) v(1:ns,t) = v(1:ns,1) dv_dtau(1:ns,t) = dv_dtau(1:ns,1) @@ -1817,47 +1786,37 @@ forall (s = 1_pInt:ns, t = 5_pInt:8_pInt, rhoSgl(s,t) * v(s,t-4_pInt) < 0.0_pRea !*** Calculation of Lp and its tangent -gdotTotal = sum(rhoSgl(1:ns,1:4) * v, 2) * burgers(1:ns,instance) +gdotTotal = sum(rhoSgl(1:ns,1:4) * v, 2) * prm%burgers(1:ns) do s = 1_pInt,ns - sLattice = slipSystemLattice(s,instance) - Lp = Lp + gdotTotal(s) * lattice_Sslip(1:3,1:3,1,sLattice,ph) + Lp = Lp + gdotTotal(s) * prm%Schmid(1:3,1:3,s) ! Schmid contributions to tangent forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & - dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & - + lattice_Sslip(i,j,1,sLattice,ph) * lattice_Sslip(k,l,1,sLattice,ph) & - * sum(rhoSgl(s,1:4) * dv_dtau(s,1:4)) * burgers(s,instance) + dLp_dMp(i,j,k,l) = dLp_dMp(i,j,k,l) & + + prm%Schmid(i,j,s) * prm%Schmid(k,l,s) & + * sum(rhoSgl(s,1:4) * dv_dtau(s,1:4)) * prm%burgers(s) + ! non Schmid contributions to tangent if (tau(s) > 0.0_pReal) then forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & - dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & - + lattice_Sslip(i,j,1,sLattice,ph) & - * ( nonSchmidProjection(k,l,1,s,instance) * rhoSgl(s,3) * dv_dtauNS(s,3) & - + nonSchmidProjection(k,l,3,s,instance) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & - * burgers(s,instance) + dLp_dMp(i,j,k,l) = dLp_dMp(i,j,k,l) & + + prm%Schmid(i,j,s) & + * ( prm%nonSchmid_pos(k,l,s) * rhoSgl(s,3) * dv_dtauNS(s,3) & + - prm%nonSchmid_neg(k,l,s) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & + * prm%burgers(s) else forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & - dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & - + lattice_Sslip(i,j,1,sLattice,ph) & - * ( nonSchmidProjection(k,l,2,s,instance) * rhoSgl(s,3) * dv_dtauNS(s,3) & - + nonSchmidProjection(k,l,4,s,instance) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & - * burgers(s,instance) + dLp_dMp(i,j,k,l) = dLp_dMp(i,j,k,l) & + + prm%Schmid(i,j,s) & + * ( prm%nonSchmid_neg(k,l,s) * rhoSgl(s,3) * dv_dtauNS(s,3) & + - prm%nonSchmid_pos(k,l,s) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & + * prm%burgers(s) endif enddo -dLp_dTstar99 = math_3333to99(dLp_dTstar3333) -#ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then - write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_LpandItsTangent at el ip',el,ip - write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> gdot total',gdotTotal - write(6,'(a,/,3(12x,3(f12.7,1x),/))') '<< CONST >> Lp',transpose(Lp) - endif -#endif end associate end subroutine plastic_nonlocal_LpAndItsTangent @@ -1866,7 +1825,7 @@ end subroutine plastic_nonlocal_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief (instantaneous) incremental change of microstructure !-------------------------------------------------------------------------------------------------- -subroutine plastic_nonlocal_deltaState(Tstar_v,ip,el) +subroutine plastic_nonlocal_deltaState(Mp,ip,el) use prec, only: & dNeq0 use debug, only: debug_level, & @@ -1877,9 +1836,8 @@ use debug, only: debug_level, & debug_i, & debug_e use math, only: pi, & - math_mul6x6 -use lattice, only: lattice_Sslip_v ,& - lattice_mu, & + math_mul33xx33 +use lattice, only: lattice_mu, & lattice_nu use mesh, only: mesh_ipVolume use material, only: material_phase, & @@ -1890,7 +1848,7 @@ use material, only: material_phase, & implicit none integer(pInt), intent(in) :: ip, & ! current grain number el ! current element number -real(pReal), dimension(6), intent(in) :: Tstar_v ! current 2nd Piola-Kirchhoff stress in Mandel notation +real(pReal), dimension(3,3), intent(in) :: Mp !< MandelStress integer(pInt) :: & @@ -1931,6 +1889,7 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e ph = phaseAt(1,ip,el) of = phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) + associate(prm => param(instance)) ns = totalNslip(instance) @@ -1980,8 +1939,7 @@ enddo !*** calculate limits for stable dipole height do s = 1_pInt,ns - sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tauBack(s) + tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo dLower = minDipoleHeight(1:ns,1:2,instance) @@ -2042,13 +2000,14 @@ forall (s = 1:ns, c = 1_pInt:2_pInt) & write(6,'(a,/,10(12x,12(e12.5,1x),/),/)') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress endif #endif + end associate end subroutine plastic_nonlocal_deltaState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -subroutine plastic_nonlocal_dotState(Tstar_v, Fe, Fp, Temperature, & +subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & timestep,subfrac, ip,el) use, intrinsic :: & IEEE_arithmetic @@ -2065,9 +2024,9 @@ use debug, only: debug_level, & debug_g, & debug_i, & debug_e -use math, only: math_mul6x6, & - math_mul3x3, & +use math, only: math_mul3x3, & math_mul33x3, & + math_mul33xx33, & math_mul33x33, & math_inv33, & math_det33, & @@ -2086,8 +2045,7 @@ use material, only: homogenization_maxNgrains, & phaseAt, phasememberAt, & phase_plasticity ,& PLASTICITY_NONLOCAL_ID -use lattice, only: lattice_Sslip_v, & - lattice_sd, & +use lattice, only: lattice_sd, & lattice_st ,& lattice_mu, & lattice_nu, & @@ -2102,7 +2060,7 @@ integer(pInt), intent(in) :: ip, & el !< current element number real(pReal), intent(in) :: Temperature, & !< temperature timestep !< substepped crystallite time increment -real(pReal), dimension(6), intent(in) :: Tstar_v !< current 2nd Piola-Kirchhoff stress in Mandel notation +real(pReal), dimension(3,3), intent(in) :: Mp !< MandelStress real(pReal), dimension(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & subfrac !< fraction of timestep at the beginning of the substepped crystallite time increment real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & @@ -2198,6 +2156,7 @@ logical considerEnteringFlux, & ph = material_phase(1_pInt,ip,el) instance = phase_plasticityInstance(ph) +associate(prm => param(instance)) ns = totalNslip(instance) tau = 0.0_pReal @@ -2271,8 +2230,7 @@ forall (t = 1_pInt:4_pInt) & !*** calculate limits for stable dipole height do s = 1_pInt,ns ! loop over slip systems - sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tauBack(s) + tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo @@ -2661,7 +2619,7 @@ else forall (s = 1:ns) & plasticState(p)%dotState(iGamma(s,instance),o) = sum(gdot(s,1:4)) endif - + end associate end subroutine plastic_nonlocal_dotState @@ -2831,13 +2789,12 @@ end subroutine plastic_nonlocal_updateCompatibility !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) +function plastic_nonlocal_postResults(Mp,Fe,ip,el) use prec, only: & dNeq0 use math, only: & - math_mul6x6, & math_mul33x3, & - math_mul33x33, & + math_mul33xx33, & pi use mesh, only: & theMesh @@ -2848,7 +2805,6 @@ function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) plasticState, & phase_plasticityInstance use lattice, only: & - lattice_Sslip_v, & lattice_sd, & lattice_st, & lattice_sn, & @@ -2856,8 +2812,7 @@ function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) lattice_nu implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), dimension(3,3), intent(in) :: Mp !< MandelStress real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & Fe !< elastic deformation gradient integer(pInt), intent(in) :: & @@ -2910,7 +2865,7 @@ ns = totalNslip(instance) cs = 0_pInt plastic_nonlocal_postResults = 0.0_pReal - +associate(prm => param(instance)) !* short hand notations for state variables forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) @@ -2937,8 +2892,7 @@ forall (t = 1_pInt:4_pInt) & !* calculate limits for stable dipole height do s = 1_pInt,ns - sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + tauBack(s) + tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo @@ -3029,8 +2983,7 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) case (resolvedstress_external_ID) do s = 1_pInt,ns - sLattice = slipSystemLattice(s,instance) - plastic_nonlocal_postResults(cs+s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,ph)) + plastic_nonlocal_postResults(cs+s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) enddo cs = cs + ns @@ -3053,7 +3006,7 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) case (rho_dot_gen_ID) ! Obsolete plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) & - + rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) + + rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_gen_edge_ID) @@ -3074,7 +3027,7 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) case (rho_dot_ann_ath_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & - + rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) + + rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_ann_the_edge_ID) @@ -3133,7 +3086,7 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) end select enddo outputsLoop - +end associate end function plastic_nonlocal_postResults end module plastic_nonlocal From 7ad866b90fe8f1d3c1157736a16c5e212e43bb71 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 12:16:12 +0100 Subject: [PATCH 233/309] not needed any more --- src/lattice.f90 | 79 +++++-------------------------------------------- src/math.f90 | 12 +------- 2 files changed, 9 insertions(+), 82 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 9be30a5d3..70f4443ce 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -27,11 +27,9 @@ module lattice lattice_interactionSlipSlip !< Slip--slip interaction type real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: & - lattice_Sslip, & !< Schmid and non-Schmid matrices lattice_Scleavage !< Schmid matrices for cleavage systems real(pReal), allocatable, dimension(:,:,:,:), protected, public :: & - lattice_Sslip_v, & !< Mandel notation of lattice_Sslip lattice_Scleavage_v !< Mandel notation of lattice_Scleavege real(pReal), allocatable, dimension(:,:,:), protected, public :: & @@ -39,8 +37,6 @@ module lattice lattice_st, & !< sd x sn lattice_sd !< slip direction of slip system - integer(pInt), allocatable, dimension(:), protected, public :: & - lattice_NnonSchmid !< total # of non-Schmid contributions for each structure ! END DEPRECATED @@ -726,14 +722,8 @@ contains !> @brief Module initialization !-------------------------------------------------------------------------------------------------- subroutine lattice_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use IO, only: & - IO_error, & - IO_timeStamp + IO_error use config, only: & config_phase @@ -748,8 +738,6 @@ subroutine lattice_init write(6,'(/,a)') ' <<<+- lattice init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" Nphases = size(config_phase) @@ -769,9 +757,6 @@ subroutine lattice_init allocate(lattice_mu(Nphases), source=0.0_pReal) allocate(lattice_nu(Nphases), source=0.0_pReal) - allocate(lattice_NnonSchmid(Nphases), source=0_pInt) - allocate(lattice_Sslip(3,3,1+2*lattice_maxNnonSchmid,lattice_maxNslip,Nphases),source=0.0_pReal) - allocate(lattice_Sslip_v(6,1+2*lattice_maxNnonSchmid,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt) allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt) ! other:me @@ -863,34 +848,22 @@ subroutine lattice_initializeStructure(myPhase,CoverA) use prec, only: & tol_math_check use math, only: & - math_crossproduct, & - math_tensorproduct33, & math_mul33x33, & - math_mul33x3, & - math_trace33, & math_symmetric33, & math_sym33to6, & math_sym3333to66, & math_Voigt66to3333, & - math_axisAngleToR, & - INRAD, & - MATH_I3 + math_crossproduct use IO, only: & - IO_error, & - IO_warning + IO_error implicit none integer(pInt), intent(in) :: myPhase real(pReal), intent(in) :: & CoverA - real(pReal), dimension(3) :: & - sdU, snU, & - np, nn real(pReal), dimension(3,lattice_maxNslip) :: & sd, sn - real(pReal), dimension(3,3,2,lattice_maxNnonSchmid,lattice_maxNslip) :: & - sns integer(pInt) :: & j, i, & myNslip, myNcleavage @@ -951,34 +924,11 @@ subroutine lattice_initializeStructure(myPhase,CoverA) myNcleavage = lattice_bcc_Ncleavage lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bcc_NslipSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bcc_NcleavageSystem - lattice_NnonSchmid(myPhase) = lattice_bcc_NnonSchmid lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bcc_interactionSlipSlip lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & lattice_SchmidMatrix_cleavage(lattice_bcc_ncleavagesystem,'bcc',covera) - do i = 1_pInt,myNslip ! assign slip system vectors - sd(1:3,i) = lattice_bcc_systemSlip(1:3,i) - sn(1:3,i) = lattice_bcc_systemSlip(4:6,i) - sdU = sd(1:3,i) / norm2(sd(1:3,i)) - snU = sn(1:3,i) / norm2(sn(1:3,i)) - ! "np" and "nn" according to Gröger_etal2008, Acta Materialia 56 (2008) 5412–5425, table 1 (corresponds to their "n1" for positive and negative slip direction respectively) - np = math_mul33x3(math_axisAngleToR(sdU,60.0_pReal*INRAD), snU) - nn = math_mul33x3(math_axisAngleToR(-sdU,60.0_pReal*INRAD), snU) - ! Schmid matrices with non-Schmid contributions according to Koester_etal2012, Acta Materialia 60 (2012) 3894–3901, eq. (17) ("n1" is replaced by either "np" or "nn" according to either positive or negative slip direction) - sns(1:3,1:3,1,1,i) = math_tensorproduct33(sdU, np) - sns(1:3,1:3,2,1,i) = math_tensorproduct33(-sdU, nn) - sns(1:3,1:3,1,2,i) = math_tensorproduct33(math_crossproduct(snU, sdU), snU) - sns(1:3,1:3,2,2,i) = math_tensorproduct33(math_crossproduct(snU, -sdU), snU) - sns(1:3,1:3,1,3,i) = math_tensorproduct33(math_crossproduct(np, sdU), np) - sns(1:3,1:3,2,3,i) = math_tensorproduct33(math_crossproduct(nn, -sdU), nn) - sns(1:3,1:3,1,4,i) = math_tensorproduct33(snU, snU) - sns(1:3,1:3,2,4,i) = math_tensorproduct33(snU, snU) - sns(1:3,1:3,1,5,i) = math_tensorproduct33(math_crossproduct(snU, sdU), math_crossproduct(snU, sdU)) - sns(1:3,1:3,2,5,i) = math_tensorproduct33(math_crossproduct(snU, -sdU), math_crossproduct(snU, -sdU)) - sns(1:3,1:3,1,6,i) = math_tensorproduct33(sdU, sdU) - sns(1:3,1:3,2,6,i) = math_tensorproduct33(-sdU, -sdU) - enddo !-------------------------------------------------------------------------------------------------- ! hex (including conversion from miller-bravais (a1=a2=a3=c) to miller (a, b, c) indices) @@ -1014,8 +964,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA) sd(3,i) = lattice_bct_systemSlip(3,i)*CoverA sn(1:2,i) = lattice_bct_systemSlip(4:5,i) sn(3,i) = lattice_bct_systemSlip(6,i)/CoverA - sdU = sd(1:3,i) / norm2(sd(1:3,i)) - snU = sn(1:3,i) / norm2(sn(1:3,i)) enddo !-------------------------------------------------------------------------------------------------- @@ -1046,18 +994,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA) do i = 1_pInt,myNslip ! store slip system vectors and Schmid matrix for my structure lattice_sd(1:3,i,myPhase) = sd(1:3,i)/norm2(sd(1:3,i)) ! make unit vector lattice_sn(1:3,i,myPhase) = sn(1:3,i)/norm2(sn(1:3,i)) ! make unit vector - lattice_st(1:3,i,myPhase) = math_crossproduct(lattice_sd(1:3,i,myPhase), & - lattice_sn(1:3,i,myPhase)) - lattice_Sslip(1:3,1:3,1,i,myPhase) = math_tensorproduct33(lattice_sd(1:3,i,myPhase), & - lattice_sn(1:3,i,myPhase)) ! calculate Schmid matrix d \otimes n - do j = 1_pInt,lattice_NnonSchmid(myPhase) - lattice_Sslip(1:3,1:3,2*j ,i,myPhase) = sns(1:3,1:3,1,j,i) - lattice_Sslip(1:3,1:3,2*j+1,i,myPhase) = sns(1:3,1:3,2,j,i) - enddo - do j = 1_pInt,1_pInt+2_pInt*lattice_NnonSchmid(myPhase) - lattice_Sslip_v(1:6,j,i,myPhase) = & - math_sym33to6(math_symmetric33(lattice_Sslip(1:3,1:3,j,i,myPhase))) - enddo + lattice_st(1:3,i,myPhase) = math_crossproduct(lattice_sd(1:3,i,myPhase),lattice_sn(1:3,i,myPhase)) enddo do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure @@ -1462,8 +1399,8 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_target, & INRAD, & MATH_I3, & math_axisAngleToR, & - math_Mandel3333to66, & - math_Mandel66to3333, & + math_sym3333to66, & + math_66toSym3333, & math_rotate_forward3333, & math_mul33x33, & math_tensorproduct33, & @@ -1514,11 +1451,11 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_target, & if (abs(C_target_unrotated66(i,i)) Date: Sun, 17 Feb 2019 11:38:13 +0000 Subject: [PATCH 234/309] [skip ci] updated version information after successful test of v2.0.2-1808-g530f4f28 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index e1be2bda8..777f5cfdb 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1789-g524bfb8c +v2.0.2-1808-g530f4f28 From 553b1c7743e5899ede29944af34c87a5cd9f4df3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 13:16:00 +0100 Subject: [PATCH 235/309] stress tensor was accidentally still converted --- src/constitutive.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 88d521af9..d73d694a7 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -882,7 +882,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState (math_sym33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), & + call plastic_nonlocal_dotState (Mp,FeArray,FpArray,temperature(ho)%p(tme), & subdt,subfracArray,ip,el) end select plasticityType @@ -965,7 +965,7 @@ subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el) call plastic_kinehardening_deltaState(Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_deltaState(math_sym33to6(Mp),ip,el) + call plastic_nonlocal_deltaState(Mp,ip,el) end select plasticityType From d3e6430b9480ac9d10fb325db2d2b6b2a78849f2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 14:30:58 +0100 Subject: [PATCH 236/309] only used internally --- src/lattice.f90 | 51 ++++++++++++++++++++-------------------- src/plastic_nonlocal.f90 | 13 +++++----- 2 files changed, 32 insertions(+), 32 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 70f4443ce..7ee6ed54c 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -42,16 +42,16 @@ module lattice !-------------------------------------------------------------------------------------------------- ! face centered cubic - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & + integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: & LATTICE_FCC_NSLIPSYSTEM = int([12, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for fcc - integer(pInt), dimension(1), parameter, public :: & + integer(pInt), dimension(1), parameter, private :: & LATTICE_FCC_NTWINSYSTEM = int([12],pInt) !< # of twin systems per family for fcc - integer(pInt), dimension(1), parameter, public :: & + integer(pInt), dimension(1), parameter, private :: & LATTICE_FCC_NTRANSSYSTEM = int([12],pInt) !< # of transformation systems per family for fcc - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & + integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: & LATTICE_FCC_NCLEAVAGESYSTEM = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc integer(pInt), parameter, private :: & @@ -84,7 +84,7 @@ module lattice 0, 1,-1, 0, 1, 1 & ],pReal),shape(LATTICE_FCC_SYSTEMSLIP)) !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli - character(len=*), dimension(2), parameter, public :: LATTICE_FCC_SLIPFAMILY_NAME = & + character(len=*), dimension(2), parameter, private :: LATTICE_FCC_SLIPFAMILY_NAME = & ['<0 1 -1>{1 1 1}', & '<0 1 -1>{0 1 1}'] @@ -104,11 +104,11 @@ module lattice -1, 1, 2, -1, 1,-1 & ],pReal),shape(LATTICE_FCC_SYSTEMTWIN)) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli - character(len=*), dimension(1), parameter, public :: LATTICE_FCC_TWINFAMILY_NAME = & + character(len=*), dimension(1), parameter, private :: LATTICE_FCC_TWINFAMILY_NAME = & ['<-2 1 1>{1 1 1}'] - integer(pInt), dimension(2_pInt,LATTICE_FCC_NTWIN), parameter, public :: & + integer(pInt), dimension(2_pInt,LATTICE_FCC_NTWIN), parameter, private :: & LATTICE_FCC_TWINNUCLEATIONSLIPPAIR = reshape(int( [& 2,3, & 1,3, & @@ -125,7 +125,7 @@ module lattice ],pInt),shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR)) ! ToDo: should be in the interaction function - integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NSLIP), parameter, public :: & + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NSLIP), parameter, private :: & LATTICE_FCC_INTERACTIONSLIPSLIP = reshape(int( [& 1, 2, 2, 4, 6, 5, 3, 5, 5, 4, 5, 6, 9,10, 9,10,11,12, & ! ---> slip 2, 1, 2, 6, 4, 5, 5, 4, 6, 5, 3, 5, 9,10,11,12, 9,10, & ! | @@ -174,13 +174,13 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered cubic - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & + integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: & LATTICE_BCC_NSLIPSYSTEM = int([ 12, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], pInt) !< # of slip systems per family for bcc - integer(pInt), dimension(1), parameter, public :: & + integer(pInt), dimension(1), parameter, private :: & LATTICE_BCC_NTWINSYSTEM = int([12], pInt) !< # of twin systems per family for bcc - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & + integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: & LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & @@ -220,7 +220,7 @@ module lattice 1, 1, 1, 1, 1,-2 & ],pReal),shape(LATTICE_BCC_SYSTEMSLIP)) - character(len=*), dimension(2), parameter, public :: LATTICE_BCC_SLIPFAMILY_NAME = & + character(len=*), dimension(2), parameter, private :: LATTICE_BCC_SLIPFAMILY_NAME = & ['<1 -1 1>{0 1 1}', & '<1 -1 1>{2 1 1}'] @@ -241,12 +241,12 @@ module lattice 1, 1, 1, 1, 1,-2 & ],pReal),shape(LATTICE_BCC_SYSTEMTWIN)) - character(len=*), dimension(1), parameter, public :: LATTICE_BCC_TWINFAMILY_NAME = & + character(len=*), dimension(1), parameter, private :: LATTICE_BCC_TWINFAMILY_NAME = & ['<1 1 1>{2 1 1}'] - integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NSLIP), parameter, public :: & + integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NSLIP), parameter, private :: & LATTICE_bcc_interactionSlipSlip = reshape(int( [& 1,2,6,6,5,4,4,3,4,3,5,4, 6,6,4,3,3,4,6,6,4,3,6,6, & ! ---> slip 2,1,6,6,4,3,5,4,5,4,4,3, 6,6,3,4,4,3,6,6,3,4,6,6, & ! | @@ -297,13 +297,13 @@ module lattice !-------------------------------------------------------------------------------------------------- ! hexagonal - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & + integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: & LATTICE_HEX_NSLIPSYSTEM = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex - integer(pInt), dimension(4), parameter, public :: & + integer(pInt), dimension(4), parameter, private :: & LATTICE_HEX_NTWINSYSTEM = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & + integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: & LATTICE_hex_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for hex integer(pInt), parameter, private :: & @@ -355,7 +355,7 @@ module lattice 1, 1, -2, 3, -1, -1, 2, 2 & ],pReal),shape(LATTICE_HEX_SYSTEMSLIP)) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr - character(len=*), dimension(6), parameter, public :: LATTICE_HEX_SLIPFAMILY_NAME = & + character(len=*), dimension(6), parameter, private :: LATTICE_HEX_SLIPFAMILY_NAME = & ['<1 1 . 1>{0 0 . 1} ', & '<1 1 . 1>{1 0 . 0} ', & '<1 0 . 0>{1 1 . 0} ', & @@ -395,14 +395,14 @@ module lattice 1, 1, -2, -3, 1, 1, -2, 2 & ],pReal),shape(LATTICE_HEX_SYSTEMTWIN)) !< twin systems for hex, order follows Prof. Tom Bieler's scheme; but numbering in data was restarted from 1 - character(len=*), dimension(4), parameter, public :: LATTICE_HEX_TWINFAMILY_NAME = & + character(len=*), dimension(4), parameter, private :: LATTICE_HEX_TWINFAMILY_NAME = & ['<-1 0 . 1>{1 0 . 2} ', & '<1 1 . 6>{-1 -1 . 1}', & '<1 0 . -2>{1 0 . 1} ', & '<1 1 . -3>{1 1 . 2} '] - integer(pInt), dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NSLIP), parameter, public :: & + integer(pInt), dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NSLIP), parameter, private :: & LATTICE_hex_interactionSlipSlip = reshape(int( [& 1, 2, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! ---> slip 2, 1, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! | @@ -456,7 +456,7 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered tetragonal - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & + integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, private :: & LATTICE_bct_NslipSystem = int([2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ],pInt) !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009 integer(pInt), parameter, private :: & @@ -532,7 +532,7 @@ module lattice 1, 1, 1, 1,-2, 1 & ],pReal),[ 3_pInt + 3_pInt,LATTICE_bct_Nslip]) !< slip systems for bct sorted by Bieler - character(len=*), dimension(13), parameter, public :: LATTICE_BCT_SLIPFAMILY_NAME = & + character(len=*), dimension(13), parameter, private :: LATTICE_BCT_SLIPFAMILY_NAME = & ['{1 0 0)<0 0 1] ', & '{1 1 0)<0 0 1] ', & '{1 0 0)<0 1 0] ', & @@ -547,7 +547,7 @@ module lattice '{2 1 1)<0 1 -1]', & '{2 1 1)<-1 1 1]'] - integer(pInt), dimension(LATTICE_bct_Nslip,LATTICE_bct_Nslip), parameter, public :: & + integer(pInt), dimension(LATTICE_bct_Nslip,LATTICE_bct_Nslip), parameter, private :: & LATTICE_bct_interactionSlipSlip = reshape(int( [& 1, 2, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & 2, 1, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & @@ -618,7 +618,7 @@ module lattice !-------------------------------------------------------------------------------------------------- ! isotropic - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & + integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: & LATTICE_iso_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for iso integer(pInt), parameter, private :: & @@ -635,7 +635,7 @@ module lattice !-------------------------------------------------------------------------------------------------- ! orthorhombic - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & + integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, private :: & LATTICE_ort_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho integer(pInt), parameter, private :: & @@ -653,7 +653,6 @@ module lattice integer(pInt), parameter, public :: & LATTICE_maxNslip = max(LATTICE_FCC_NSLIP,LATTICE_BCC_NSLIP,LATTICE_HEX_NSLIP, & LATTICE_bct_Nslip), & !< max # of slip systems over lattice structures - LATTICE_maxNnonSchmid = LATTICE_bcc_NnonSchmid, & !< max # of non-Schmid contributions over lattice structures LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & LATTICE_hex_Ncleavage, & LATTICE_iso_Ncleavage,LATTICE_ort_Ncleavage), & !< max # of cleavage systems over lattice structures diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 4a2d6b42f..733834beb 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -915,7 +915,7 @@ param(instance)%probabilisticMultiplication = .false. prm%significantRho = config_phase(p)%getFloat('significantrho')!,'significant_rho','significantdensity','significant_density') - prm%significantN = config_phase(p)%getFloat('significantn', 0.0_pReal)!,'significant_n','significantdislocations','significant_dislcations') + prm%significantN = config_phase(p)%getFloat('significantn', 0.0_pReal)!,'significant_n','significantdislocations','significant_dislcations') @@ -1035,7 +1035,7 @@ param(instance)%probabilisticMultiplication = .false. if (outputID /= undefined_ID) then plastic_nonlocal_output(i,instance) = outputs(i) - plastic_nonlocal_sizePostResult(i,instance) = totalNslip(instance) + plastic_nonlocal_sizePostResult(i,instance) = prm%totalNslip prm%outputID = [prm%outputID , outputID] endif @@ -1645,7 +1645,8 @@ end subroutine plastic_nonlocal_kinetics !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, Mp, Temperature, ip, el) +subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, & + Mp, Temperature, ip, el) use math, only: math_3333to99, & math_mul6x6, & @@ -1704,10 +1705,7 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt ph = phaseAt(1_pInt,ip,el) of = phasememberAt(1_pInt,ip,el) -!*** initialize local variables -Lp = 0.0_pReal -dLp_dMp = 0.0_pReal instance = phase_plasticityInstance(ph) associate(prm => param(instance)) @@ -1788,6 +1786,9 @@ forall (s = 1_pInt:ns, t = 5_pInt:8_pInt, rhoSgl(s,t) * v(s,t-4_pInt) < 0.0_pRea gdotTotal = sum(rhoSgl(1:ns,1:4) * v, 2) * prm%burgers(1:ns) +Lp = 0.0_pReal +dLp_dMp = 0.0_pReal + do s = 1_pInt,ns Lp = Lp + gdotTotal(s) * prm%Schmid(1:3,1:3,s) From 40b0386b5f744397ab2874188cf31c9323f862ec Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 16:36:13 +0100 Subject: [PATCH 237/309] caused segmentation fault in doxygen seems like enum has a special meaning will be used soon with new thermal --- src/kinematics_thermal_expansion.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 3d1de3d0a..3696593ad 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -24,10 +24,10 @@ module kinematics_thermal_expansion integer(pInt), dimension(:), allocatable, target, public :: & kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage -! enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult -! enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output -! thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... -! end enum + enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult + enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output + thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... + end enum public :: & kinematics_thermal_expansion_init, & kinematics_thermal_expansion_initialStrain, & From c4b3ac3afb360748aaa16d12050952332469d943 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 17:04:26 +0100 Subject: [PATCH 238/309] slip system definition for bcc still needed --- src/lattice.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 7ee6ed54c..07f8aed82 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -108,7 +108,7 @@ module lattice ['<-2 1 1>{1 1 1}'] - integer(pInt), dimension(2_pInt,LATTICE_FCC_NTWIN), parameter, private :: & + integer(pInt), dimension(2_pInt,LATTICE_FCC_NTWIN), parameter, public :: & LATTICE_FCC_TWINNUCLEATIONSLIPPAIR = reshape(int( [& 2,3, & 1,3, & @@ -928,6 +928,10 @@ subroutine lattice_initializeStructure(myPhase,CoverA) lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & lattice_SchmidMatrix_cleavage(lattice_bcc_ncleavagesystem,'bcc',covera) + do i = 1_pInt,myNslip + sd(1:3,i) = lattice_bcc_systemSlip(1:3,i) + sn(1:3,i) = lattice_bcc_systemSlip(4:6,i) + enddo !-------------------------------------------------------------------------------------------------- ! hex (including conversion from miller-bravais (a1=a2=a3=c) to miller (a, b, c) indices) From 44e41465d07d7a6b73cff6f58d3bfc32ff321e1d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 17:56:01 +0100 Subject: [PATCH 239/309] use functions from lattice to calculate slip systems don't rely on internal coding for collinear systems --- src/plastic_nonlocal.f90 | 38 +++++++++----------------------------- 1 file changed, 9 insertions(+), 29 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 733834beb..8727e576c 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -85,8 +85,8 @@ module plastic_nonlocal lambda0PerSlipFamily, & !< mean free path prefactor for each family and instance lambda0, & !< mean free path prefactor for each slip system and instance burgersPerSlipFamily, & !< absolute length of burgers vector [m] for each family and instance - burgers, & !< absolute length of burgers vector [m] for each slip system and instance - interactionSlipSlip !< coefficients for slip-slip interaction for each interaction type and instance + burgers !< absolute length of burgers vector [m] for each slip system and instance + real(pReal), dimension(:,:,:), allocatable, private :: & minDipoleHeightPerSlipFamily, & !< minimum stable edge/screw dipole height for each family and instance @@ -94,8 +94,7 @@ module plastic_nonlocal peierlsStressPerSlipFamily, & !< Peierls stress (edge and screw) peierlsStress, & !< Peierls stress (edge and screw) forestProjectionEdge, & !< matrix of forest projections of edge dislocations for each instance - forestProjectionScrew, & !< matrix of forest projections of screw dislocations for each instance - interactionMatrixSlipSlip !< interaction matrix of the different slip systems for each instance + forestProjectionScrew !< matrix of forest projections of screw dislocations for each instance real(pReal), dimension(:,:,:,:), allocatable, private :: & lattice2slip, & !< orthogonal transformation matrix from lattice coordinate system to slip coordinate system (passive rotation !!!) @@ -259,6 +258,7 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_init(fileUnit) +use prec, only: dEq use math, only: math_Voigt66to3333, & math_mul3x3, & math_expand @@ -388,7 +388,6 @@ allocate(rhoDipEdge0(lattice_maxNslipFamily,maxNinstances), s allocate(rhoDipScrew0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) allocate(burgersPerSlipFamily(lattice_maxNslipFamily,maxNinstances), source=0.0_pReal) allocate(lambda0PerSlipFamily(lattice_maxNslipFamily,maxNinstances), source=0.0_pReal) -allocate(interactionSlipSlip(lattice_maxNinteraction,maxNinstances), source=0.0_pReal) allocate(minDipoleHeightPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=-1.0_pReal) allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=0.0_pReal) @@ -408,10 +407,8 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s endif if (IO_getTag(line,'[',']') /= '') then ! next phase phase = phase + 1_pInt ! advance phase section counter - if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then + if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) & Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) - Nchunks_SlipSlip = maxval(lattice_InteractionSlipSlip(:,:,phase)) - endif cycle endif if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then ! one of my phases. do not short-circuit here (.and. with next if statement). It's not safe in Fortran @@ -482,12 +479,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s significantRho(instance) = IO_floatValue(line,chunkPos,2_pInt) case('significantn','significant_n','significantdislocations','significant_dislcations') significantN(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('interaction_slipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_LABEL//')') - do it = 1_pInt,Nchunks_SlipSlip - interactionSlipSlip(it,instance) = IO_floatValue(line,chunkPos,1_pInt+it) - enddo case('linetension','linetensioneffect','linetension_effect') linetensionEffect(instance) = IO_floatValue(line,chunkPos,2_pInt) case('edgejog','edgejogs','edgejogeffect','edgejog_effect') @@ -571,8 +562,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') endif enddo - if (any(interactionSlipSlip(1:maxval(lattice_interactionSlipSlip(:,:,phase)),instance) < 0.0_pReal)) & - call IO_error(211_pInt,ext_msg='interaction_SlipSlip ('//PLASTICITY_NONLOCAL_label//')') if (linetensionEffect(instance) < 0.0_pReal .or. linetensionEffect(instance) > 1.0_pReal) & call IO_error(211_pInt,ext_msg='linetension ('//PLASTICITY_NONLOCAL_label//')') if (edgeJogFactor(instance) < 0.0_pReal .or. edgeJogFactor(instance) > 1.0_pReal) & @@ -651,7 +640,6 @@ allocate(lambda0(maxTotalNslip,maxNinstances), allocate(minDipoleHeight(maxTotalNslip,2,maxNinstances), source=-1.0_pReal) allocate(forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(lattice2slip(1:3, 1:3, maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=2.0_pReal) @@ -809,21 +797,13 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), = abs(math_mul3x3(lattice_sn(1:3,slipSystemLattice(s1,instance),phase), & lattice_sd(1:3,slipSystemLattice(s2,instance),phase))) ! forest projection of screw dislocations is the projection of b onto the slip normal of the respective splip plane - !*** calculation of interaction matrices - - interactionMatrixSlipSlip(s1,s2,instance) & - = interactionSlipSlip(lattice_interactionSlipSlip(slipSystemLattice(s1,instance), & - slipSystemLattice(s2,instance), & - phase), instance) !*** colinear slip system (only makes sense for fcc like it is defined here) - if (lattice_interactionSlipSlip(slipSystemLattice(s1,instance), & - slipSystemLattice(s2,instance), & - phase) == 3_pInt) then + if ((all(dEq(lattice_sd(1:3,slipSystemLattice(s1,instance),phase), & + lattice_sd(1:3,slipSystemLattice(s2,instance),phase))) .or. all(dEq(lattice_sd(1:3,slipSystemLattice(s1,instance),phase), & + -1.0_pReal* lattice_sd(1:3,slipSystemLattice(s2,instance),phase)))) .and. s1 /= s2) & colinearSystem(s1,instance) = s2 - endif - enddo !*** rotation matrix from lattice configuration to slip system @@ -1331,7 +1311,7 @@ forall (s = 1_pInt:ns) & !*** (see Kubin,Devincre,Hoc; 2008; Modeling dislocation storage rates and mean free paths in face-centered cubic crystals) myInteractionMatrix = 0.0_pReal -myInteractionMatrix(1:ns,1:ns) = interactionMatrixSlipSlip(1:ns,1:ns,instance) +myInteractionMatrix(1:ns,1:ns) = prm%interactionSlipSlip(1:ns,1:ns) if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTICE_fcc_ID) then ! only fcc and bcc do s = 1_pInt,ns myRhoForest = max(rhoForest(s),significantRho(instance)) From 690fef6f06e4a72b1adf1b23f7bb1d5b06505566 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 17:56:48 +0100 Subject: [PATCH 240/309] avoid publicly avaialbe data, rather provide setters and getters --- src/lattice.f90 | 388 +++++++++++++++++++++++------------------------- 1 file changed, 187 insertions(+), 201 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 07f8aed82..7566c7579 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -23,9 +23,6 @@ module lattice lattice_NslipSystem, & !< total # of slip systems in each family lattice_NcleavageSystem !< total # of transformation systems in each family - integer(pInt), allocatable, dimension(:,:,:), protected, public :: & - lattice_interactionSlipSlip !< Slip--slip interaction type - real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: & lattice_Scleavage !< Schmid matrices for cleavage systems @@ -89,7 +86,7 @@ module lattice '<0 1 -1>{0 1 1}'] real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter, private :: & - LATTICE_fcc_systemTwin = reshape(real( [& + LATTICE_FCC_SYSTEMTWIN = reshape(real( [& -2, 1, 1, 1, 1, 1, & 1,-2, 1, 1, 1, 1, & 1, 1,-2, 1, 1, 1, & @@ -124,42 +121,6 @@ module lattice 10,11 & ],pInt),shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR)) -! ToDo: should be in the interaction function - integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NSLIP), parameter, private :: & - LATTICE_FCC_INTERACTIONSLIPSLIP = reshape(int( [& - 1, 2, 2, 4, 6, 5, 3, 5, 5, 4, 5, 6, 9,10, 9,10,11,12, & ! ---> slip - 2, 1, 2, 6, 4, 5, 5, 4, 6, 5, 3, 5, 9,10,11,12, 9,10, & ! | - 2, 2, 1, 5, 5, 3, 5, 6, 4, 6, 5, 4, 11,12, 9,10, 9,10, & ! | - 4, 6, 5, 1, 2, 2, 4, 5, 6, 3, 5, 5, 9,10,10, 9,12,11, & ! v slip - 6, 4, 5, 2, 1, 2, 5, 3, 5, 5, 4, 6, 9,10,12,11,10, 9, & - 5, 5, 3, 2, 2, 1, 6, 5, 4, 5, 6, 4, 11,12,10, 9,10, 9, & - 3, 5, 5, 4, 5, 6, 1, 2, 2, 4, 6, 5, 10, 9,10, 9,11,12, & - 5, 4, 6, 5, 3, 5, 2, 1, 2, 6, 4, 5, 10, 9,12,11, 9,10, & - 5, 6, 4, 6, 5, 4, 2, 2, 1, 5, 5, 3, 12,11,10, 9, 9,10, & - 4, 5, 6, 3, 5, 5, 4, 6, 5, 1, 2, 2, 10, 9, 9,10,12,11, & - 5, 3, 5, 5, 4, 6, 6, 4, 5, 2, 1, 2, 10, 9,11,12,10, 9, & - 6, 5, 4, 5, 6, 4, 5, 5, 3, 2, 2, 1, 12,11, 9,10,10, 9, & - - 9, 9,11, 9, 9,11,10,10,12,10,10,12, 1, 7, 8, 8, 8, 8, & - 10,10,12,10,10,12, 9, 9,11, 9, 9,11, 7, 1, 8, 8, 8, 8, & - 9,11, 9,10,12,10,10,12,10, 9,11, 9, 8, 8, 1, 7, 8, 8, & - 10,12,10, 9,11, 9, 9,11, 9,10,12,10, 8, 8, 7, 1, 8, 8, & - 11, 9, 9,12,10,10,11, 9, 9,12,10,10, 8, 8, 8, 8, 1, 7, & - 12,10,10,11, 9, 9,12,10,10,11, 9, 9, 8, 8, 8, 8, 7, 1 & - ],pInt),shape(LATTICE_FCC_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for fcc - !< 1: self interaction - !< 2: coplanar interaction - !< 3: collinear interaction - !< 4: Hirth locks - !< 5: glissile junctions - !< 6: Lomer locks - !< 7: crossing (similar to Hirth locks in <110>{111} for two {110} planes) - !< 8: similar to Lomer locks in <110>{111} for two {110} planes - !< 9: similar to Lomer locks in <110>{111} btw one {110} and one {111} plane - !<10: similar to glissile junctions in <110>{111} btw one {110} and one {111} plane - !<11: crossing btw one {110} and one {111} plane - !<12: collinear btw one {110} and one {111} plane - real(pReal), dimension(3+3,LATTICE_fcc_Ncleavage), parameter, private :: & LATTICE_fcc_systemCleavage = reshape(real([& ! Cleavage direction Plane normal @@ -186,7 +147,6 @@ module lattice integer(pInt), parameter, private :: & LATTICE_BCC_NSLIP = sum(LATTICE_BCC_NSLIPSYSTEM), & !< total # of slip systems for bcc LATTICE_BCC_NTWIN = sum(LATTICE_BCC_NTWINSYSTEM), & !< total # of twin systems for bcc - LATTICE_bcc_NnonSchmid = 6_pInt, & !< total # of non-Schmid contributions for bcc (A. Koester, A. Ma, A. Hartmaier 2012) LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: & @@ -244,43 +204,6 @@ module lattice character(len=*), dimension(1), parameter, private :: LATTICE_BCC_TWINFAMILY_NAME = & ['<1 1 1>{2 1 1}'] - - - integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NSLIP), parameter, private :: & - LATTICE_bcc_interactionSlipSlip = reshape(int( [& - 1,2,6,6,5,4,4,3,4,3,5,4, 6,6,4,3,3,4,6,6,4,3,6,6, & ! ---> slip - 2,1,6,6,4,3,5,4,5,4,4,3, 6,6,3,4,4,3,6,6,3,4,6,6, & ! | - 6,6,1,2,4,5,3,4,4,5,3,4, 4,3,6,6,6,6,3,4,6,6,4,3, & ! | - 6,6,2,1,3,4,4,5,3,4,4,5, 3,4,6,6,6,6,4,3,6,6,3,4, & ! v slip - 5,4,4,3,1,2,6,6,3,4,5,4, 3,6,4,6,6,4,6,3,4,6,3,6, & - 4,3,5,4,2,1,6,6,4,5,4,3, 4,6,3,6,6,3,6,4,3,6,4,6, & - 4,5,3,4,6,6,1,2,5,4,3,4, 6,3,6,4,4,6,3,6,6,4,6,3, & - 3,4,4,5,6,6,2,1,4,3,4,5, 6,4,6,3,3,6,4,6,6,3,6,4, & - 4,5,4,3,3,4,5,4,1,2,6,6, 3,6,6,4,4,6,6,3,6,4,3,6, & - 3,4,5,4,4,5,4,3,2,1,6,6, 4,6,6,3,3,6,6,4,6,3,4,6, & - 5,4,3,4,5,4,3,4,6,6,1,2, 6,3,4,6,6,4,3,6,4,6,6,3, & - 4,3,4,5,4,3,4,5,6,6,2,1, 6,4,3,6,6,3,4,6,3,6,6,4, & - ! - 6,6,4,3,3,4,6,6,3,4,6,6, 1,5,6,6,5,6,6,3,5,6,3,6, & - 6,6,3,4,6,6,3,4,6,6,3,4, 5,1,6,6,6,5,3,6,6,5,6,3, & - 4,3,6,6,4,3,6,6,6,6,4,3, 6,6,1,5,6,3,5,6,3,6,5,6, & - 3,4,6,6,6,6,4,3,4,3,6,6, 6,6,5,1,3,6,6,5,6,3,6,5, & - 3,4,6,6,6,6,4,3,4,3,6,6, 5,6,6,3,1,6,5,6,5,3,6,6, & - 4,3,6,6,4,3,6,6,6,6,4,3, 6,5,3,6,6,1,6,5,3,5,6,6, & - 6,6,3,4,6,6,3,4,6,6,3,4, 6,3,5,6,5,6,1,6,6,6,5,3, & - 6,6,4,3,3,4,6,6,3,4,6,6, 3,6,6,5,6,5,6,1,6,6,3,5, & - 4,3,6,6,4,3,6,6,6,6,4,3, 5,6,3,6,5,3,6,6,1,6,6,5, & - 3,4,6,6,6,6,4,3,4,3,6,6, 6,5,6,3,3,5,6,6,6,1,5,6, & - 6,6,4,3,3,4,6,6,3,4,6,6, 3,6,5,6,6,6,5,3,6,5,1,6, & - 6,6,3,4,6,6,3,4,6,6,3,4, 6,3,6,5,6,6,3,5,5,6,6,1 & - ],pInt),shape(LATTICE_BCC_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for bcc from Queyreau et al. Int J Plast 25 (2009) 361–377 - !< 1: self interaction - !< 2: coplanar interaction - !< 3: collinear interaction - !< 4: mixed-asymmetrical junction - !< 5: mixed-symmetrical junction - !< 6: edge junction - real(pReal), dimension(3+3,LATTICE_bcc_Ncleavage), parameter, private :: & LATTICE_bcc_systemCleavage = reshape(real([& ! Cleavage direction Plane normal @@ -401,50 +324,6 @@ module lattice '<1 0 . -2>{1 0 . 1} ', & '<1 1 . -3>{1 1 . 2} '] - - integer(pInt), dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NSLIP), parameter, private :: & - LATTICE_hex_interactionSlipSlip = reshape(int( [& - 1, 2, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! ---> slip - 2, 1, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! | - 2, 2, 1, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! | - ! v slip - 6, 6, 6, 4, 5, 5, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & - 6, 6, 6, 5, 4, 5, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & - 6, 6, 6, 5, 5, 4, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & - ! - 12,12,12, 11,11,11, 9,10,10, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & - 12,12,12, 11,11,11, 10, 9,10, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & - 12,12,12, 11,11,11, 10,10, 9, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & - ! - 20,20,20, 19,19,19, 18,18,18, 16,17,17,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - 20,20,20, 19,19,19, 18,18,18, 17,16,17,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - 20,20,20, 19,19,19, 18,18,18, 17,17,16,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - 20,20,20, 19,19,19, 18,18,18, 17,17,17,16,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - 20,20,20, 19,19,19, 18,18,18, 17,17,17,17,16,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - 20,20,20, 19,19,19, 18,18,18, 17,17,17,17,17,16, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - ! - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 25,26,26,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,25,26,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,25,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,25,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,25,26,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,25,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,25,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,25,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,25,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,25,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,26,25,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,26,26,25, 35,35,35,35,35,35, & - ! - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 36,37,37,37,37,37, & - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,36,37,37,37,37, & - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,36,37,37,37, & - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,36,37,37, & - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,36,37, & - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,37,36 & - ],pInt),shape(LATTICE_HEX_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for hex (onion peel naming scheme) - - real(pReal), dimension(4+4,LATTICE_hex_Ncleavage), parameter, private :: & LATTICE_hex_systemCleavage = reshape(real([& ! Cleavage direction Plane normal @@ -547,74 +426,6 @@ module lattice '{2 1 1)<0 1 -1]', & '{2 1 1)<-1 1 1]'] - integer(pInt), dimension(LATTICE_bct_Nslip,LATTICE_bct_Nslip), parameter, private :: & - LATTICE_bct_interactionSlipSlip = reshape(int( [& - 1, 2, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & - 2, 1, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & - ! - 6, 6, 4, 5, 8, 8, 14, 14, 14, 14, 22, 22, 32, 32, 32, 32, 44, 44, 58, 58, 74, 74, 74, 74, 92, 92, 92, 92, 92, 92, 92, 92, 112, 112, 112, 112, 134,134,134,134,134,134,134,134, 158,158,158,158,158,158,158,158, & - 6, 6, 5, 4, 8, 8, 14, 14, 14, 14, 22, 22, 32, 32, 32, 32, 44, 44, 58, 58, 74, 74, 74, 74, 92, 92, 92, 92, 92, 92, 92, 92, 112, 112, 112, 112, 134,134,134,134,134,134,134,134, 158,158,158,158,158,158,158,158, & - ! - 12, 12, 11, 11, 9, 10, 15, 15, 15, 15, 23, 23, 33, 33, 33, 33, 45, 45, 59, 59, 75, 75, 75, 75, 93, 93, 93, 93, 93, 93, 93, 93, 113, 113, 113, 113, 135,135,135,135,135,135,135,135, 159,159,159,159,159,159,159,159, & - 12, 12, 11, 11, 10, 9, 15, 15, 15, 15, 23, 23, 33, 33, 33, 33, 45, 45, 59, 59, 75, 75, 75, 75, 93, 93, 93, 93, 93, 93, 93, 93, 113, 113, 113, 113, 135,135,135,135,135,135,135,135, 159,159,159,159,159,159,159,159, & - ! - 20, 20, 19, 19, 18, 18, 16, 17, 17, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & - 20, 20, 19, 19, 18, 18, 17, 16, 17, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & - 20, 20, 19, 19, 18, 18, 17, 17, 16, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & - 20, 20, 19, 19, 18, 18, 17, 17, 17, 16, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & - ! - 30, 30, 29, 29, 28, 28, 27, 27, 27, 27, 25, 26, 35, 35, 35, 35, 47, 47, 61, 61, 77, 77, 77, 77, 95, 95, 95, 95, 95, 95, 95, 95, 115, 115, 115, 115, 137,137,137,137,137,137,137,137, 161,161,161,161,161,161,161,161, & - 30, 30, 29, 29, 28, 28, 27, 27, 27, 27, 26, 25, 35, 35, 35, 35, 47, 47, 61, 61, 77, 77, 77, 77, 95, 95, 95, 95, 95, 95, 95, 95, 115, 115, 115, 115, 137,137,137,137,137,137,137,137, 161,161,161,161,161,161,161,161, & - ! - 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 36, 37, 37, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & - 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 36, 37, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & - 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 37, 36, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & - 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 37, 37, 36, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & - ! - 56, 56, 55, 55, 54, 54, 53, 53, 53, 53, 52, 52, 51, 51, 51, 51, 49, 50, 63, 63, 79, 79, 79, 79, 97, 97, 97, 97, 97, 97, 97, 97, 117, 117, 117, 117, 139,139,139,139,139,139,139,139, 163,163,163,163,163,163,163,163, & - 56, 56, 55, 55, 54, 54, 53, 53, 53, 53, 52, 52, 51, 51, 51, 51, 50, 49, 63, 63, 79, 79, 79, 79, 97, 97, 97, 97, 97, 97, 97, 97, 117, 117, 117, 117, 139,139,139,139,139,139,139,139, 163,163,163,163,163,163,163,163, & - ! - 72, 72, 71, 71, 70, 70, 69, 69, 69, 69, 68, 68, 67, 67, 67, 67, 66, 66, 64, 65, 80, 80, 80, 80, 98, 98, 98, 98, 98, 98, 98, 98, 118, 118, 118, 118, 140,140,140,140,140,140,140,140, 164,164,164,164,164,164,164,164, & - 72, 72, 71, 71, 70, 70, 69, 69, 69, 69, 68, 68, 67, 67, 67, 67, 66, 66, 65, 64, 80, 80, 80, 80, 98, 98, 98, 98, 98, 98, 98, 98, 118, 118, 118, 118, 140,140,140,140,140,140,140,140, 164,164,164,164,164,164,164,164, & - ! - 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 81, 82, 82, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & - 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 81, 82, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & - 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 82, 81, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & - 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 82, 82, 81, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & - ! - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 100,101,101,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,100,101,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,100,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,100,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,100,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,100,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,101,100,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,101,101,100, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - ! - 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 122, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & - 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 121, 122, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & - 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 121, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & - 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 122, 121, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & - ! - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 144,145,145,145,145,145,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,144,145,145,145,145,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,144,145,145,145,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,144,145,145,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,144,145,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,144,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,145,144,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,145,145,144, 168,168,168,168,168,168,168,168, & - ! - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,169,170,170,170,170,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,169,170,170,170,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,170,169,170,170,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,170,170,169,170,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,169,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,169,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,170,169 & - ],pInt),[lattice_bct_Nslip,lattice_bct_Nslip],order=[2,1]) - !-------------------------------------------------------------------------------------------------- ! isotropic @@ -655,8 +466,7 @@ module lattice LATTICE_bct_Nslip), & !< max # of slip systems over lattice structures LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & LATTICE_hex_Ncleavage, & - LATTICE_iso_Ncleavage,LATTICE_ort_Ncleavage), & !< max # of cleavage systems over lattice structures - LATTICE_maxNinteraction = 182_pInt + LATTICE_iso_Ncleavage,LATTICE_ort_Ncleavage) !< max # of cleavage systems over lattice structures !END DEPRECATED real(pReal), dimension(:,:,:), allocatable, public, protected :: & @@ -757,7 +567,6 @@ subroutine lattice_init allocate(lattice_nu(Nphases), source=0.0_pReal) allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt) - allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt) ! other:me allocate(lattice_Scleavage(3,3,3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_Scleavage_v(6,3,lattice_maxNslip,Nphases),source=0.0_pReal) @@ -905,7 +714,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA) myNcleavage = lattice_fcc_Ncleavage lattice_NslipSystem (1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_fcc_interactionSlipSlip lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & lattice_SchmidMatrix_cleavage(lattice_fcc_ncleavageSystem,'fcc',covera) @@ -923,7 +731,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA) myNcleavage = lattice_bcc_Ncleavage lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bcc_NslipSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bcc_NcleavageSystem - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bcc_interactionSlipSlip lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & lattice_SchmidMatrix_cleavage(lattice_bcc_ncleavagesystem,'bcc',covera) @@ -940,7 +747,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA) myNcleavage = lattice_hex_Ncleavage lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = LATTICE_HEX_NSLIPSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_hex_NcleavageSystem - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_hex_interactionSlipSlip lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & lattice_SchmidMatrix_cleavage(lattice_hex_ncleavagesystem,'hex',covera) @@ -960,7 +766,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA) case (LATTICE_bct_ID) myNslip = lattice_bct_Nslip lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bct_NslipSystem - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bct_interactionSlipSlip do i = 1_pInt,myNslip ! assign slip system vectors sd(1:2,i) = lattice_bct_systemSlip(1:2,i) @@ -1532,22 +1337,203 @@ function lattice_interaction_SlipSlip(Nslip,interactionValues,structure) result( integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt), dimension(:,:), allocatable :: interactionTypes + + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NSLIP), parameter :: & + FCC_INTERACTIONSLIPSLIP = reshape(int( [& + 1, 2, 2, 4, 6, 5, 3, 5, 5, 4, 5, 6, 9,10, 9,10,11,12, & ! ---> slip + 2, 1, 2, 6, 4, 5, 5, 4, 6, 5, 3, 5, 9,10,11,12, 9,10, & ! | + 2, 2, 1, 5, 5, 3, 5, 6, 4, 6, 5, 4, 11,12, 9,10, 9,10, & ! | + 4, 6, 5, 1, 2, 2, 4, 5, 6, 3, 5, 5, 9,10,10, 9,12,11, & ! v slip + 6, 4, 5, 2, 1, 2, 5, 3, 5, 5, 4, 6, 9,10,12,11,10, 9, & + 5, 5, 3, 2, 2, 1, 6, 5, 4, 5, 6, 4, 11,12,10, 9,10, 9, & + 3, 5, 5, 4, 5, 6, 1, 2, 2, 4, 6, 5, 10, 9,10, 9,11,12, & + 5, 4, 6, 5, 3, 5, 2, 1, 2, 6, 4, 5, 10, 9,12,11, 9,10, & + 5, 6, 4, 6, 5, 4, 2, 2, 1, 5, 5, 3, 12,11,10, 9, 9,10, & + 4, 5, 6, 3, 5, 5, 4, 6, 5, 1, 2, 2, 10, 9, 9,10,12,11, & + 5, 3, 5, 5, 4, 6, 6, 4, 5, 2, 1, 2, 10, 9,11,12,10, 9, & + 6, 5, 4, 5, 6, 4, 5, 5, 3, 2, 2, 1, 12,11, 9,10,10, 9, & + + 9, 9,11, 9, 9,11,10,10,12,10,10,12, 1, 7, 8, 8, 8, 8, & + 10,10,12,10,10,12, 9, 9,11, 9, 9,11, 7, 1, 8, 8, 8, 8, & + 9,11, 9,10,12,10,10,12,10, 9,11, 9, 8, 8, 1, 7, 8, 8, & + 10,12,10, 9,11, 9, 9,11, 9,10,12,10, 8, 8, 7, 1, 8, 8, & + 11, 9, 9,12,10,10,11, 9, 9,12,10,10, 8, 8, 8, 8, 1, 7, & + 12,10,10,11, 9, 9,12,10,10,11, 9, 9, 8, 8, 8, 8, 7, 1 & + ],pInt),shape(FCC_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for fcc + !< 1: self interaction + !< 2: coplanar interaction + !< 3: collinear interaction + !< 4: Hirth locks + !< 5: glissile junctions + !< 6: Lomer locks + !< 7: crossing (similar to Hirth locks in <110>{111} for two {110} planes) + !< 8: similar to Lomer locks in <110>{111} for two {110} planes + !< 9: similar to Lomer locks in <110>{111} btw one {110} and one {111} plane + !<10: similar to glissile junctions in <110>{111} btw one {110} and one {111} plane + !<11: crossing btw one {110} and one {111} plane + !<12: collinear btw one {110} and one {111} plane + + integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NSLIP), parameter :: & + BCC_INTERACTIONSLIPSLIP = reshape(int( [& + 1,2,6,6,5,4,4,3,4,3,5,4, 6,6,4,3,3,4,6,6,4,3,6,6, & ! ---> slip + 2,1,6,6,4,3,5,4,5,4,4,3, 6,6,3,4,4,3,6,6,3,4,6,6, & ! | + 6,6,1,2,4,5,3,4,4,5,3,4, 4,3,6,6,6,6,3,4,6,6,4,3, & ! | + 6,6,2,1,3,4,4,5,3,4,4,5, 3,4,6,6,6,6,4,3,6,6,3,4, & ! v slip + 5,4,4,3,1,2,6,6,3,4,5,4, 3,6,4,6,6,4,6,3,4,6,3,6, & + 4,3,5,4,2,1,6,6,4,5,4,3, 4,6,3,6,6,3,6,4,3,6,4,6, & + 4,5,3,4,6,6,1,2,5,4,3,4, 6,3,6,4,4,6,3,6,6,4,6,3, & + 3,4,4,5,6,6,2,1,4,3,4,5, 6,4,6,3,3,6,4,6,6,3,6,4, & + 4,5,4,3,3,4,5,4,1,2,6,6, 3,6,6,4,4,6,6,3,6,4,3,6, & + 3,4,5,4,4,5,4,3,2,1,6,6, 4,6,6,3,3,6,6,4,6,3,4,6, & + 5,4,3,4,5,4,3,4,6,6,1,2, 6,3,4,6,6,4,3,6,4,6,6,3, & + 4,3,4,5,4,3,4,5,6,6,2,1, 6,4,3,6,6,3,4,6,3,6,6,4, & + ! + 6,6,4,3,3,4,6,6,3,4,6,6, 1,5,6,6,5,6,6,3,5,6,3,6, & + 6,6,3,4,6,6,3,4,6,6,3,4, 5,1,6,6,6,5,3,6,6,5,6,3, & + 4,3,6,6,4,3,6,6,6,6,4,3, 6,6,1,5,6,3,5,6,3,6,5,6, & + 3,4,6,6,6,6,4,3,4,3,6,6, 6,6,5,1,3,6,6,5,6,3,6,5, & + 3,4,6,6,6,6,4,3,4,3,6,6, 5,6,6,3,1,6,5,6,5,3,6,6, & + 4,3,6,6,4,3,6,6,6,6,4,3, 6,5,3,6,6,1,6,5,3,5,6,6, & + 6,6,3,4,6,6,3,4,6,6,3,4, 6,3,5,6,5,6,1,6,6,6,5,3, & + 6,6,4,3,3,4,6,6,3,4,6,6, 3,6,6,5,6,5,6,1,6,6,3,5, & + 4,3,6,6,4,3,6,6,6,6,4,3, 5,6,3,6,5,3,6,6,1,6,6,5, & + 3,4,6,6,6,6,4,3,4,3,6,6, 6,5,6,3,3,5,6,6,6,1,5,6, & + 6,6,4,3,3,4,6,6,3,4,6,6, 3,6,5,6,6,6,5,3,6,5,1,6, & + 6,6,3,4,6,6,3,4,6,6,3,4, 6,3,6,5,6,6,3,5,5,6,6,1 & + ],pInt),shape(BCC_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for bcc from Queyreau et al. Int J Plast 25 (2009) 361–377 + !< 1: self interaction + !< 2: coplanar interaction + !< 3: collinear interaction + !< 4: mixed-asymmetrical junction + !< 5: mixed-symmetrical junction + !< 6: edge junction + + integer(pInt), dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NSLIP), parameter :: & + HEX_INTERACTIONSLIPSLIP = reshape(int( [& + 1, 2, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! ---> slip + 2, 1, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! | + 2, 2, 1, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! | + ! v slip + 6, 6, 6, 4, 5, 5, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & + 6, 6, 6, 5, 4, 5, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & + 6, 6, 6, 5, 5, 4, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & + ! + 12,12,12, 11,11,11, 9,10,10, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & + 12,12,12, 11,11,11, 10, 9,10, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & + 12,12,12, 11,11,11, 10,10, 9, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & + ! + 20,20,20, 19,19,19, 18,18,18, 16,17,17,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + 20,20,20, 19,19,19, 18,18,18, 17,16,17,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + 20,20,20, 19,19,19, 18,18,18, 17,17,16,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + 20,20,20, 19,19,19, 18,18,18, 17,17,17,16,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + 20,20,20, 19,19,19, 18,18,18, 17,17,17,17,16,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + 20,20,20, 19,19,19, 18,18,18, 17,17,17,17,17,16, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + ! + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 25,26,26,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,25,26,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,25,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,25,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,25,26,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,25,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,25,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,25,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,25,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,25,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,26,25,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,26,26,25, 35,35,35,35,35,35, & + ! + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 36,37,37,37,37,37, & + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,36,37,37,37,37, & + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,36,37,37,37, & + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,36,37,37, & + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,36,37, & + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,37,36 & + ],pInt),shape(HEX_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for hex (onion peel naming scheme) + + integer(pInt), dimension(LATTICE_BCT_NSLIP,LATTICE_BCT_NSLIP), parameter :: & + BCT_INTERACTIONSLIPSLIP = reshape(int( [& + 1, 2, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & + 2, 1, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & + ! + 6, 6, 4, 5, 8, 8, 14, 14, 14, 14, 22, 22, 32, 32, 32, 32, 44, 44, 58, 58, 74, 74, 74, 74, 92, 92, 92, 92, 92, 92, 92, 92, 112, 112, 112, 112, 134,134,134,134,134,134,134,134, 158,158,158,158,158,158,158,158, & + 6, 6, 5, 4, 8, 8, 14, 14, 14, 14, 22, 22, 32, 32, 32, 32, 44, 44, 58, 58, 74, 74, 74, 74, 92, 92, 92, 92, 92, 92, 92, 92, 112, 112, 112, 112, 134,134,134,134,134,134,134,134, 158,158,158,158,158,158,158,158, & + ! + 12, 12, 11, 11, 9, 10, 15, 15, 15, 15, 23, 23, 33, 33, 33, 33, 45, 45, 59, 59, 75, 75, 75, 75, 93, 93, 93, 93, 93, 93, 93, 93, 113, 113, 113, 113, 135,135,135,135,135,135,135,135, 159,159,159,159,159,159,159,159, & + 12, 12, 11, 11, 10, 9, 15, 15, 15, 15, 23, 23, 33, 33, 33, 33, 45, 45, 59, 59, 75, 75, 75, 75, 93, 93, 93, 93, 93, 93, 93, 93, 113, 113, 113, 113, 135,135,135,135,135,135,135,135, 159,159,159,159,159,159,159,159, & + ! + 20, 20, 19, 19, 18, 18, 16, 17, 17, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & + 20, 20, 19, 19, 18, 18, 17, 16, 17, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & + 20, 20, 19, 19, 18, 18, 17, 17, 16, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & + 20, 20, 19, 19, 18, 18, 17, 17, 17, 16, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & + ! + 30, 30, 29, 29, 28, 28, 27, 27, 27, 27, 25, 26, 35, 35, 35, 35, 47, 47, 61, 61, 77, 77, 77, 77, 95, 95, 95, 95, 95, 95, 95, 95, 115, 115, 115, 115, 137,137,137,137,137,137,137,137, 161,161,161,161,161,161,161,161, & + 30, 30, 29, 29, 28, 28, 27, 27, 27, 27, 26, 25, 35, 35, 35, 35, 47, 47, 61, 61, 77, 77, 77, 77, 95, 95, 95, 95, 95, 95, 95, 95, 115, 115, 115, 115, 137,137,137,137,137,137,137,137, 161,161,161,161,161,161,161,161, & + ! + 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 36, 37, 37, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & + 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 36, 37, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & + 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 37, 36, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & + 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 37, 37, 36, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & + ! + 56, 56, 55, 55, 54, 54, 53, 53, 53, 53, 52, 52, 51, 51, 51, 51, 49, 50, 63, 63, 79, 79, 79, 79, 97, 97, 97, 97, 97, 97, 97, 97, 117, 117, 117, 117, 139,139,139,139,139,139,139,139, 163,163,163,163,163,163,163,163, & + 56, 56, 55, 55, 54, 54, 53, 53, 53, 53, 52, 52, 51, 51, 51, 51, 50, 49, 63, 63, 79, 79, 79, 79, 97, 97, 97, 97, 97, 97, 97, 97, 117, 117, 117, 117, 139,139,139,139,139,139,139,139, 163,163,163,163,163,163,163,163, & + ! + 72, 72, 71, 71, 70, 70, 69, 69, 69, 69, 68, 68, 67, 67, 67, 67, 66, 66, 64, 65, 80, 80, 80, 80, 98, 98, 98, 98, 98, 98, 98, 98, 118, 118, 118, 118, 140,140,140,140,140,140,140,140, 164,164,164,164,164,164,164,164, & + 72, 72, 71, 71, 70, 70, 69, 69, 69, 69, 68, 68, 67, 67, 67, 67, 66, 66, 65, 64, 80, 80, 80, 80, 98, 98, 98, 98, 98, 98, 98, 98, 118, 118, 118, 118, 140,140,140,140,140,140,140,140, 164,164,164,164,164,164,164,164, & + ! + 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 81, 82, 82, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & + 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 81, 82, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & + 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 82, 81, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & + 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 82, 82, 81, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & + ! + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 100,101,101,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,100,101,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,100,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,100,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,100,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,100,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,101,100,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,101,101,100, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + ! + 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 122, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & + 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 121, 122, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & + 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 121, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & + 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 122, 121, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & + ! + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 144,145,145,145,145,145,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,144,145,145,145,145,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,144,145,145,145,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,144,145,145,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,144,145,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,144,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,145,144,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,145,145,144, 168,168,168,168,168,168,168,168, & + ! + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,169,170,170,170,170,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,169,170,170,170,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,170,169,170,170,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,170,170,169,170,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,169,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,169,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,170,169 & + ],pInt),shape(BCT_INTERACTIONSLIPSLIP),order=[2,1]) + if (len_trim(structure) /= 3_pInt) & call IO_error(137_pInt,ext_msg='lattice_interaction_SlipSlip: '//trim(structure)) select case(structure(1:3)) case('fcc') - interactionTypes = LATTICE_FCC_INTERACTIONSLIPSLIP + interactionTypes = FCC_INTERACTIONSLIPSLIP NslipMax = LATTICE_FCC_NSLIPSYSTEM case('bcc') - interactionTypes = LATTICE_BCC_INTERACTIONSLIPSLIP + interactionTypes = BCC_INTERACTIONSLIPSLIP NslipMax = LATTICE_BCC_NSLIPSYSTEM case('hex') - interactionTypes = LATTICE_HEX_INTERACTIONSLIPSLIP + interactionTypes = HEX_INTERACTIONSLIPSLIP NslipMax = LATTICE_HEX_NSLIPSYSTEM case('bct') - interactionTypes = LATTICE_BCT_INTERACTIONSLIPSLIP + interactionTypes = BCT_INTERACTIONSLIPSLIP NslipMax = LATTICE_BCT_NSLIPSYSTEM case default call IO_error(137_pInt,ext_msg='lattice_interaction_SlipSlip: '//trim(structure)) From 27cf60e64d3abb253023fd36e3188840f40b4779 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 17 Feb 2019 22:59:51 +0100 Subject: [PATCH 241/309] backup relevant documentation --- .gitlab-ci.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ce822fea1..9b992136c 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -524,11 +524,10 @@ backupData: - cd $TESTROOT/performance # location of new runtime results - git commit -am"${CI_PIPELINE_ID}_${CI_COMMIT_SHA}" - mkdir $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA} - - cp $TESTROOT/performance/time.txt $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ - mv $TESTROOT/performance/time.png $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ - - cp $TESTROOT/performance/memory.txt $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ - mv $TESTROOT/performance/memory.png $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ - mv $DAMASKROOT/PRIVATE/documenting/DAMASK_* $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ + - mv $DAMASKROOT/processing $BACKUP/${CI_PIPELINE_ID}_${CI_COMMIT_SHA}/ only: - development From 77ac0d647e9ef606adb7752db4d65433ae4366d8 Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 17 Feb 2019 22:19:52 +0000 Subject: [PATCH 242/309] [skip ci] updated version information after successful test of v2.0.2-1826-gd2a9f55a --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 777f5cfdb..0bd4d9b5b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1808-g530f4f28 +v2.0.2-1826-gd2a9f55a From 435dce220c615e2bf01c1044977163c6529be4b4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 18 Feb 2019 07:24:56 +0100 Subject: [PATCH 243/309] move stress conversion one level up should be totally avoided --- src/constitutive.f90 | 40 ++++++++++++++++++++-------------------- src/crystallite.f90 | 8 +++++--- 2 files changed, 25 insertions(+), 23 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 64f7cb60e..e5adaf4cf 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -176,8 +176,6 @@ subroutine constitutive_init() call config_deallocate('material.config/phase') write(6,'(/,a)') ' <<<+- constitutive init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" mainProcess: if (worldrank == 0) then !-------------------------------------------------------------------------------------------------- @@ -525,7 +523,8 @@ end subroutine constitutive_LpAndItsTangents !> @brief contains the constitutive equation for calculating the velocity gradient ! ToDo: MD: S is Mi? !-------------------------------------------------------------------------------------------------- -subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, el) +subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & + S, Fi, ipc, ip, el) use prec, only: & pReal use math, only: & @@ -560,8 +559,8 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), intent(in), dimension(6) :: & - S6 !< 2nd Piola-Kirchhoff stress (vector notation) + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola-Kirchhoff stress real(pReal), intent(in), dimension(3,3) :: & Fi !< intermediate deformation gradient real(pReal), intent(out), dimension(3,3) :: & @@ -590,7 +589,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e case (PLASTICITY_isotropic_ID) plasticityType of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6),instance,of) + call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) case default plasticityType my_Li = 0.0_pReal my_dLi_dS = 0.0_pReal @@ -602,9 +601,9 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e KinematicsLoop: do k = 1_pInt, phase_Nkinematics(material_phase(ipc,ip,el)) kinematicsType: select case (phase_kinematics(k,material_phase(ipc,ip,el))) case (KINEMATICS_cleavage_opening_ID) kinematicsType - call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6), ipc, ip, el) + call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ipc, ip, el) case (KINEMATICS_slipplane_opening_ID) kinematicsType - call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6), ipc, ip, el) + call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ipc, ip, el) case (KINEMATICS_thermal_expansion_ID) kinematicsType call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el) case default kinematicsType @@ -703,7 +702,8 @@ end subroutine constitutive_SandItsTangents !> @brief returns the 2nd Piola-Kirchhoff stress tensor and its tangent with respect to !> the elastic and intermeidate deformation gradients using Hookes law !-------------------------------------------------------------------------------------------------- -subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip, el) +subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & + Fe, Fi, ipc, ip, el) use prec, only: & pReal use math, only : & @@ -767,7 +767,7 @@ end subroutine constitutive_hooke_SandItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfracArray,ipc, ip, el) +subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, subfracArray,ipc, ip, el) use prec, only: & pReal, & pLongInt @@ -839,20 +839,20 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac FpArray !< plastic deformation gradient real(pReal), intent(in), dimension(3,3) :: & Fi !< intermediate deformation gradient - real(pReal), intent(in), dimension(6) :: & - S6 !< 2nd Piola Kirchhoff stress (vector notation) + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola Kirchhoff stress (vector notation) real(pReal), dimension(3,3) :: & Mp integer(pInt) :: & ho, & !< homogenization tme, & !< thermal member position - s, & !< counter in source loop + i, & !< counter in source loop instance, of ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) - Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_6toSym33(S6)) + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) @@ -886,21 +886,21 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac subdt,subfracArray,ip,el) end select plasticityType - SourceLoop: do s = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) + SourceLoop: do i = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) - sourceType: select case (phase_source(s,material_phase(ipc,ip,el))) + sourceType: select case (phase_source(i,material_phase(ipc,ip,el))) case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState (math_6toSym33(S6), ipc, ip, el) !< correct stress? + call source_damage_anisoBrittle_dotState (S, ipc, ip, el) !< correct stress? case (SOURCE_damage_isoDuctile_ID) sourceType - call source_damage_isoDuctile_dotState ( ipc, ip, el) + call source_damage_isoDuctile_dotState ( ipc, ip, el) case (SOURCE_damage_anisoDuctile_ID) sourceType - call source_damage_anisoDuctile_dotState ( ipc, ip, el) + call source_damage_anisoDuctile_dotState ( ipc, ip, el) case (SOURCE_thermal_externalheat_ID) sourceType - call source_thermal_externalheat_dotState( ipc, ip, el) + call source_thermal_externalheat_dotState( ipc, ip, el) end select sourceType diff --git a/src/crystallite.f90 b/src/crystallite.f90 index f049cd400..b357b4a02 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -761,7 +761,7 @@ subroutine crystallite_stressTangent() crystallite_Fe(1:3,1:3,c,i,e), & crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate elastic stress tangent call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & - crystallite_Tstar_v(1:6,c,i,e), & + math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & crystallite_Fi(1:3,1:3,c,i,e), & c,i,e) ! call constitutive law to calculate Li tangent in lattice configuration @@ -1387,7 +1387,7 @@ logical function integrateStress(& !* calculate intermediate velocity gradient and its tangent from constitutive law call constitutive_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, & - math_sym33to6(S), Fi_new, ipc, ip, el) + S, Fi_new, ipc, ip, el) #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & @@ -2268,6 +2268,8 @@ end subroutine update_state subroutine update_dotState(timeFraction) use, intrinsic :: & IEEE_arithmetic + use math, only: & + math_6toSym33 !ToDo: Temporarly needed until T_star_v is called S and stored as matrix use material, only: & plasticState, & sourceState, & @@ -2300,7 +2302,7 @@ subroutine update_dotState(timeFraction) do g = 1,homogenization_Ngrains(mesh_element(3,e)) !$OMP FLUSH(nonlocalStop) if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then - call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & + call constitutive_collectDotState(math_6toSym33(crystallite_Tstar_v(1:6,g,i,e)), & crystallite_Fe, & crystallite_Fi(1:3,1:3,g,i,e), & crystallite_Fp, & From 2ac60dabd94116f37357a222dd89e1e453249f9d Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 18 Feb 2019 08:27:30 +0000 Subject: [PATCH 244/309] [skip ci] updated version information after successful test of v2.0.2-1829-ga0afed46 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 0bd4d9b5b..ccca69d77 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1826-gd2a9f55a +v2.0.2-1829-ga0afed46 From ae9d8e4e8d7f4dbc05d1c4457d1453d0b008c7c7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 18 Feb 2019 10:28:08 +0100 Subject: [PATCH 245/309] cleaning --- src/lattice.f90 | 8 +- src/plastic_nonlocal.f90 | 213 ++++++++++++--------------------------- 2 files changed, 68 insertions(+), 153 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 9ed8cced4..b9fb71065 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -30,7 +30,6 @@ module lattice lattice_sn, & !< normal direction of slip system lattice_st, & !< sd x sn lattice_sd !< slip direction of slip system - ! END DEPRECATED @@ -273,7 +272,7 @@ module lattice -2, 1, 1, 3, 2, -1, -1, 2, & 1, -2, 1, 3, -1, 2, -1, 2, & 1, 1, -2, 3, -1, -1, 2, 2 & - ],pReal),shape(LATTICE_HEX_SYSTEMSLIP)) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr + ],pReal),shape(LATTICE_HEX_SYSTEMSLIP)) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr character(len=*), dimension(6), parameter, private :: LATTICE_HEX_SLIPFAMILY_NAME = & ['<1 1 . 1>{0 0 . 1} ', & @@ -313,7 +312,7 @@ module lattice -2, 1, 1, -3, -2, 1, 1, 2, & 1, -2, 1, -3, 1, -2, 1, 2, & 1, 1, -2, -3, 1, 1, -2, 2 & - ],pReal),shape(LATTICE_HEX_SYSTEMTWIN)) !< twin systems for hex, order follows Prof. Tom Bieler's scheme; but numbering in data was restarted from 1 + ],pReal),shape(LATTICE_HEX_SYSTEMTWIN)) !< twin systems for hex, order follows Prof. Tom Bieler's scheme character(len=*), dimension(4), parameter, private :: LATTICE_HEX_TWINFAMILY_NAME = & ['<-1 0 . 1>{1 0 . 2} ', & @@ -406,7 +405,7 @@ module lattice 1,-1, 1, -2,-1, 1, & -1, 1, 1, -1,-2, 1, & 1, 1, 1, 1,-2, 1 & - ],pReal),[ 3_pInt + 3_pInt,LATTICE_bct_Nslip]) !< slip systems for bct sorted by Bieler + ],pReal),[ 3_pInt + 3_pInt,LATTICE_bct_Nslip]) !< slip systems for bct sorted by Bieler character(len=*), dimension(13), parameter, private :: LATTICE_BCT_SLIPFAMILY_NAME = & ['{1 0 0)<0 0 1] ', & @@ -495,6 +494,7 @@ module lattice LATTICE_bct_ID, & LATTICE_ort_ID end enum + integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public, protected :: & lattice_structure, trans_lattice_structure diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 8727e576c..79b1df55a 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -51,11 +51,8 @@ module plastic_nonlocal real(pReal), dimension(:), allocatable, private :: & atomicVolume, & !< atomic volume Dsd0, & !< prefactor for self-diffusion coefficient - selfDiffusionEnergy, & !< activation enthalpy for diffusion aTolRho, & !< absolute tolerance for dislocation density in state integration aTolShear, & !< absolute tolerance for accumulated shear in state integration - significantRho, & !< density considered significant - significantN, & !< number of dislocations considered significant cutoffRadius, & !< cutoff radius for dislocation stress doublekinkwidth, & !< width of a doubkle kink in multiples of the burgers vector length b solidSolutionEnergy, & !< activation energy for solid solution in J @@ -63,8 +60,6 @@ module plastic_nonlocal solidSolutionConcentration, & !< concentration of solid solution in atomic parts pParam, & !< parameter for kinetic law (Kocks,Argon,Ashby) qParam, & !< parameter for kinetic law (Kocks,Argon,Ashby) - viscosity, & !< viscosity for dislocation glide in Pa s - fattack, & !< attack frequency in Hz rhoSglScatter, & !< standard deviation of scatter in initial dislocation density surfaceTransmissivity, & !< transmissivity at free surface grainboundaryTransmissivity, & !< transmissivity at grain boundary (identified by different texture) @@ -72,8 +67,7 @@ module plastic_nonlocal fEdgeMultiplication, & !< factor that determines how much edge dislocations contribute to multiplication (0...1) rhoSglRandom, & rhoSglRandomBinning, & - linetensionEffect, & - edgeJogFactor + linetensionEffect real(pReal), dimension(:,:), allocatable, private :: & rhoSglEdgePos0, & !< initial edge_pos dislocation density per slip system for each family and instance @@ -204,9 +198,6 @@ module plastic_nonlocal interactionSlipSlip ,& !< coefficients for slip-slip interaction for each interaction type and instance forestProjectionEdge, & !< matrix of forest projections of edge dislocations for each instance forestProjectionScrew !< matrix of forest projections of screw dislocations for each instance - integer(pInt), dimension(:), allocatable, private :: & - iGamma, & !< state indices for accumulated shear - iRhoF !< state indices for forest density real(pReal), dimension(:), allocatable, private :: & nonSchmidCoeff integer(pInt) :: totalNslip @@ -249,7 +240,7 @@ module plastic_nonlocal private :: & plastic_nonlocal_kinetics - + contains @@ -310,12 +301,9 @@ integer(pInt) :: phase, & s, & ! index of my slip system s1, & ! index of my slip system s2, & ! index of my slip system - it, & ! index of my interaction type t, & ! index of dislocation type c, & ! index of dislocation character - Nchunks_SlipSlip = 0_pInt, & - Nchunks_SlipFamilies = 0_pInt, & - mySize = 0_pInt ! to suppress warnings, safe as init is called only once + Nchunks_SlipFamilies character(len=65536) :: & tag = '', & line = '' @@ -354,11 +342,8 @@ allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(totalNslip(maxNinstances), source=0_pInt) allocate(atomicVolume(maxNinstances), source=0.0_pReal) allocate(Dsd0(maxNinstances), source=-1.0_pReal) -allocate(selfDiffusionEnergy(maxNinstances), source=0.0_pReal) allocate(aTolRho(maxNinstances), source=0.0_pReal) allocate(aTolShear(maxNinstances), source=0.0_pReal) -allocate(significantRho(maxNinstances), source=0.0_pReal) -allocate(significantN(maxNinstances), source=0.0_pReal) allocate(cutoffRadius(maxNinstances), source=-1.0_pReal) allocate(doublekinkwidth(maxNinstances), source=0.0_pReal) allocate(solidSolutionEnergy(maxNinstances), source=0.0_pReal) @@ -366,8 +351,6 @@ allocate(solidSolutionSize(maxNinstances), source=0.0_pReal) allocate(solidSolutionConcentration(maxNinstances), source=0.0_pReal) allocate(pParam(maxNinstances), source=1.0_pReal) allocate(qParam(maxNinstances), source=1.0_pReal) -allocate(viscosity(maxNinstances), source=0.0_pReal) -allocate(fattack(maxNinstances), source=0.0_pReal) allocate(rhoSglScatter(maxNinstances), source=0.0_pReal) allocate(rhoSglRandom(maxNinstances), source=0.0_pReal) allocate(rhoSglRandomBinning(maxNinstances), source=1.0_pReal) @@ -376,7 +359,6 @@ allocate(grainboundaryTransmissivity(maxNinstances), source=-1.0_pReal) allocate(CFLfactor(maxNinstances), source=2.0_pReal) allocate(fEdgeMultiplication(maxNinstances), source=0.0_pReal) allocate(linetensionEffect(maxNinstances), source=0.0_pReal) -allocate(edgeJogFactor(maxNinstances), source=1.0_pReal) allocate(shortRangeStressCorrection(maxNinstances), source=.false.) allocate(probabilisticMultiplication(maxNinstances), source=.false.) @@ -469,20 +451,12 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s atomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) case('selfdiffusionprefactor','dsd0') Dsd0(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('selfdiffusionenergy','qsd') - selfDiffusionEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) case('atol_rho','atol_density','absolutetolerancedensity','absolutetolerance_density') aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) case('atol_shear','atol_plasticshear','atol_accumulatedshear','absolutetoleranceshear','absolutetolerance_shear') aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('significantrho','significant_rho','significantdensity','significant_density') - significantRho(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('significantn','significant_n','significantdislocations','significant_dislcations') - significantN(instance) = IO_floatValue(line,chunkPos,2_pInt) case('linetension','linetensioneffect','linetension_effect') linetensionEffect(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('edgejog','edgejogs','edgejogeffect','edgejog_effect') - edgeJogFactor(instance) = IO_floatValue(line,chunkPos,2_pInt) case('peierlsstressedge','peierlsstress_edge') do f = 1_pInt, Nchunks_SlipFamilies peierlsStressPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) @@ -503,10 +477,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s pParam(instance) = IO_floatValue(line,chunkPos,2_pInt) case('q') qParam(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('viscosity','glideviscosity') - viscosity(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('attackfrequency','fattack') - fattack(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglscatter') rhoSglScatter(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglrandom') @@ -564,24 +534,16 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s enddo if (linetensionEffect(instance) < 0.0_pReal .or. linetensionEffect(instance) > 1.0_pReal) & call IO_error(211_pInt,ext_msg='linetension ('//PLASTICITY_NONLOCAL_label//')') - if (edgeJogFactor(instance) < 0.0_pReal .or. edgeJogFactor(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='edgejog ('//PLASTICITY_NONLOCAL_label//')') if (cutoffRadius(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='r ('//PLASTICITY_NONLOCAL_label//')') if (atomicVolume(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='atomicVolume ('//PLASTICITY_NONLOCAL_label//')') if (Dsd0(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='selfDiffusionPrefactor ('//PLASTICITY_NONLOCAL_label//')') - if (selfDiffusionEnergy(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='selfDiffusionEnergy ('//PLASTICITY_NONLOCAL_label//')') if (aTolRho(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='aTol_rho ('//PLASTICITY_NONLOCAL_label//')') if (aTolShear(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='aTol_shear ('//PLASTICITY_NONLOCAL_label//')') - if (significantRho(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='significantRho ('//PLASTICITY_NONLOCAL_label//')') - if (significantN(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='significantN ('//PLASTICITY_NONLOCAL_label//')') if (doublekinkwidth(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='doublekinkwidth ('//PLASTICITY_NONLOCAL_label//')') if (solidSolutionEnergy(instance) <= 0.0_pReal) & @@ -594,10 +556,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s call IO_error(211_pInt,ext_msg='p ('//PLASTICITY_NONLOCAL_label//')') if (qParam(instance) < 1.0_pReal .or. qParam(instance) > 2.0_pReal) & call IO_error(211_pInt,ext_msg='q ('//PLASTICITY_NONLOCAL_label//')') - if (viscosity(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='viscosity ('//PLASTICITY_NONLOCAL_label//')') - if (fattack(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='attackFrequency ('//PLASTICITY_NONLOCAL_label//')') if (rhoSglScatter(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') if (rhoSglRandom(instance) < 0.0_pReal) & @@ -930,6 +888,15 @@ param(instance)%probabilisticMultiplication = .false. prm%shortRangeStressCorrection = config_phase(p)%getInt('shortrangestresscorrection' ) > 0_pInt prm%probabilisticMultiplication = config_phase(p)%keyExists('/probabilisticmultiplication/' )!,'randomsources','randommultiplication','discretesources') + + ! sanity checks + if ( prm%viscosity <= 0.0_pReal) extmsg = trim(extmsg)//' viscosity' + if ( prm%significantN < 0.0_pReal) extmsg = trim(extmsg)//' significantN' + if ( prm%significantrho < 0.0_pReal) extmsg = trim(extmsg)//' significantrho' + if ( prm%selfDiffusionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' selfDiffusionEnergy' + if ( prm%fattack <= 0.0_pReal) extmsg = trim(extmsg)//' fattack' + if (prm%edgeJogFactor < 0.0_pReal .or. prm%edgeJogFactor > 1.0_pReal) extmsg = trim(extmsg)//' edgeJogFactor' + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) @@ -1037,8 +1004,7 @@ use IO, only: IO_error use lattice, only: lattice_maxNslipFamily use math, only: math_sampleGaussVar use mesh, only: mesh_ipVolume, & - theMesh, & - mesh_element + theMesh use material, only: material_phase, & phase_plasticityInstance, & plasticState, & @@ -1190,7 +1156,6 @@ use debug, only: & debug_e use mesh, only: & theMesh, & - mesh_element, & mesh_ipNeighborhood, & mesh_ipCoordinates, & mesh_ipVolume, & @@ -1205,8 +1170,6 @@ use material, only: & use lattice, only: & lattice_sd, & lattice_st, & - lattice_mu, & - lattice_nu, & lattice_structure, & LATTICE_bcc_ID, & LATTICE_fcc_ID @@ -1314,16 +1277,16 @@ myInteractionMatrix = 0.0_pReal myInteractionMatrix(1:ns,1:ns) = prm%interactionSlipSlip(1:ns,1:ns) if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTICE_fcc_ID) then ! only fcc and bcc do s = 1_pInt,ns - myRhoForest = max(rhoForest(s),significantRho(instance)) - correction = ( 1.0_pReal - linetensionEffect(instance) & - + linetensionEffect(instance) & - * log(0.35_pReal * burgers(s,instance) * sqrt(myRhoForest)) & - / log(0.35_pReal * burgers(s,instance) * 1e6_pReal)) ** 2.0_pReal + myRhoForest = max(rhoForest(s),prm%significantRho) + correction = ( 1.0_pReal - prm%linetensionEffect & + + prm%linetensionEffect & + * log(0.35_pReal * prm%burgers(s) * sqrt(myRhoForest)) & + / log(0.35_pReal * prm%burgers(s) * 1e6_pReal)) ** 2.0_pReal myInteractionMatrix(s,1:ns) = correction * myInteractionMatrix(s,1:ns) enddo endif forall (s = 1_pInt:ns) & - tauThreshold(s) = lattice_mu(ph) * burgers(s,instance) & + tauThreshold(s) = prm%mu * prm%burgers(s) & * sqrt(dot_product((sum(abs(rhoSgl),2) + sum(abs(rhoDip),2)), myInteractionMatrix(s,1:ns))) @@ -1349,12 +1312,8 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then np = phaseAt(1,neighbor_ip,neighbor_el) no = phasememberAt(1,neighbor_ip,neighbor_el) if (neighbor_el > 0 .and. neighbor_ip > 0) then - neighbor_phase = material_phase(1,neighbor_ip,neighbor_el) - neighbor_instance = phase_plasticityInstance(neighbor_phase) - neighbor_ns = totalNslip(neighbor_instance) - if (.not. phase_localPlasticity(neighbor_phase) & - .and. neighbor_instance == instance) then ! same instance should be same structure - if (neighbor_ns == ns) then + neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) + if (neighbor_instance == instance) then ! same instance should be same structure nRealNeighbors = nRealNeighbors + 1_pInt forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) @@ -1376,10 +1335,6 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then if (math_mul3x3(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pReal) & ! neighboring connection points in opposite direction to face normal: must be periodic image connection_latticeConf(1:3,n) = normal_latticeConf * mesh_ipVolume(ip,el) & / mesh_ipArea(n,ip,el) ! instead take the surface normal scaled with the diameter of the cell - else - ! different number of active slip systems - call IO_error(-1_pInt,ext_msg='different number of active slip systems in neighboring IPs of same crystal structure') - endif else ! local neighbor or different lattice structure or different constitution instance -> use central values instead connection_latticeConf(1:3,n) = 0.0_pReal @@ -1438,8 +1393,8 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then !* gives the local stress correction when multiplied with a factor - tauBack(s) = - lattice_mu(ph) * burgers(s,instance) / (2.0_pReal * pi) & - * (rhoExcessGradient_over_rho(1) / (1.0_pReal - lattice_nu(ph)) & + tauBack(s) = - prm%mu * prm%burgers(s) / (2.0_pReal * pi) & + * (rhoExcessGradient_over_rho(1) / (1.0_pReal - prm%nu) & + rhoExcessGradient_over_rho(2)) enddo @@ -1528,6 +1483,7 @@ real(pReal) tauRel_P, & instance = phase_plasticityInstance(material_phase(1_pInt,ip,el)) ns = totalNslip(instance) +associate(prm => param(instance)) v = 0.0_pReal dv_dtau = 0.0_pReal dv_dtauNS = 0.0_pReal @@ -1549,7 +1505,7 @@ if (Temperature > 0.0_pReal) then criticalStress_P = peierlsStress(s,c,instance) activationEnergy_P = criticalStress_P * activationVolume_P tauRel_P = min(1.0_pReal, tauEff / criticalStress_P) ! ensure that the activation probability cannot become greater than one - tPeierls = 1.0_pReal / fattack(instance) & + tPeierls = 1.0_pReal / prm%fattack & * exp(activationEnergy_P / (KB * Temperature) & * (1.0_pReal - tauRel_P**pParam(instance))**qParam(instance)) if (tauEff < criticalStress_P) then @@ -1572,7 +1528,7 @@ if (Temperature > 0.0_pReal) then activationEnergy_S = solidSolutionEnergy(instance) criticalStress_S = activationEnergy_S / activationVolume_S tauRel_S = min(1.0_pReal, tauEff / criticalStress_S) ! ensure that the activation probability cannot become greater than one - tSolidSolution = 1.0_pReal / fattack(instance) & + tSolidSolution = 1.0_pReal / prm%fattack & * exp(activationEnergy_S / (KB * Temperature) & * (1.0_pReal - tauRel_S**pParam(instance))**qParam(instance)) if (tauEff < criticalStress_S) then @@ -1588,7 +1544,7 @@ if (Temperature > 0.0_pReal) then !* viscous glide velocity tauEff = abs(tau(s)) - tauThreshold(s) - mobility = burgers(s,instance) / viscosity(instance) + mobility = burgers(s,instance) / prm%viscosity vViscous = mobility * tauEff @@ -1620,6 +1576,7 @@ endif endif #endif +end associate end subroutine plastic_nonlocal_kinetics !-------------------------------------------------------------------------------------------------- @@ -1667,8 +1624,7 @@ integer(pInt) instance, & ph, & !phase number of, & !offset t, & !< dislocation type - s, & !< index of my current slip system - sLattice !< index of my current slip system according to lattice order + s !< index of my current slip system real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & rhoSgl !< single dislocation densities (including blocked) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & @@ -1698,8 +1654,8 @@ forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) endforall -where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & - .or. abs(rhoSgl) < significantRho(instance)) & +where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & + .or. abs(rhoSgl) < prm%significantRho) & rhoSgl = 0.0_pReal tauBack = plasticState(ph)%state(iTauB(1:ns,instance),of) @@ -1818,8 +1774,6 @@ use debug, only: debug_level, & debug_e use math, only: pi, & math_mul33xx33 -use lattice, only: lattice_mu, & - lattice_nu use mesh, only: mesh_ipVolume use material, only: material_phase, & plasticState, & @@ -1887,11 +1841,11 @@ forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) endforall tauBack = plasticState(ph)%state(iTauB(1:ns,instance),of) -where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & - .or. abs(rhoSgl) < significantRho(instance)) & +where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & + .or. abs(rhoSgl) < prm%significantRho) & rhoSgl = 0.0_pReal -where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & - .or. abs(rhoDip) < significantRho(instance)) & +where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & + .or. abs(rhoDip) < prm%significantRho) & rhoDip = 0.0_pReal @@ -1919,14 +1873,14 @@ enddo !*** calculate limits for stable dipole height -do s = 1_pInt,ns +do s = 1_pInt,prm%totalNslip tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = lattice_mu(ph) * burgers(1:ns,instance) & - / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) -dUpper(1:ns,2) = lattice_mu(ph) * burgers(1:ns,instance) / (4.0_pReal * pi * abs(tau)) +dUpper(1:ns,1) = prm%mu * prm%burgers & + / (8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau)) +dUpper(1:ns,2) = prm%mu * prm%burgers / (4.0_pReal * PI * abs(tau)) forall (c = 1_pInt:2_pInt) @@ -1995,7 +1949,6 @@ use, intrinsic :: & use prec, only: dNeq0, & dNeq, & dEq0 -use numerics, only: numerics_timeSyncing use IO, only: IO_error use debug, only: debug_level, & debug_constitutive, & @@ -2013,7 +1966,6 @@ use math, only: math_mul3x3, & math_det33, & pi use mesh, only: theMesh, & - mesh_element, & mesh_ipNeighborhood, & mesh_ipVolume, & mesh_ipArea, & @@ -2069,8 +2021,7 @@ integer(pInt) :: ph, & p,& !< phase shortcut np,& !< neighbour phase shortcut topp, & !< type of dislocation with opposite sign to t - s, & !< index of my current slip system - sLattice !< index of my current slip system according to lattice order + s !< index of my current slip system real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),10) :: & rhoDot, & !< density evolution rhoDotMultiplication, & !< density evolution by multiplication @@ -2086,7 +2037,6 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt my_rhoSgl !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & v, & !< current dislocation glide velocity - v0, & !< dislocation glide velocity at start of cryst inc my_v, & !< dislocation glide velocity of central ip neighbor_v, & !< dislocation glide velocity of enighboring ip gdot !< shear rates @@ -2161,26 +2111,13 @@ tauBack = plasticState(p)%state(iTauB(1:ns,instance),o) rhoSglOriginal = rhoSgl rhoDipOriginal = rhoDip -where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & - .or. abs(rhoSgl) < significantRho(instance)) & +where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & + .or. abs(rhoSgl) < prm%significantRho) & rhoSgl = 0.0_pReal -where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & - .or. abs(rhoDip) < significantRho(instance)) & +where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & + .or. abs(rhoDip) < prm%significantRho) & rhoDip = 0.0_pReal -if (numerics_timeSyncing) then - forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl0(s,t) = max(plasticState(p)%state0(iRhoU(s,t,instance),o), 0.0_pReal) - rhoSgl0(s,t+4_pInt) = plasticState(p)%state0(iRhoB(s,t,instance),o) - v0(s,t) = plasticState(p)%state0(iV (s,t,instance),o) - endforall - where (abs(rhoSgl0) * mesh_ipVolume(ip,el) ** 0.667_pReal < significantN(instance) & - .or. abs(rhoSgl0) < significantRho(instance)) & - rhoSgl0 = 0.0_pReal -endif - - - !*** sanity check for timestep if (timestep <= 0.0_pReal) then ! if illegal timestep... Why here and not on function entry?? @@ -2194,7 +2131,7 @@ endif !*** Calculate shear rate forall (t = 1_pInt:4_pInt) & - gdot(1_pInt:ns,t) = rhoSgl(1_pInt:ns,t) * burgers(1:ns,instance) * v(1:ns,t) + gdot(1_pInt:ns,t) = rhoSgl(1_pInt:ns,t) * prm%burgers(1:ns) * v(1:ns,t) #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & @@ -2365,23 +2302,14 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then endif if (considerEnteringFlux) then - if(numerics_timeSyncing .and. (dNeq(subfrac(1,neighbor_ip,neighbor_el),subfrac(1,ip,el)))) then ! for timesyncing: in case of a timestep at the interface we have to use "state0" to make sure that fluxes n both sides are equal - forall (s = 1:ns, t = 1_pInt:4_pInt) - - neighbor_v(s,t) = plasticState(np)%state0(iV (s,t,neighbor_instance),no) - neighbor_rhoSgl(s,t) = max(plasticState(np)%state0(iRhoU(s,t,neighbor_instance),no),0.0_pReal) - - endforall - else forall (s = 1:ns, t = 1_pInt:4_pInt) neighbor_v(s,t) = plasticState(np)%state(iV (s,t,neighbor_instance),no) neighbor_rhoSgl(s,t) = max(plasticState(np)%state(iRhoU(s,t,neighbor_instance),no), & 0.0_pReal) endforall - endif - where (neighbor_rhoSgl * mesh_ipVolume(neighbor_ip,neighbor_el) ** 0.667_pReal < significantN(instance) & - .or. neighbor_rhoSgl < significantRho(instance)) & + where (neighbor_rhoSgl * mesh_ipVolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%significantN & + .or. neighbor_rhoSgl < prm%significantRho) & neighbor_rhoSgl = 0.0_pReal normal_neighbor2me_defConf = math_det33(Favg) * math_mul33x3(math_inv33(transpose(Favg)), & mesh_ipAreaNormal(1:3,neighbor_n,neighbor_ip,neighbor_el)) ! calculate the normal of the interface in (average) deformed configuration (now pointing from my neighbor to me!!!) @@ -2433,17 +2361,6 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then !* use "state0" to make sure that fluxes on both sides of the (potential) timestep are equal. my_rhoSgl = rhoSgl my_v = v - if(numerics_timeSyncing) then - if (dEq0(subfrac(1_pInt,ip,el))) then - my_rhoSgl = rhoSgl0 - my_v = v0 - elseif (neighbor_n > 0_pInt) then - if (dEq0(subfrac(1_pInt,neighbor_ip,neighbor_el))) then - my_rhoSgl = rhoSgl0 - my_v = v0 - endif - endif - endif normal_me2neighbor_defConf = math_det33(Favg) & * math_mul33x3(math_inv33(transpose(Favg)), & @@ -2483,20 +2400,20 @@ endif !*** formation by glide do c = 1_pInt,2_pInt - rhoDotSingle2DipoleGlide(1:ns,2*c-1) = -2.0_pReal * dUpper(1:ns,c) / burgers(1:ns,instance) & + rhoDotSingle2DipoleGlide(1:ns,2*c-1) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns) & * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) & ! negative mobile --> positive mobile + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1)) & ! positive mobile --> negative mobile + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) ! positive mobile --> negative immobile - rhoDotSingle2DipoleGlide(1:ns,2*c) = -2.0_pReal * dUpper(1:ns,c) / burgers(1:ns,instance) & + rhoDotSingle2DipoleGlide(1:ns,2*c) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns) & * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) & ! negative mobile --> positive mobile + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1)) & ! positive mobile --> negative mobile + abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c))) ! negative mobile --> positive immobile - rhoDotSingle2DipoleGlide(1:ns,2*c+3) = -2.0_pReal * dUpper(1:ns,c) / burgers(1:ns,instance) & + rhoDotSingle2DipoleGlide(1:ns,2*c+3) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns) & * rhoSgl(1:ns,2*c+3) * abs(gdot(1:ns,2*c)) ! negative mobile --> positive immobile - rhoDotSingle2DipoleGlide(1:ns,2*c+4) = -2.0_pReal * dUpper(1:ns,c) / burgers(1:ns,instance) & + rhoDotSingle2DipoleGlide(1:ns,2*c+4) = -2.0_pReal * dUpper(1:ns,c) / prm%burgers(1:ns)& * rhoSgl(1:ns,2*c+4) * abs(gdot(1:ns,2*c-1)) ! positive mobile --> negative immobile rhoDotSingle2DipoleGlide(1:ns,c+8) = - rhoDotSingle2DipoleGlide(1:ns,2*c-1) & @@ -2511,7 +2428,7 @@ enddo rhoDotAthermalAnnihilation = 0.0_pReal forall (c=1_pInt:2_pInt) & - rhoDotAthermalAnnihilation(1:ns,c+8_pInt) = -2.0_pReal * dLower(1:ns,c) / burgers(1:ns,instance) & + rhoDotAthermalAnnihilation(1:ns,c+8_pInt) = -2.0_pReal * dLower(1:ns,c) / prm%burgers(1:ns) & * ( 2.0_pReal * (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) + rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1))) & ! was single hitting single + 2.0_pReal * (abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c)) + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) & ! was single hitting immobile single or was immobile single hit by single + rhoDip(1:ns,c) * (abs(gdot(1:ns,2*c-1)) + abs(gdot(1:ns,2*c)))) ! single knocks dipole constituent @@ -2519,16 +2436,16 @@ forall (c=1_pInt:2_pInt) & if (lattice_structure(ph) == LATTICE_fcc_ID) & ! only fcc forall (s = 1:ns, colinearSystem(s,instance) > 0_pInt) & rhoDotAthermalAnnihilation(colinearSystem(s,instance),1:2) = - rhoDotAthermalAnnihilation(s,10) & - * 0.25_pReal * sqrt(rhoForest(s)) * (dUpper(s,2) + dLower(s,2)) * edgeJogFactor(instance) + * 0.25_pReal * sqrt(rhoForest(s)) * (dUpper(s,2) + dLower(s,2)) * prm%edgeJogFactor !*** thermally activated annihilation of edge dipoles by climb rhoDotThermalAnnihilation = 0.0_pReal -selfDiffusion = Dsd0(instance) * exp(-selfDiffusionEnergy(instance) / (KB * Temperature)) -vClimb = atomicVolume(instance) * selfDiffusion / ( KB * Temperature ) & - * lattice_mu(ph) / ( 2.0_pReal * PI * (1.0_pReal-lattice_nu(ph)) ) & +selfDiffusion = prm%Dsd0 * exp(-prm%selfDiffusionEnergy / (KB * Temperature)) +vClimb = prm%atomicVolume * selfDiffusion / ( KB * Temperature ) & + * prm%mu / ( 2.0_pReal * PI * (1.0_pReal-prm%nu) ) & * 2.0_pReal / ( dUpper(1:ns,1) + dLower(1:ns,1) ) forall (s = 1_pInt:ns, dUpper(s,1) > dLower(s,1)) & rhoDotThermalAnnihilation(s,9) = max(- 4.0_pReal * rhoDip(s,1) * vClimb(s) / (dUpper(s,1) - dLower(s,1)), & @@ -2621,8 +2538,7 @@ use material, only: material_phase, & phase_localPlasticity, & phase_plasticityInstance, & homogenization_maxNgrains -use mesh, only: mesh_element, & - mesh_ipNeighborhood, & +use mesh, only: mesh_ipNeighborhood, & theMesh use lattice, only: lattice_sn, & lattice_sd, & @@ -2671,7 +2587,7 @@ instance = phase_plasticityInstance(ph) ns = totalNslip(instance) slipNormal(1:3,1:ns) = lattice_sn(1:3, slipSystemLattice(1:ns,instance), ph) slipDirection(1:3,1:ns) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph) - +associate(prm => param(instance)) !*** start out fully compatible @@ -2689,7 +2605,7 @@ neighbors: do n = 1_pInt,Nneighbors !* Set surface transmissivity to the value specified in the material.config if (neighbor_e <= 0_pInt .or. neighbor_i <= 0_pInt) then - forall(s1 = 1_pInt:ns) my_compatibility(1:2,s1,s1,n) = sqrt(surfaceTransmissivity(instance)) + forall(s1 = 1_pInt:ns) my_compatibility(1:2,s1,s1,n) = sqrt(prm%surfaceTransmissivity) cycle endif @@ -2711,12 +2627,12 @@ neighbors: do n = 1_pInt,Nneighbors !* GRAIN BOUNDARY ! !* fixed transmissivity for adjacent ips with different texture (only if explicitly given in material.config) - if (grainboundaryTransmissivity(instance) >= 0.0_pReal) then + if (prm%grainboundaryTransmissivity >= 0.0_pReal) then neighbor_textureID = material_texture(1,neighbor_i,neighbor_e) if (neighbor_textureID /= textureID) then if (.not. phase_localPlasticity(neighbor_phase)) then forall(s1 = 1_pInt:ns) & - my_compatibility(1:2,s1,s1,n) = sqrt(grainboundaryTransmissivity(instance)) + my_compatibility(1:2,s1,s1,n) = sqrt(prm%grainboundaryTransmissivity) endif cycle endif @@ -2764,6 +2680,7 @@ enddo neighbors compatibility(1:2,1:ns,1:ns,1:Nneighbors,i,e) = my_compatibility +end associate end subroutine plastic_nonlocal_updateCompatibility @@ -2812,8 +2729,8 @@ function plastic_nonlocal_postResults(Mp,Fe,ip,el) o, & !< index of current output of,& !< offset shortcut t, & !< type of dislocation - s, & !< index of my current slip system - sLattice !< index of my current slip system according to lattice order + s !< index of my current slip system + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),8) :: & rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) rhoDotSgl !< evolution rate of single dislocation densities (positive/negative screw and edge without dipoles) @@ -2835,8 +2752,6 @@ function plastic_nonlocal_postResults(Mp,Fe,ip,el) m_currentconf !< direction of dislocation motion for edge and screw (unit vector) in current configuration real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & n_currentconf !< slip system normal (unit vector) in current configuration - real(pReal), dimension(3,3) :: & - sigma ph = phaseAt(1,ip,el) of = phasememberAt(1,ip,el) From 43a451b2e17a989355a8c8d55f342192e5b60313 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 18 Feb 2019 14:35:10 +0100 Subject: [PATCH 246/309] inplace not useful use shell script if you want to keep an backup of your old data --- PRIVATE | 2 +- processing/post/vtk_addGridData.py | 10 ++-------- ..._addPointcloudData.py => vtk_addPointCloudData.py} | 6 +----- processing/post/vtk_addRectilinearGridData.py | 11 ++--------- 4 files changed, 6 insertions(+), 23 deletions(-) rename processing/post/{vtk_addPointcloudData.py => vtk_addPointCloudData.py} (96%) diff --git a/PRIVATE b/PRIVATE index ddb0dae72..dc9722c3c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit ddb0dae72af9012cca45d9fa5665da41815e88f7 +Subproject commit dc9722c3c9787bbb0f63308a7015b6709e6d4f94 diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py index a1713afb1..c458b1f07 100755 --- a/processing/post/vtk_addGridData.py +++ b/processing/post/vtk_addGridData.py @@ -25,10 +25,6 @@ parser.add_option( '--vtk', dest = 'vtk', type = 'string', metavar = 'string', help = 'VTK file name') -parser.add_option( '--inplace', - dest = 'inplace', - action = 'store_true', - help = 'modify VTK file in-place') parser.add_option('-r', '--render', dest = 'render', action = 'store_true', @@ -49,7 +45,6 @@ parser.add_option('-c', '--color', parser.set_defaults(data = [], tensor = [], color = [], - inplace = False, render = False, ) @@ -64,24 +59,23 @@ if os.path.splitext(options.vtk)[1] == '.vtr': reader.Update() rGrid = reader.GetOutput() writer = vtk.vtkXMLRectilinearGridWriter() - writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr')) elif os.path.splitext(options.vtk)[1] == '.vtk': reader = vtk.vtkGenericDataObjectReader() reader.SetFileName(options.vtk) reader.Update() rGrid = reader.GetRectilinearGridOutput() writer = vtk.vtkXMLRectilinearGridWriter() - writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr')) elif os.path.splitext(options.vtk)[1] == '.vtu': reader = vtk.vtkXMLUnstructuredGridReader() reader.SetFileName(options.vtk) reader.Update() rGrid = reader.GetOutput() writer = vtk.vtkXMLUnstructuredGridWriter() - writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtu' if options.inplace else '_added.vtu')) else: parser.error('Unsupported VTK file type extension.') +writer.SetFileName(options.vtk) + Npoints = rGrid.GetNumberOfPoints() Ncells = rGrid.GetNumberOfCells() diff --git a/processing/post/vtk_addPointcloudData.py b/processing/post/vtk_addPointCloudData.py similarity index 96% rename from processing/post/vtk_addPointcloudData.py rename to processing/post/vtk_addPointCloudData.py index 369320d3d..5ab1d419e 100755 --- a/processing/post/vtk_addPointcloudData.py +++ b/processing/post/vtk_addPointCloudData.py @@ -23,10 +23,6 @@ parser.add_option( '--vtk', dest = 'vtk', type = 'string', metavar = 'string', help = 'VTK file name') -parser.add_option( '--inplace', - dest = 'inplace', - action = 'store_true', - help = 'modify VTK file in-place') parser.add_option('-r', '--render', dest = 'render', action = 'store_true', @@ -153,7 +149,7 @@ for name in filenames: writer = vtk.vtkXMLPolyDataWriter() writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() - writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtp' if options.inplace else '_added.vtp')) + writer.SetFileName(options.vtk) writer.SetInputData(Polydata) writer.Write() diff --git a/processing/post/vtk_addRectilinearGridData.py b/processing/post/vtk_addRectilinearGridData.py index 83a1451a0..e445214fd 100755 --- a/processing/post/vtk_addRectilinearGridData.py +++ b/processing/post/vtk_addRectilinearGridData.py @@ -25,10 +25,6 @@ parser.add_option( '--vtk', dest = 'vtk', type = 'string', metavar = 'string', help = 'VTK file name') -parser.add_option( '--inplace', - dest = 'inplace', - action = 'store_true', - help = 'modify VTK file in-place') parser.add_option('-r', '--render', dest = 'render', action = 'store_true', @@ -49,7 +45,6 @@ parser.add_option('-c', '--color', parser.set_defaults(data = [], tensor = [], color = [], - inplace = False, render = False, ) @@ -158,16 +153,14 @@ for name in filenames: elif mode == 'point': rGrid.GetPointData().AddArray(VTKarray[me]) rGrid.Modified() - if vtk.VTK_MAJOR_VERSION <= 5: rGrid.Update() # ------------------------------------------ output result --------------------------------------- writer = vtk.vtkXMLRectilinearGridWriter() writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() - writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr')) - if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid) - else: writer.SetInputData(rGrid) + writer.SetFileName(options.vtk) + writer.SetInputData(rGrid) writer.Write() # ------------------------------------------ render result --------------------------------------- From 95ec0f5cd03a71f8ed1bcd7bd4e3d0af3840b1c7 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 18 Feb 2019 16:07:11 +0000 Subject: [PATCH 247/309] [skip ci] updated version information after successful test of v2.0.2-1831-g43a451b2 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index ccca69d77..4b293256e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1829-ga0afed46 +v2.0.2-1831-g43a451b2 From a58dd17df19f868a84edd4a56608af6311506aa0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 18 Feb 2019 20:58:58 +0100 Subject: [PATCH 248/309] adjusting documentation format --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index dc9722c3c..75fbf8c1d 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit dc9722c3c9787bbb0f63308a7015b6709e6d4f94 +Subproject commit 75fbf8c1d9eb9b08fa15b55b7caaa4c4f7c167e0 From 1a5711e2464b62886fbafcfce168fa9fb5cf0d92 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 18 Feb 2019 22:55:31 +0100 Subject: [PATCH 249/309] using more parameters from parameter structure --- src/plastic_nonlocal.f90 | 152 ++++++++++++--------------------------- 1 file changed, 46 insertions(+), 106 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 79b1df55a..c87fd9865 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -14,12 +14,6 @@ module plastic_nonlocal real(pReal), parameter, private :: & KB = 1.38e-23_pReal !< Physical parameter, Boltzmann constant in J/Kelvin - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_nonlocal_sizeDotState, & !< number of dotStates = number of basic state variables - plastic_nonlocal_sizeDependentState, & !< number of dependent state variables - plastic_nonlocal_sizeState !< total number of state variables - - integer(pInt), dimension(:,:), allocatable, target, public :: & plastic_nonlocal_sizePostResult !< size of each post result output @@ -51,23 +45,15 @@ module plastic_nonlocal real(pReal), dimension(:), allocatable, private :: & atomicVolume, & !< atomic volume Dsd0, & !< prefactor for self-diffusion coefficient - aTolRho, & !< absolute tolerance for dislocation density in state integration - aTolShear, & !< absolute tolerance for accumulated shear in state integration cutoffRadius, & !< cutoff radius for dislocation stress - doublekinkwidth, & !< width of a doubkle kink in multiples of the burgers vector length b - solidSolutionEnergy, & !< activation energy for solid solution in J - solidSolutionSize, & !< solid solution obstacle size in multiples of the burgers vector length - solidSolutionConcentration, & !< concentration of solid solution in atomic parts pParam, & !< parameter for kinetic law (Kocks,Argon,Ashby) qParam, & !< parameter for kinetic law (Kocks,Argon,Ashby) rhoSglScatter, & !< standard deviation of scatter in initial dislocation density surfaceTransmissivity, & !< transmissivity at free surface grainboundaryTransmissivity, & !< transmissivity at grain boundary (identified by different texture) - CFLfactor, & !< safety factor for CFL flux condition fEdgeMultiplication, & !< factor that determines how much edge dislocations contribute to multiplication (0...1) rhoSglRandom, & - rhoSglRandomBinning, & - linetensionEffect + rhoSglRandomBinning real(pReal), dimension(:,:), allocatable, private :: & rhoSglEdgePos0, & !< initial edge_pos dislocation density per slip system for each family and instance @@ -77,9 +63,7 @@ module plastic_nonlocal rhoDipEdge0, & !< initial edge dipole dislocation density per slip system for each family and instance rhoDipScrew0, & !< initial screw dipole dislocation density per slip system for each family and instance lambda0PerSlipFamily, & !< mean free path prefactor for each family and instance - lambda0, & !< mean free path prefactor for each slip system and instance - burgersPerSlipFamily, & !< absolute length of burgers vector [m] for each family and instance - burgers !< absolute length of burgers vector [m] for each slip system and instance + lambda0 !< mean free path prefactor for each slip system and instance real(pReal), dimension(:,:,:), allocatable, private :: & @@ -209,8 +193,6 @@ module plastic_nonlocal integer(pInt) , dimension(:) ,allocatable , public:: & Nslip,& - slipFamily, & !< lookup table relating active slip system to slip family for each instance - slipSystemLattice, & !< lookup table relating active slip system index to lattice slip system index for each instance colinearSystem !< colinear system to the active slip system (only valid for fcc!) logical, private :: & @@ -329,9 +311,6 @@ integer(pInt) :: phase, & !*** memory allocation for global variables allocate(param(maxNinstances)) -allocate(plastic_nonlocal_sizeDotState(maxNinstances), source=0_pInt) -allocate(plastic_nonlocal_sizeDependentState(maxNinstances), source=0_pInt) -allocate(plastic_nonlocal_sizeState(maxNinstances), source=0_pInt) allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0_pInt) allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) plastic_nonlocal_output = '' @@ -342,13 +321,7 @@ allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(totalNslip(maxNinstances), source=0_pInt) allocate(atomicVolume(maxNinstances), source=0.0_pReal) allocate(Dsd0(maxNinstances), source=-1.0_pReal) -allocate(aTolRho(maxNinstances), source=0.0_pReal) -allocate(aTolShear(maxNinstances), source=0.0_pReal) allocate(cutoffRadius(maxNinstances), source=-1.0_pReal) -allocate(doublekinkwidth(maxNinstances), source=0.0_pReal) -allocate(solidSolutionEnergy(maxNinstances), source=0.0_pReal) -allocate(solidSolutionSize(maxNinstances), source=0.0_pReal) -allocate(solidSolutionConcentration(maxNinstances), source=0.0_pReal) allocate(pParam(maxNinstances), source=1.0_pReal) allocate(qParam(maxNinstances), source=1.0_pReal) allocate(rhoSglScatter(maxNinstances), source=0.0_pReal) @@ -356,9 +329,7 @@ allocate(rhoSglRandom(maxNinstances), source=0.0_pReal) allocate(rhoSglRandomBinning(maxNinstances), source=1.0_pReal) allocate(surfaceTransmissivity(maxNinstances), source=1.0_pReal) allocate(grainboundaryTransmissivity(maxNinstances), source=-1.0_pReal) -allocate(CFLfactor(maxNinstances), source=2.0_pReal) allocate(fEdgeMultiplication(maxNinstances), source=0.0_pReal) -allocate(linetensionEffect(maxNinstances), source=0.0_pReal) allocate(shortRangeStressCorrection(maxNinstances), source=.false.) allocate(probabilisticMultiplication(maxNinstances), source=.false.) @@ -368,7 +339,6 @@ allocate(rhoSglScrewPos0(lattice_maxNslipFamily,maxNinstances), s allocate(rhoSglScrewNeg0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) allocate(rhoDipEdge0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) allocate(rhoDipScrew0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) -allocate(burgersPerSlipFamily(lattice_maxNslipFamily,maxNinstances), source=0.0_pReal) allocate(lambda0PerSlipFamily(lattice_maxNslipFamily,maxNinstances), source=0.0_pReal) allocate(minDipoleHeightPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=-1.0_pReal) allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=0.0_pReal) @@ -433,10 +403,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s do f = 1_pInt, Nchunks_SlipFamilies lambda0PerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo - case ('burgers') - do f = 1_pInt, Nchunks_SlipFamilies - burgersPerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo case('cutoffradius','r') cutoffRadius(instance) = IO_floatValue(line,chunkPos,2_pInt) case('minimumdipoleheightedge','ddipminedge') @@ -451,12 +417,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s atomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) case('selfdiffusionprefactor','dsd0') Dsd0(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('atol_rho','atol_density','absolutetolerancedensity','absolutetolerance_density') - aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('atol_shear','atol_plasticshear','atol_accumulatedshear','absolutetoleranceshear','absolutetolerance_shear') - aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('linetension','linetensioneffect','linetension_effect') - linetensionEffect(instance) = IO_floatValue(line,chunkPos,2_pInt) case('peierlsstressedge','peierlsstress_edge') do f = 1_pInt, Nchunks_SlipFamilies peierlsStressPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) @@ -465,14 +425,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s do f = 1_pInt, Nchunks_SlipFamilies peierlsStressPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo - case('doublekinkwidth') - doublekinkwidth(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('solidsolutionenergy') - solidSolutionEnergy(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('solidsolutionsize') - solidSolutionSize(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('solidsolutionconcentration') - solidSolutionConcentration(instance) = IO_floatValue(line,chunkPos,2_pInt) case('p') pParam(instance) = IO_floatValue(line,chunkPos,2_pInt) case('q') @@ -487,8 +439,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s surfaceTransmissivity(instance) = IO_floatValue(line,chunkPos,2_pInt) case('grainboundarytransmissivity') grainboundaryTransmissivity(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('cflfactor') - CFLfactor(instance) = IO_floatValue(line,chunkPos,2_pInt) case('fedgemultiplication','edgemultiplicationfactor','edgemultiplication') fEdgeMultiplication(instance) = IO_floatValue(line,chunkPos,2_pInt) case('shortrangestresscorrection') @@ -518,8 +468,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s call IO_error(211_pInt,ext_msg='rhoDipEdge0 ('//PLASTICITY_NONLOCAL_label//')') if (rhoDipScrew0(f,instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='rhoDipScrew0 ('//PLASTICITY_NONLOCAL_label//')') - if (burgersPerSlipFamily(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='Burgers ('//PLASTICITY_NONLOCAL_label//')') if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') if (minDipoleHeightPerSlipFamily(f,1,instance) < 0.0_pReal) & @@ -532,26 +480,12 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') endif enddo - if (linetensionEffect(instance) < 0.0_pReal .or. linetensionEffect(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='linetension ('//PLASTICITY_NONLOCAL_label//')') if (cutoffRadius(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='r ('//PLASTICITY_NONLOCAL_label//')') if (atomicVolume(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='atomicVolume ('//PLASTICITY_NONLOCAL_label//')') if (Dsd0(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='selfDiffusionPrefactor ('//PLASTICITY_NONLOCAL_label//')') - if (aTolRho(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='aTol_rho ('//PLASTICITY_NONLOCAL_label//')') - if (aTolShear(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='aTol_shear ('//PLASTICITY_NONLOCAL_label//')') - if (doublekinkwidth(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='doublekinkwidth ('//PLASTICITY_NONLOCAL_label//')') - if (solidSolutionEnergy(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='solidSolutionEnergy ('//PLASTICITY_NONLOCAL_label//')') - if (solidSolutionSize(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='solidSolutionSize ('//PLASTICITY_NONLOCAL_label//')') - if (solidSolutionConcentration(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='solidSolutionConcentration ('//PLASTICITY_NONLOCAL_label//')') if (pParam(instance) <= 0.0_pReal .or. pParam(instance) > 1.0_pReal) & call IO_error(211_pInt,ext_msg='p ('//PLASTICITY_NONLOCAL_label//')') if (qParam(instance) < 1.0_pReal .or. qParam(instance) > 2.0_pReal) & @@ -566,8 +500,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s call IO_error(211_pInt,ext_msg='surfaceTransmissivity ('//PLASTICITY_NONLOCAL_label//')') if (grainboundaryTransmissivity(instance) > 1.0_pReal) & call IO_error(211_pInt,ext_msg='grainboundaryTransmissivity ('//PLASTICITY_NONLOCAL_label//')') - if (CFLfactor(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='CFLfactor ('//PLASTICITY_NONLOCAL_label//')') if (fEdgeMultiplication(instance) < 0.0_pReal .or. fEdgeMultiplication(instance) > 1.0_pReal) & call IO_error(211_pInt,ext_msg='edgemultiplicationfactor ('//PLASTICITY_NONLOCAL_label//')') @@ -593,7 +525,6 @@ allocate(iGamma(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iRhoF(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iTauF(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) -allocate(burgers(maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(lambda0(maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(minDipoleHeight(maxTotalNslip,2,maxNinstances), source=-1.0_pReal) allocate(forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) @@ -738,7 +669,6 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), !*** burgers vector, mean free path prefactor and minimum dipole distance for each slip system - burgers(s1,instance) = burgersPerSlipFamily(f,instance) lambda0(s1,instance) = lambda0PerSlipFamily(f,instance) minDipoleHeight(s1,1:2,instance) = minDipoleHeightPerSlipFamily(f,1:2,instance) peierlsStress(s1,1:2,instance) = peierlsStressPerSlipFamily(f,1:2,instance) @@ -832,9 +762,9 @@ param(instance)%probabilisticMultiplication = .false. prm%lambda0 = math_expand(prm%lambda0,prm%Nslip) - prm%burgers = config_phase(p)%getFloats('burgers') + prm%burgers = config_phase(p)%getFloats('burgers', requiredSize=size(prm%Nslip)) - if (size(prm%burgers) /= size(prm%Nslip)) call IO_error(150_pInt,ext_msg='burgers') + prm%burgers = math_expand(prm%burgers,prm%Nslip) @@ -848,8 +778,8 @@ param(instance)%probabilisticMultiplication = .false. prm%Dsd0 = config_phase(p)%getFloat('selfdiffusionprefactor') !,'dsd0') prm%selfDiffusionEnergy = config_phase(p)%getFloat('selfdiffusionenergy') !,'qsd') - prm%aTolRho = config_phase(p)%getFloat('atol_rho') !,'atol_density','absolutetolerancedensity','absolutetolerance_density') - prm%aTolShear = config_phase(p)%getFloat('atol_shear') !,'atol_plasticshear','atol_accumulatedshear','absolutetoleranceshear','absolutetolerance_shear') + prm%aTolRho = config_phase(p)%getFloat('atol_rho') + prm%aTolShear = config_phase(p)%getFloat('atol_shear') prm%significantRho = config_phase(p)%getFloat('significantrho')!,'significant_rho','significantdensity','significant_density') @@ -882,21 +812,29 @@ param(instance)%probabilisticMultiplication = .false. prm%surfaceTransmissivity = config_phase(p)%getFloat('surfacetransmissivity') prm%grainboundaryTransmissivity = config_phase(p)%getFloat('grainboundarytransmissivity') - prm%CFLfactor = config_phase(p)%getFloat('cflfactor') + prm%CFLfactor = config_phase(p)%getFloat('cflfactor',defaultVal=2.0_pReal) prm%fEdgeMultiplication = config_phase(p)%getFloat('edgemultiplication')!,'edgemultiplicationfactor','fedgemultiplication') prm%shortRangeStressCorrection = config_phase(p)%getInt('shortrangestresscorrection' ) > 0_pInt prm%probabilisticMultiplication = config_phase(p)%keyExists('/probabilisticmultiplication/' )!,'randomsources','randommultiplication','discretesources') - ! sanity checks + if ( any(prm%burgers <= 0.0_pReal)) extmsg = trim(extmsg)//' burgers' if ( prm%viscosity <= 0.0_pReal) extmsg = trim(extmsg)//' viscosity' if ( prm%significantN < 0.0_pReal) extmsg = trim(extmsg)//' significantN' if ( prm%significantrho < 0.0_pReal) extmsg = trim(extmsg)//' significantrho' if ( prm%selfDiffusionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' selfDiffusionEnergy' if ( prm%fattack <= 0.0_pReal) extmsg = trim(extmsg)//' fattack' if (prm%edgeJogFactor < 0.0_pReal .or. prm%edgeJogFactor > 1.0_pReal) extmsg = trim(extmsg)//' edgeJogFactor' - + if ( prm%solidSolutionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionEnergy' + if ( prm%solidSolutionSize <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionSize' + if ( prm%solidSolutionConcentration <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionConcentration' + if ( prm%CFLfactor < 0.0_pReal) extmsg = trim(extmsg)//' CFLfactor' + if ( prm%doublekinkwidth <= 0.0_pReal) extmsg = trim(extmsg)//' doublekinkwidth' + if ( prm%atolshear <= 0.0_pReal) extmsg = trim(extmsg)//' atolshear' + if ( prm%atolrho <= 0.0_pReal) extmsg = trim(extmsg)//' atolrho' + if (prm%linetensionEffect < 0.0_pReal .or. prm%linetensionEffect > 1.0_pReal) extmsg = trim(extmsg)//' edgeJogFactor' + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) @@ -1122,16 +1060,18 @@ subroutine plastic_nonlocal_aTolState(ph,instance) ns, & t, c +associate (prm => param(instance)) ns = totalNslip(instance) forall (t = 1_pInt:4_pInt) - plasticState(ph)%aTolState(iRhoU(1:ns,t,instance)) = aTolRho(instance) - plasticState(ph)%aTolState(iRhoB(1:ns,t,instance)) = aTolRho(instance) + plasticState(ph)%aTolState(iRhoU(1:ns,t,instance)) = prm%aTolRho + plasticState(ph)%aTolState(iRhoB(1:ns,t,instance)) = prm%aTolRho end forall forall (c = 1_pInt:2_pInt) & - plasticState(ph)%aTolState(iRhoD(1:ns,c,instance)) = aTolRho(instance) + plasticState(ph)%aTolState(iRhoD(1:ns,c,instance)) = prm%aTolRho - plasticState(ph)%aTolState(iGamma(1:ns,instance)) = aTolShear(instance) + plasticState(ph)%aTolState(iGamma(1:ns,instance)) = prm%aTolShear +end associate end subroutine plastic_nonlocal_aTolState !-------------------------------------------------------------------------------------------------- @@ -1498,10 +1438,10 @@ if (Temperature > 0.0_pReal) then !* The derivative only gives absolute values; the correct sign is taken care of in the formula for the derivative of the velocity tauEff = max(0.0_pReal, abs(tauNS(s)) - tauThreshold(s)) ! ensure that the effective stress is positive - meanfreepath_P = burgers(s,instance) - jumpWidth_P = burgers(s,instance) - activationLength_P = doublekinkwidth(instance) * burgers(s,instance) - activationVolume_P = activationLength_P * jumpWidth_P * burgers(s,instance) + meanfreepath_P = prm%burgers(s) + jumpWidth_P = prm%burgers(s) + activationLength_P = prm%doublekinkwidth *prm%burgers(s) + activationVolume_P = activationLength_P * jumpWidth_P * prm%burgers(s) criticalStress_P = peierlsStress(s,c,instance) activationEnergy_P = criticalStress_P * activationVolume_P tauRel_P = min(1.0_pReal, tauEff / criticalStress_P) ! ensure that the activation probability cannot become greater than one @@ -1521,11 +1461,11 @@ if (Temperature > 0.0_pReal) then !* The derivative only gives absolute values; the correct sign is taken care of in the formula for the derivative of the velocity tauEff = abs(tau(s)) - tauThreshold(s) - meanfreepath_S = burgers(s,instance) / sqrt(solidSolutionConcentration(instance)) - jumpWidth_S = solidSolutionSize(instance) * burgers(s,instance) - activationLength_S = burgers(s,instance) / sqrt(solidSolutionConcentration(instance)) - activationVolume_S = activationLength_S * jumpWidth_S * burgers(s,instance) - activationEnergy_S = solidSolutionEnergy(instance) + meanfreepath_S = prm%burgers(s) / sqrt(prm%solidSolutionConcentration) + jumpWidth_S = prm%solidSolutionSize * prm%burgers(s) + activationLength_S = prm%burgers(s) / sqrt(prm%solidSolutionConcentration) + activationVolume_S = activationLength_S * jumpWidth_S * prm%burgers(s) + activationEnergy_S = prm%solidSolutionEnergy criticalStress_S = activationEnergy_S / activationVolume_S tauRel_S = min(1.0_pReal, tauEff / criticalStress_S) ! ensure that the activation probability cannot become greater than one tSolidSolution = 1.0_pReal / prm%fattack & @@ -1544,7 +1484,7 @@ if (Temperature > 0.0_pReal) then !* viscous glide velocity tauEff = abs(tau(s)) - tauThreshold(s) - mobility = burgers(s,instance) / prm%viscosity + mobility = prm%burgers(s) / prm%viscosity vViscous = mobility * tauEff @@ -2153,9 +2093,9 @@ do s = 1_pInt,ns ! loop over slip systems enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = lattice_mu(ph) * burgers(1:ns,instance) & +dUpper(1:ns,1) = lattice_mu(ph) * prm%burgers(1:ns) & / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) -dUpper(1:ns,2) = lattice_mu(ph) * burgers(1:ns,instance) & +dUpper(1:ns,2) = lattice_mu(ph) * prm%burgers(1:ns) & / (4.0_pReal * pi * abs(tau)) forall (c = 1_pInt:2_pInt) where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& @@ -2172,10 +2112,10 @@ dUpper = max(dUpper,dLower) rhoDotMultiplication = 0.0_pReal if (lattice_structure(ph) == LATTICE_bcc_ID) then ! BCC forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) - rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / burgers(s,instance) & ! assuming double-cross-slip of screws to be decisive for multiplication + rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / prm%burgers(s) & ! assuming double-cross-slip of screws to be decisive for multiplication * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation - rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) / burgers(s,instance) & ! assuming double-cross-slip of screws to be decisive for multiplication + rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) /prm%burgers(s) & ! assuming double-cross-slip of screws to be decisive for multiplication * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation endforall @@ -2203,7 +2143,7 @@ else sourceProbability(s,1_pInt,ip,el) = 2.0_pReal rhoDotMultiplication(s,1:4) = & (sum(abs(gdot(s,1:2))) * fEdgeMultiplication(instance) + sum(abs(gdot(s,3:4)))) & - / burgers(s,instance) * sqrt(rhoForest(s)) / lambda0(s,instance) + /prm%burgers(s) * sqrt(rhoForest(s)) / lambda0(s,instance) endif enddo #ifdef DEBUG @@ -2215,7 +2155,7 @@ else else rhoDotMultiplication(1:ns,1:4) = spread( & (sum(abs(gdot(1:ns,1:2)),2) * fEdgeMultiplication(instance) + sum(abs(gdot(1:ns,3:4)),2)) & - * sqrt(rhoForest(1:ns)) / lambda0(1:ns,instance) / burgers(1:ns,instance), 2, 4) + * sqrt(rhoForest(1:ns)) / lambda0(1:ns,instance) / prm%burgers(1:ns), 2, 4) endif endif @@ -2231,14 +2171,14 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then !*** check CFL (Courant-Friedrichs-Lewy) condition for flux if (any( abs(gdot) > 0.0_pReal & ! any active slip system ... - .and. CFLfactor(instance) * abs(v) * timestep & + .and. prm%CFLfactor * abs(v) * timestep & > mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here) #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt) then write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', & maxval(abs(v), abs(gdot) > 0.0_pReal & - .and. CFLfactor(instance) * abs(v) * timestep & + .and. prm%CFLfactor * abs(v) * timestep & > mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el))), & ' at a timestep of ',timestep write(6,'(a)') '<< CONST >> enforcing cutback !!!' @@ -2497,8 +2437,8 @@ rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) = 2.0_pReal * rhoDotThermalAnnihilation( #endif -if ( any(rhoSglOriginal(1:ns,1:4) + rhoDot(1:ns,1:4) * timestep < -aTolRho(instance)) & - .or. any(rhoDipOriginal(1:ns,1:2) + rhoDot(1:ns,9:10) * timestep < -aTolRho(instance))) then +if ( any(rhoSglOriginal(1:ns,1:4) + rhoDot(1:ns,1:4) * timestep < -prm%aTolRho) & + .or. any(rhoDipOriginal(1:ns,1:2) + rhoDot(1:ns,9:10) * timestep < -prm%aTolRho)) then #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt) then write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip @@ -2782,7 +2722,7 @@ tauBack = plasticState(ph)%State(iTauB(1:ns,instance),of) !* Calculate shear rate forall (t = 1_pInt:4_pInt) & - gdot(1:ns,t) = rhoSgl(1:ns,t) * burgers(1:ns,instance) * v(1:ns,t) + gdot(1:ns,t) = rhoSgl(1:ns,t) * prm%burgers(1:ns) * v(1:ns,t) !* calculate limits for stable dipole height @@ -2793,9 +2733,9 @@ do s = 1_pInt,ns enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = lattice_mu(ph) * burgers(1:ns,instance) & +dUpper(1:ns,1) = lattice_mu(ph) * prm%burgers(1:ns) & / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) -dUpper(1:ns,2) = lattice_mu(ph) * burgers(1:ns,instance) & +dUpper(1:ns,2) = lattice_mu(ph) * prm%burgers(1:ns) & / (4.0_pReal * pi * abs(tau)) forall (c = 1_pInt:2_pInt) where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& From 9b0251428413aea182585dffbc1c50dd0dc43162 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 18 Feb 2019 22:29:07 +0000 Subject: [PATCH 250/309] [skip ci] updated version information after successful test of v2.0.2-1833-ga58dd17d --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 4b293256e..19dea3847 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1831-g43a451b2 +v2.0.2-1833-ga58dd17d From 6bcd4a77d2aa8c548533ab52f167d71402159a64 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Feb 2019 09:43:48 +0100 Subject: [PATCH 251/309] complex pointer structure for state --- src/plastic_nonlocal.f90 | 126 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 124 insertions(+), 2 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index c87fd9865..58aeb4e12 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -203,6 +203,43 @@ module plastic_nonlocal outputID !< ID of each post result output end type tParameters + type, private :: tNonlocalState + + real(pReal), pointer, dimension(:,:) :: & + rho, & ! < all dislocations + rhoSgl, & + rhoSglMobile, & ! iRhoU + rhoSglEdgeMobile, & + rhoSglEdgeMobilePos, & + rhoSglEdgeMobileNeg, & + rhoSglScrewMobile, & + rhoSglScrewMobilePos, & + rhoSglScrewMobileNeg, & + rhoSglImmobile, & ! iRhoB + rhoSglEdgeImmobile, & + rhoSglEdgeImmobilePos, & + rhoSglEdgeImmobileNeg, & + rhoSglScrewImmobile, & + rhoSglScrewImmobilePos, & + rhoSglScrewImmobileNeg, & + rhoSglPos, & + rhoSglMobilePos, & + rhoSglImmobilePos, & + rhoSglNeg, & + rhoSglMobileNeg, & + rhoSglImmobileNeg, & + rhoDip, & ! iRhoD + rhoDipEdge, & + rhoDipScrew, & + rhoSglScrew, & + rhoSglEdge, & + accumulatedshear + end type tNonlocalState + type(tNonlocalState), allocatable, dimension(:), private :: & + deltaState, & + dotState, & + state + type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance) @@ -310,6 +347,9 @@ integer(pInt) :: phase, & !*** memory allocation for global variables allocate(param(maxNinstances)) +allocate(state(maxNinstances)) +allocate(dotState(maxNinstances)) +allocate(deltaState(maxNinstances)) allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0_pInt) allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) @@ -721,6 +761,9 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle instance = phase_plasticityInstance(p) associate(prm => param(instance), & + dot => dotState(instance), & + stt => state(instance), & + del => deltaState(instance), & config => config_phase(p)) prm%mu = lattice_mu(p) @@ -925,12 +968,91 @@ param(instance)%probabilisticMultiplication = .false. endif enddo - end associate + plasticState(p)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,instance)) + stt%rho => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + dot%rho => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + del%rho => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + plasticState(p)%aTolState(1:10_pInt*prm%totalNslip) = prm%aTolRho + + stt%rhoSglEdge => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt:06_pInt*prm%totalNslip:2*prm%totalNslip,:) + stt%rhoSglScrew => plasticState(p)%state (2_pInt*prm%totalNslip+1_pInt:08_pInt*prm%totalNslip:2*prm%totalNslip,:) + + stt%rhoSgl => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + dot%rhoSgl => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + del%rhoSgl => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + + stt%rhoSglMobile => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + dot%rhoSglMobile => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + del%rhoSglMobile => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) - enddo + stt%rhoSglEdgeMobile => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) + dot%rhoSglEdgeMobile => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) + del%rhoSglEdgeMobile => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) + + stt%rhoSglEdgeMobilePos => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) + dot%rhoSglEdgeMobilePos => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) + del%rhoSglEdgeMobilePos => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt: 1_pInt*prm%totalNslip,:) + + stt%rhoSglEdgeMobileNeg => plasticState(p)%state (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) + dot%rhoSglEdgeMobileNeg => plasticState(p)%dotState (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) + del%rhoSglEdgeMobileNeg => plasticState(p)%deltaState (1_pInt*prm%totalNslip+1_pInt: 2_pInt*prm%totalNslip,:) + + stt%rhoSglScrewMobile => plasticState(p)%state (2_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + dot%rhoSglScrewMobile => plasticState(p)%dotState (2_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + del%rhoSglScrewMobile => plasticState(p)%deltaState (2_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + + stt%rhoSglScrewMobilePos => plasticState(p)%state (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) + dot%rhoSglScrewMobilePos => plasticState(p)%dotState (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) + del%rhoSglScrewMobilePos => plasticState(p)%deltaState (2_pInt*prm%totalNslip+1_pInt: 3_pInt*prm%totalNslip,:) + stt%rhoSglScrewMobileNeg => plasticState(p)%state (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + dot%rhoSglScrewMobileNeg => plasticState(p)%dotState (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + del%rhoSglScrewMobileNeg => plasticState(p)%deltaState (3_pInt*prm%totalNslip+1_pInt: 4_pInt*prm%totalNslip,:) + + stt%rhoSglImmobile => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + dot%rhoSglImmobile => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + del%rhoSglImmobile => plasticState(p)%deltaState (4_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + + stt%rhoSglEdgeImmobile => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) + dot%rhoSglEdgeImmobile => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) + del%rhoSglEdgeImmobile => plasticState(p)%deltaState (4_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) + + stt%rhoSglEdgeImmobilePos => plasticState(p)%state (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) + dot%rhoSglEdgeImmobilePos => plasticState(p)%dotState (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) + del%rhoSglEdgeImmobilePos => plasticState(p)%deltaState (4_pInt*prm%totalNslip+1_pInt: 5_pInt*prm%totalNslip,:) + + stt%rhoSglEdgeImmobileNeg => plasticState(p)%state (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) + dot%rhoSglEdgeImmobileNeg => plasticState(p)%dotState (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) + del%rhoSglEdgeImmobileNeg => plasticState(p)%deltaState (5_pInt*prm%totalNslip+1_pInt: 6_pInt*prm%totalNslip,:) + + stt%rhoSglScrewImmobile => plasticState(p)%state (6_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + dot%rhoSglScrewImmobile => plasticState(p)%dotState (6_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + del%rhoSglScrewImmobile => plasticState(p)%deltaState (6_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + + stt%rhoSglScrewImmobilePos => plasticState(p)%state (6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) + dot%rhoSglScrewImmobilePos => plasticState(p)%dotState(6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) + del%rhoSglScrewImmobilePos => plasticState(p)%deltaState(6_pInt*prm%totalNslip+1_pInt: 7_pInt*prm%totalNslip,:) + + stt%rhoSglScrewImmobileNeg => plasticState(p)%state (7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + dot%rhoSglScrewImmobileNeg => plasticState(p)%dotState(7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + del%rhoSglScrewImmobileNeg => plasticState(p)%deltaState(7_pInt*prm%totalNslip+1_pInt: 8_pInt*prm%totalNslip,:) + + stt%rhoDip => plasticState(p)%state (8_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + dot%rhoDip => plasticState(p)%dotState (8_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + del%rhoDip => plasticState(p)%deltaState (8_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + + stt%rhoDipEdge => plasticState(p)%state (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) + dot%rhoDipEdge => plasticState(p)%dotState (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) + del%rhoDipEdge => plasticState(p)%deltaState (8_pInt*prm%totalNslip+1_pInt: 9_pInt*prm%totalNslip,:) + + stt%rhoDipScrew => plasticState(p)%state (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + dot%rhoDipScrew => plasticState(p)%dotState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + del%rhoDipScrew => plasticState(p)%deltaState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) +plasticState(p)%aTolState(iGamma(1:ns,instance)) = prm%aTolShear + end associate + enddo end subroutine plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- From 41899f6d3329502d7ec41cef2cdda916c035d9d4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Feb 2019 10:31:14 +0100 Subject: [PATCH 252/309] using more parameters from smart structure --- src/plastic_nonlocal.f90 | 91 +++++++++++++--------------------------- 1 file changed, 30 insertions(+), 61 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 58aeb4e12..622302b92 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -45,12 +45,7 @@ module plastic_nonlocal real(pReal), dimension(:), allocatable, private :: & atomicVolume, & !< atomic volume Dsd0, & !< prefactor for self-diffusion coefficient - cutoffRadius, & !< cutoff radius for dislocation stress - pParam, & !< parameter for kinetic law (Kocks,Argon,Ashby) - qParam, & !< parameter for kinetic law (Kocks,Argon,Ashby) rhoSglScatter, & !< standard deviation of scatter in initial dislocation density - surfaceTransmissivity, & !< transmissivity at free surface - grainboundaryTransmissivity, & !< transmissivity at grain boundary (identified by different texture) fEdgeMultiplication, & !< factor that determines how much edge dislocations contribute to multiplication (0...1) rhoSglRandom, & rhoSglRandomBinning @@ -75,7 +70,6 @@ module plastic_nonlocal forestProjectionScrew !< matrix of forest projections of screw dislocations for each instance real(pReal), dimension(:,:,:,:), allocatable, private :: & - lattice2slip, & !< orthogonal transformation matrix from lattice coordinate system to slip coordinate system (passive rotation !!!) rhoDotEdgeJogsOutput, & sourceProbability @@ -146,7 +140,6 @@ module plastic_nonlocal aTolShear, & !< absolute tolerance for accumulated shear in state integration significantRho, & !< density considered significant significantN, & !< number of dislocations considered significant - cutoffRadius, & !< cutoff radius for dislocation stress doublekinkwidth, & !< width of a doubkle kink in multiples of the burgers vector length b solidSolutionEnergy, & !< activation energy for solid solution in J solidSolutionSize, & !< solid solution obstacle size in multiples of the burgers vector length @@ -361,14 +354,9 @@ allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(totalNslip(maxNinstances), source=0_pInt) allocate(atomicVolume(maxNinstances), source=0.0_pReal) allocate(Dsd0(maxNinstances), source=-1.0_pReal) -allocate(cutoffRadius(maxNinstances), source=-1.0_pReal) -allocate(pParam(maxNinstances), source=1.0_pReal) -allocate(qParam(maxNinstances), source=1.0_pReal) allocate(rhoSglScatter(maxNinstances), source=0.0_pReal) allocate(rhoSglRandom(maxNinstances), source=0.0_pReal) allocate(rhoSglRandomBinning(maxNinstances), source=1.0_pReal) -allocate(surfaceTransmissivity(maxNinstances), source=1.0_pReal) -allocate(grainboundaryTransmissivity(maxNinstances), source=-1.0_pReal) allocate(fEdgeMultiplication(maxNinstances), source=0.0_pReal) allocate(shortRangeStressCorrection(maxNinstances), source=.false.) allocate(probabilisticMultiplication(maxNinstances), source=.false.) @@ -443,8 +431,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s do f = 1_pInt, Nchunks_SlipFamilies lambda0PerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo - case('cutoffradius','r') - cutoffRadius(instance) = IO_floatValue(line,chunkPos,2_pInt) case('minimumdipoleheightedge','ddipminedge') do f = 1_pInt, Nchunks_SlipFamilies minDipoleHeightPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) @@ -465,20 +451,12 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s do f = 1_pInt, Nchunks_SlipFamilies peierlsStressPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo - case('p') - pParam(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('q') - qParam(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglscatter') rhoSglScatter(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglrandom') rhoSglRandom(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglrandombinning') rhoSglRandomBinning(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('surfacetransmissivity') - surfaceTransmissivity(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('grainboundarytransmissivity') - grainboundaryTransmissivity(instance) = IO_floatValue(line,chunkPos,2_pInt) case('fedgemultiplication','edgemultiplicationfactor','edgemultiplication') fEdgeMultiplication(instance) = IO_floatValue(line,chunkPos,2_pInt) case('shortrangestresscorrection') @@ -520,26 +498,16 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') endif enddo - if (cutoffRadius(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='r ('//PLASTICITY_NONLOCAL_label//')') if (atomicVolume(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='atomicVolume ('//PLASTICITY_NONLOCAL_label//')') if (Dsd0(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='selfDiffusionPrefactor ('//PLASTICITY_NONLOCAL_label//')') - if (pParam(instance) <= 0.0_pReal .or. pParam(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='p ('//PLASTICITY_NONLOCAL_label//')') - if (qParam(instance) < 1.0_pReal .or. qParam(instance) > 2.0_pReal) & - call IO_error(211_pInt,ext_msg='q ('//PLASTICITY_NONLOCAL_label//')') if (rhoSglScatter(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') if (rhoSglRandom(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='rhoSglRandom ('//PLASTICITY_NONLOCAL_label//')') if (rhoSglRandomBinning(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') - if (surfaceTransmissivity(instance) < 0.0_pReal .or. surfaceTransmissivity(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='surfaceTransmissivity ('//PLASTICITY_NONLOCAL_label//')') - if (grainboundaryTransmissivity(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='grainboundaryTransmissivity ('//PLASTICITY_NONLOCAL_label//')') if (fEdgeMultiplication(instance) < 0.0_pReal .or. fEdgeMultiplication(instance) > 1.0_pReal) & call IO_error(211_pInt,ext_msg='edgemultiplicationfactor ('//PLASTICITY_NONLOCAL_label//')') @@ -565,11 +533,11 @@ allocate(iGamma(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iRhoF(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iTauF(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) + allocate(lambda0(maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(minDipoleHeight(maxTotalNslip,2,maxNinstances), source=-1.0_pReal) allocate(forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(lattice2slip(1:3, 1:3, maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=2.0_pReal) @@ -595,15 +563,6 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), NofMyPhase=count(material_phase==phase) myPhase2: if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then instance = phase_plasticityInstance(phase) - !*** Inverse lookup of my slip system family and the slip system in lattice - - l = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily - do s = 1_pInt,Nslip(f,instance) - l = l + 1_pInt - slipFamily(l,instance) = f - slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt, phase)) + s - enddo; enddo !*** determine size of state array @@ -704,6 +663,18 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), plasticState(phase)%accumulatedSlip => & plasticState(phase)%state (iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) + + !*** Inverse lookup of my slip system family and the slip system in lattice + + l = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily + do s = 1_pInt,Nslip(f,instance) + l = l + 1_pInt + slipFamily(l,instance) = f + slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt, phase)) + s + enddo; enddo + + do s1 = 1_pInt,ns f = slipFamily(s1,instance) @@ -733,13 +704,7 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), -1.0_pReal* lattice_sd(1:3,slipSystemLattice(s2,instance),phase)))) .and. s1 /= s2) & colinearSystem(s1,instance) = s2 enddo - - !*** rotation matrix from lattice configuration to slip system - - lattice2slip(1:3,1:3,s1,instance) & - = transpose( reshape([ lattice_sd(1:3, slipSystemLattice(s1,instance), phase), & - -lattice_st(1:3, slipSystemLattice(s1,instance), phase), & - lattice_sn(1:3, slipSystemLattice(s1,instance), phase)], [3,3])) + enddo @@ -817,7 +782,6 @@ param(instance)%probabilisticMultiplication = .false. peierlsStressPerSlipFamily(:,2_pInt,instance) = config_phase(p)%getFloat('peierlsstressscrew')!,'peierlsstress_screw') prm%atomicVolume = config_phase(p)%getFloat('atomicvolume') - prm%cutoffRadius = config_phase(p)%getFloat('r')!,cutoffradius') prm%Dsd0 = config_phase(p)%getFloat('selfdiffusionprefactor') !,'dsd0') prm%selfDiffusionEnergy = config_phase(p)%getFloat('selfdiffusionenergy') !,'qsd') @@ -853,8 +817,8 @@ param(instance)%probabilisticMultiplication = .false. prm%rhoSglRandomBinning = config_phase(p)%getFloat('rhosglrandombinning',0.0_pReal) !ToDo: useful default? - prm%surfaceTransmissivity = config_phase(p)%getFloat('surfacetransmissivity') - prm%grainboundaryTransmissivity = config_phase(p)%getFloat('grainboundarytransmissivity') + prm%surfaceTransmissivity = config_phase(p)%getFloat('surfacetransmissivity',defaultVal=1.0_pReal) + prm%grainboundaryTransmissivity = config_phase(p)%getFloat('grainboundarytransmissivity',defaultVal=-1.0_pReal) prm%CFLfactor = config_phase(p)%getFloat('cflfactor',defaultVal=2.0_pReal) prm%fEdgeMultiplication = config_phase(p)%getFloat('edgemultiplication')!,'edgemultiplicationfactor','fedgemultiplication') @@ -877,7 +841,12 @@ param(instance)%probabilisticMultiplication = .false. if ( prm%atolshear <= 0.0_pReal) extmsg = trim(extmsg)//' atolshear' if ( prm%atolrho <= 0.0_pReal) extmsg = trim(extmsg)//' atolrho' if (prm%linetensionEffect < 0.0_pReal .or. prm%linetensionEffect > 1.0_pReal) extmsg = trim(extmsg)//' edgeJogFactor' - + if (prm%p <= 0.0_pReal .or. prm%p > 1.0_pReal) extmsg = trim(extmsg)//' p' + if (prm%q < 1.0_pReal .or. prm%q > 2.0_pReal) extmsg = trim(extmsg)//' q' + if (prm%surfaceTransmissivity < 0.0_pReal .or. prm%surfaceTransmissivity > 1.0_pReal) & +extmsg = trim(extmsg)//' surfaceTransmissivity' + if (prm%grainboundaryTransmissivity > 1.0_pReal) extmsg = trim(extmsg)//' grainboundaryTransmissivity' + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) @@ -1569,11 +1538,11 @@ if (Temperature > 0.0_pReal) then tauRel_P = min(1.0_pReal, tauEff / criticalStress_P) ! ensure that the activation probability cannot become greater than one tPeierls = 1.0_pReal / prm%fattack & * exp(activationEnergy_P / (KB * Temperature) & - * (1.0_pReal - tauRel_P**pParam(instance))**qParam(instance)) + * (1.0_pReal - tauRel_P**prm%p)**prm%q) if (tauEff < criticalStress_P) then - dtPeierls_dtau = tPeierls * pParam(instance) * qParam(instance) * activationVolume_P / (KB * Temperature) & - * (1.0_pReal - tauRel_P**pParam(instance))**(qParam(instance)-1.0_pReal) & - * tauRel_P**(pParam(instance)-1.0_pReal) + dtPeierls_dtau = tPeierls * prm%p * prm%q * activationVolume_P / (KB * Temperature) & + * (1.0_pReal - tauRel_P**prm%p)**(prm%q-1.0_pReal) & + * tauRel_P**(prm%p-1.0_pReal) else dtPeierls_dtau = 0.0_pReal endif @@ -1592,12 +1561,12 @@ if (Temperature > 0.0_pReal) then tauRel_S = min(1.0_pReal, tauEff / criticalStress_S) ! ensure that the activation probability cannot become greater than one tSolidSolution = 1.0_pReal / prm%fattack & * exp(activationEnergy_S / (KB * Temperature) & - * (1.0_pReal - tauRel_S**pParam(instance))**qParam(instance)) + * (1.0_pReal - tauRel_S**prm%p)**prm%q) if (tauEff < criticalStress_S) then - dtSolidSolution_dtau = tSolidSolution * pParam(instance) * qParam(instance) & + dtSolidSolution_dtau = tSolidSolution * prm%p * prm%q & * activationVolume_S / (KB * Temperature) & - * (1.0_pReal - tauRel_S**pParam(instance))**(qParam(instance)-1.0_pReal) & - * tauRel_S**(pParam(instance)-1.0_pReal) + * (1.0_pReal - tauRel_S**prm%p)**(prm%q-1.0_pReal) & + * tauRel_S**(prm%p-1.0_pReal) else dtSolidSolution_dtau = 0.0_pReal endif From 25727bfa525a2c651e7660d26016594f406958d2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Feb 2019 10:32:18 +0100 Subject: [PATCH 253/309] using CamelCase --- processing/pre/seeds_check.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/processing/pre/seeds_check.sh b/processing/pre/seeds_check.sh index 9bc054406..025c9eb90 100755 --- a/processing/pre/seeds_check.sh +++ b/processing/pre/seeds_check.sh @@ -2,9 +2,9 @@ for seeds in "$@" do - vtk_pointcloud $seeds + vtk_pointCloud $seeds - vtk_addPointcloudData $seeds \ + vtk_addPointCloudData $seeds \ --data microstructure,weight \ --inplace \ --vtk ${seeds%.*}.vtp \ From e8ac2d0d975245a2681c10d53ac34e9961ddfec6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Feb 2019 10:43:04 +0100 Subject: [PATCH 254/309] limiting inter-module dependencies --- src/constitutive.f90 | 4 +++- src/plastic_nonlocal.f90 | 35 ++++++++++++----------------------- 2 files changed, 15 insertions(+), 24 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e5adaf4cf..beeae9e87 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -424,6 +424,8 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & PLASTICITY_DISLOTWIN_ID, & PLASTICITY_DISLOUCLA_ID, & PLASTICITY_NONLOCAL_ID + use mesh, only: & + mesh_ipVolume use plastic_isotropic, only: & plastic_isotropic_LpAndItsTangent use plastic_phenopowerlaw, only: & @@ -488,7 +490,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp,Mp, & - temperature(ho)%p(tme),ip,el) + temperature(ho)%p(tme),mesh_ipVolume(ip,el),ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType of = phasememberAt(ipc,ip,el) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 622302b92..43611f034 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -46,7 +46,6 @@ module plastic_nonlocal atomicVolume, & !< atomic volume Dsd0, & !< prefactor for self-diffusion coefficient rhoSglScatter, & !< standard deviation of scatter in initial dislocation density - fEdgeMultiplication, & !< factor that determines how much edge dislocations contribute to multiplication (0...1) rhoSglRandom, & rhoSglRandomBinning @@ -357,7 +356,6 @@ allocate(Dsd0(maxNinstances), source=-1.0_pReal) allocate(rhoSglScatter(maxNinstances), source=0.0_pReal) allocate(rhoSglRandom(maxNinstances), source=0.0_pReal) allocate(rhoSglRandomBinning(maxNinstances), source=1.0_pReal) -allocate(fEdgeMultiplication(maxNinstances), source=0.0_pReal) allocate(shortRangeStressCorrection(maxNinstances), source=.false.) allocate(probabilisticMultiplication(maxNinstances), source=.false.) @@ -457,8 +455,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s rhoSglRandom(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglrandombinning') rhoSglRandomBinning(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('fedgemultiplication','edgemultiplicationfactor','edgemultiplication') - fEdgeMultiplication(instance) = IO_floatValue(line,chunkPos,2_pInt) case('shortrangestresscorrection') shortRangeStressCorrection(instance) = IO_floatValue(line,chunkPos,2_pInt) > 0.0_pReal case('probabilisticmultiplication','randomsources','randommultiplication','discretesources') @@ -508,8 +504,7 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s call IO_error(211_pInt,ext_msg='rhoSglRandom ('//PLASTICITY_NONLOCAL_label//')') if (rhoSglRandomBinning(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') - if (fEdgeMultiplication(instance) < 0.0_pReal .or. fEdgeMultiplication(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='edgemultiplicationfactor ('//PLASTICITY_NONLOCAL_label//')') + !*** determine total number of active slip systems @@ -846,6 +841,9 @@ param(instance)%probabilisticMultiplication = .false. if (prm%surfaceTransmissivity < 0.0_pReal .or. prm%surfaceTransmissivity > 1.0_pReal) & extmsg = trim(extmsg)//' surfaceTransmissivity' if (prm%grainboundaryTransmissivity > 1.0_pReal) extmsg = trim(extmsg)//' grainboundaryTransmissivity' + if (prm%fEdgeMultiplication < 0.0_pReal .or. prm%fEdgeMultiplication > 1.0_pReal) & +extmsg = trim(extmsg)//' surfaceTransmissivity' + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) @@ -1614,30 +1612,21 @@ end subroutine plastic_nonlocal_kinetics !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, & - Mp, Temperature, ip, el) + Mp, Temperature, volume, ip, el) -use math, only: math_3333to99, & - math_mul6x6, & - math_mul33xx33, & - math_6toSym33 -use debug, only: debug_level, & - debug_constitutive, & - debug_levelExtensive, & - debug_levelSelective, & - debug_i, & - debug_e +use math, only: math_mul33xx33 use material, only: material_phase, & plasticState, & phaseAt, phasememberAt,& phase_plasticityInstance -use mesh, only: mesh_ipVolume implicit none !*** input variables integer(pInt), intent(in) :: ip, & !< current integration point el !< current element number -real(pReal), intent(in) :: Temperature !< temperature +real(pReal), intent(in) :: Temperature, & !< temperature +volume !< volume of the materialpoint real(pReal), dimension(3,3), intent(in) :: Mp @@ -1685,7 +1674,7 @@ forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) endforall -where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & +where (abs(rhoSgl) * volume ** 0.667_pReal < prm%significantN & .or. abs(rhoSgl) < prm%significantRho) & rhoSgl = 0.0_pReal @@ -2215,7 +2204,7 @@ else if (probabilisticMultiplication(instance)) then meshlength = mesh_ipVolume(ip,el)**0.333_pReal where(sum(rhoSgl(1:ns,1:4),2) > 0.0_pReal) - nSources = (sum(rhoSgl(1:ns,1:2),2) * fEdgeMultiplication(instance) + sum(rhoSgl(1:ns,3:4),2)) & + nSources = (sum(rhoSgl(1:ns,1:2),2) * prm%fEdgeMultiplication + sum(rhoSgl(1:ns,3:4),2)) & / sum(rhoSgl(1:ns,1:4),2) * meshlength / lambda0(1:ns,instance)*sqrt(rhoForest(1:ns)) elsewhere nSources = meshlength / lambda0(1:ns,instance) * sqrt(rhoForest(1:ns)) @@ -2233,7 +2222,7 @@ else else sourceProbability(s,1_pInt,ip,el) = 2.0_pReal rhoDotMultiplication(s,1:4) = & - (sum(abs(gdot(s,1:2))) * fEdgeMultiplication(instance) + sum(abs(gdot(s,3:4)))) & + (sum(abs(gdot(s,1:2))) * prm%fEdgeMultiplication + sum(abs(gdot(s,3:4)))) & /prm%burgers(s) * sqrt(rhoForest(s)) / lambda0(s,instance) endif enddo @@ -2245,7 +2234,7 @@ else #endif else rhoDotMultiplication(1:ns,1:4) = spread( & - (sum(abs(gdot(1:ns,1:2)),2) * fEdgeMultiplication(instance) + sum(abs(gdot(1:ns,3:4)),2)) & + (sum(abs(gdot(1:ns,1:2)),2) * prm%fEdgeMultiplication + sum(abs(gdot(1:ns,3:4)),2)) & * sqrt(rhoForest(1:ns)) / lambda0(1:ns,instance) / prm%burgers(1:ns), 2, 4) endif endif From 29a7f8e939493873d62fe407628eb7f1ae53efc5 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 19 Feb 2019 13:16:11 +0000 Subject: [PATCH 255/309] [skip ci] updated version information after successful test of v2.0.2-1835-g25727bfa --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 19dea3847..4eb9c509c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1833-ga58dd17d +v2.0.2-1835-g25727bfa From 3bec76e781cb48db38524e8225eda286ae95f04c Mon Sep 17 00:00:00 2001 From: Satyapriya Gupta Date: Tue, 19 Feb 2019 12:06:46 -0500 Subject: [PATCH 256/309] can now deal with 1x1x1 geoms --- processing/pre/geom_toTable.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/processing/pre/geom_toTable.py b/processing/pre/geom_toTable.py index a29ef7afb..73e4888d1 100755 --- a/processing/pre/geom_toTable.py +++ b/processing/pre/geom_toTable.py @@ -86,7 +86,7 @@ for name in filenames: yy = np.tile(np.repeat(y,info['grid'][0] ),info['grid'][2]) zz = np.repeat(z,info['grid'][0]*info['grid'][1]) - table.data = np.squeeze(np.dstack((xx,yy,zz,microstructure))) + table.data = np.squeeze(np.dstack((xx,yy,zz,microstructure)),axis=0) table.data_writeArray() # ------------------------------------------ finalize output --------------------------------------- From cc0e65c3b000ac1524a8da5db32c12b7c947723d Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 19 Feb 2019 19:35:57 +0000 Subject: [PATCH 257/309] [skip ci] updated version information after successful test of v2.0.2-1837-g3bec76e7 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 4eb9c509c..7d075db3e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1835-g25727bfa +v2.0.2-1837-g3bec76e7 From 649750a1c9a2d7fefce014a60b835bfc1754c8d3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Feb 2019 23:55:59 +0100 Subject: [PATCH 258/309] let lattice to the work --- src/lattice.f90 | 154 +++++++++++++++++++++++++++++++++++++-- src/plastic_nonlocal.f90 | 35 +++------ 2 files changed, 160 insertions(+), 29 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index b9fb71065..0c9ed52cf 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -498,6 +498,31 @@ module lattice integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public, protected :: & lattice_structure, trans_lattice_structure + + interface lattice_forestProjection ! DEPRECATED, use lattice_forestProjection_edge + module procedure slipProjection_transverse + end interface lattice_forestProjection + + interface lattice_forestProjection_edge + module procedure slipProjection_transverse + end interface lattice_forestProjection_edge + + interface lattice_forestProjection_screw + module procedure slipProjection_direction + end interface lattice_forestProjection_screw + + interface lattice_slipProjection_modeI + module procedure slipProjection_normal + end interface lattice_slipProjection_modeI + + interface lattice_slipProjection_modeII + module procedure slipProjection_direction + end interface lattice_slipProjection_modeII + + interface lattice_slipProjection_modeIII + module procedure slipProjection_transverse + end interface lattice_slipProjection_modeIII + public :: & lattice_init, & @@ -517,10 +542,16 @@ module lattice lattice_interaction_SlipTwin, & lattice_interaction_SlipTrans, & lattice_interaction_TwinSlip, & - lattice_forestProjection, & lattice_characteristicShear_Twin, & lattice_C66_twin, & - lattice_C66_trans + lattice_C66_trans, & + lattice_forestProjection, & + lattice_forestProjection_edge, & + lattice_forestProjection_screw, & + lattice_slipProjection_modeI, & + lattice_slipProjection_modeII, & + lattice_slipProjection_modeIII + contains @@ -2181,9 +2212,11 @@ end function lattice_SchmidMatrix_cleavage !-------------------------------------------------------------------------------------------------- -!> @brief Forest projection (for edge dislocations) +!> @brief Projection of the transverse direction onto the slip plane +!> @details: This projection is used to calculate forest hardening for edge dislocations and for +! mode III failure (ToDo: MD I am not 100% sure about mode III) !-------------------------------------------------------------------------------------------------- -function lattice_forestProjection(Nslip,structure,cOverA) result(projection) +function slipProjection_transverse(Nslip,structure,cOverA) result(projection) use math, only: & math_mul3x3 use IO, only: & @@ -2231,7 +2264,118 @@ function lattice_forestProjection(Nslip,structure,cOverA) result(projection) projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j))) enddo; enddo -end function lattice_forestProjection +end function slipProjection_transverse + + +!-------------------------------------------------------------------------------------------------- +!> @brief Projection of the slip direction onto the slip plane +!> @details: This projection is used to calculate forest hardening for screw dislocations and for +! mode II failure (ToDo: MD I am not 100% sure about mode II) +!-------------------------------------------------------------------------------------------------- +function slipProjection_direction(Nslip,structure,cOverA) result(projection) + use math, only: & + math_mul3x3 + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + real(pReal), dimension(:,:), allocatable :: slipSystems + integer(pInt), dimension(:), allocatable :: NslipMax + integer(pInt) :: i, j + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + NslipMax = LATTICE_FCC_NSLIPSYSTEM + slipSystems = LATTICE_FCC_SYSTEMSLIP + case('bcc') + NslipMax = LATTICE_BCC_NSLIPSYSTEM + slipSystems = LATTICE_BCC_SYSTEMSLIP + case('hex') + NslipMax = LATTICE_HEX_NSLIPSYSTEM + slipSystems = LATTICE_HEX_SYSTEMSLIP + case('bct') + NslipMax = LATTICE_BCT_NSLIPSYSTEM + slipSystems = LATTICE_BCT_SYSTEMSLIP + case default + call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) + end select + + if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & + call IO_error(145_pInt,ext_msg='Nslip '//trim(structure)) + if (any(Nslip < 0_pInt)) & + call IO_error(144_pInt,ext_msg='Nslip '//trim(structure)) + + coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) + + do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) + projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,1,j))) + enddo; enddo + +end function slipProjection_direction + + +!-------------------------------------------------------------------------------------------------- +!> @brief Projection of the slip plane onto itself +!> @details: This projection is used for mode I failure +!-------------------------------------------------------------------------------------------------- +function slipProjection_normal(Nslip,structure,cOverA) result(projection) + use math, only: & + math_mul3x3 + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + real(pReal), dimension(:,:), allocatable :: slipSystems + integer(pInt), dimension(:), allocatable :: NslipMax + integer(pInt) :: i, j + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + NslipMax = LATTICE_FCC_NSLIPSYSTEM + slipSystems = LATTICE_FCC_SYSTEMSLIP + case('bcc') + NslipMax = LATTICE_BCC_NSLIPSYSTEM + slipSystems = LATTICE_BCC_SYSTEMSLIP + case('hex') + NslipMax = LATTICE_HEX_NSLIPSYSTEM + slipSystems = LATTICE_HEX_SYSTEMSLIP + case('bct') + NslipMax = LATTICE_BCT_NSLIPSYSTEM + slipSystems = LATTICE_BCT_SYSTEMSLIP + case default + call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) + end select + + if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & + call IO_error(145_pInt,ext_msg='Nslip '//trim(structure)) + if (any(Nslip < 0_pInt)) & + call IO_error(144_pInt,ext_msg='Nslip '//trim(structure)) + + coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) + + do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) + projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,j))) + enddo; enddo + +end function slipProjection_normal !-------------------------------------------------------------------------------------------------- diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 43611f034..49b550fee 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -64,10 +64,8 @@ module plastic_nonlocal minDipoleHeightPerSlipFamily, & !< minimum stable edge/screw dipole height for each family and instance minDipoleHeight, & !< minimum stable edge/screw dipole height for each slip system and instance peierlsStressPerSlipFamily, & !< Peierls stress (edge and screw) - peierlsStress, & !< Peierls stress (edge and screw) - forestProjectionEdge, & !< matrix of forest projections of edge dislocations for each instance - forestProjectionScrew !< matrix of forest projections of screw dislocations for each instance - + peierlsStress !< Peierls stress (edge and screw) + real(pReal), dimension(:,:,:,:), allocatable, private :: & rhoDotEdgeJogsOutput, & sourceProbability @@ -172,8 +170,8 @@ module plastic_nonlocal real(pReal), dimension(:,:), allocatable :: & interactionSlipSlip ,& !< coefficients for slip-slip interaction for each interaction type and instance - forestProjectionEdge, & !< matrix of forest projections of edge dislocations for each instance - forestProjectionScrew !< matrix of forest projections of screw dislocations for each instance + forestProjection_Edge, & !< matrix of forest projections of edge dislocations for each instance + forestProjection_Screw !< matrix of forest projections of screw dislocations for each instance real(pReal), dimension(:), allocatable, private :: & nonSchmidCoeff integer(pInt) :: totalNslip @@ -531,8 +529,6 @@ allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) allocate(lambda0(maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(minDipoleHeight(maxTotalNslip,2,maxNinstances), source=-1.0_pReal) -allocate(forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=2.0_pReal) @@ -680,18 +676,7 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), peierlsStress(s1,1:2,instance) = peierlsStressPerSlipFamily(f,1:2,instance) do s2 = 1_pInt,ns - - !*** calculation of forest projections for edge and screw dislocations. s2 acts as forest for s1 - - forestProjectionEdge(s1,s2,instance) & - = abs(math_mul3x3(lattice_sn(1:3,slipSystemLattice(s1,instance),phase), & - lattice_st(1:3,slipSystemLattice(s2,instance),phase))) ! forest projection of edge dislocations is the projection of (t = b x n) onto the slip normal of the respective slip plane - - forestProjectionScrew(s1,s2,instance) & - = abs(math_mul3x3(lattice_sn(1:3,slipSystemLattice(s1,instance),phase), & - lattice_sd(1:3,slipSystemLattice(s2,instance),phase))) ! forest projection of screw dislocations is the projection of b onto the slip normal of the respective splip plane - - + !*** colinear slip system (only makes sense for fcc like it is defined here) if ((all(dEq(lattice_sd(1:3,slipSystemLattice(s1,instance),phase), & @@ -769,8 +754,10 @@ param(instance)%probabilisticMultiplication = .false. prm%burgers = math_expand(prm%burgers,prm%Nslip) - - + prm%forestProjection_edge = lattice_forestProjection_edge (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%forestProjection_screw = lattice_forestProjection_screw (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) minDipoleHeightPerSlipFamily(:,1_pInt,instance) = config_phase(p)%getFloats('minimumdipoleheightedge')!,'ddipminedge') minDipoleHeightPerSlipFamily(:,2_pInt,instance) = config_phase(p)%getFloats('minimumdipoleheightscrew')!,'ddipminscrew') peierlsStressPerSlipFamily(:,1_pInt,instance) = config_phase(p)%getFloat('peierlsstressedge')!,'peierlsstress_edge') @@ -1293,9 +1280,9 @@ where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & forall (s = 1_pInt:ns) & rhoForest(s) = dot_product((sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) + rhoDip(1:ns,1)), & - forestProjectionEdge(s,1:ns,instance)) & + prm%forestProjection_Edge(s,1:ns)) & + dot_product((sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) + rhoDip(1:ns,2)), & - forestProjectionScrew(s,1:ns,instance)) + prm%forestProjection_Screw(s,1:ns)) !*** calculate the threshold shear stress for dislocation slip From d0b0e3be3b428e2459fec1bbfe6c1fb79d4ca38c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Feb 2019 00:41:44 +0100 Subject: [PATCH 259/309] simplified --- src/plastic_nonlocal.f90 | 82 ++++++++++------------------------------ 1 file changed, 19 insertions(+), 63 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 49b550fee..7f4788b79 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -44,7 +44,6 @@ module plastic_nonlocal real(pReal), dimension(:), allocatable, private :: & atomicVolume, & !< atomic volume - Dsd0, & !< prefactor for self-diffusion coefficient rhoSglScatter, & !< standard deviation of scatter in initial dislocation density rhoSglRandom, & rhoSglRandomBinning @@ -80,11 +79,6 @@ module plastic_nonlocal real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & compatibility !< slip system compatibility between me and my neighbors - - logical, dimension(:), allocatable, private :: & - shortRangeStressCorrection, & !< flag indicating the use of the short range stress correction by a excess density gradient term - probabilisticMultiplication - enum, bind(c) enumerator :: undefined_ID, & rho_sgl_edge_pos_mobile_ID, & @@ -350,12 +344,9 @@ allocate(slipFamily(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(totalNslip(maxNinstances), source=0_pInt) allocate(atomicVolume(maxNinstances), source=0.0_pReal) -allocate(Dsd0(maxNinstances), source=-1.0_pReal) allocate(rhoSglScatter(maxNinstances), source=0.0_pReal) allocate(rhoSglRandom(maxNinstances), source=0.0_pReal) allocate(rhoSglRandomBinning(maxNinstances), source=1.0_pReal) -allocate(shortRangeStressCorrection(maxNinstances), source=.false.) -allocate(probabilisticMultiplication(maxNinstances), source=.false.) allocate(rhoSglEdgePos0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) allocate(rhoSglEdgeNeg0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) @@ -427,36 +418,14 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s do f = 1_pInt, Nchunks_SlipFamilies lambda0PerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo - case('minimumdipoleheightedge','ddipminedge') - do f = 1_pInt, Nchunks_SlipFamilies - minDipoleHeightPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo - case('minimumdipoleheightscrew','ddipminscrew') - do f = 1_pInt, Nchunks_SlipFamilies - minDipoleHeightPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo case('atomicvolume') atomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('selfdiffusionprefactor','dsd0') - Dsd0(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('peierlsstressedge','peierlsstress_edge') - do f = 1_pInt, Nchunks_SlipFamilies - peierlsStressPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo - case('peierlsstressscrew','peierlsstress_screw') - do f = 1_pInt, Nchunks_SlipFamilies - peierlsStressPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo case('rhosglscatter') rhoSglScatter(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglrandom') rhoSglRandom(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglrandombinning') rhoSglRandomBinning(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('shortrangestresscorrection') - shortRangeStressCorrection(instance) = IO_floatValue(line,chunkPos,2_pInt) > 0.0_pReal - case('probabilisticmultiplication','randomsources','randommultiplication','discretesources') - probabilisticMultiplication(instance) = IO_floatValue(line,chunkPos,2_pInt) > 0.0_pReal end select endif; endif enddo parsingFile @@ -482,20 +451,11 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s call IO_error(211_pInt,ext_msg='rhoDipScrew0 ('//PLASTICITY_NONLOCAL_label//')') if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') - if (minDipoleHeightPerSlipFamily(f,1,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='minimumDipoleHeightEdge ('//PLASTICITY_NONLOCAL_label//')') - if (minDipoleHeightPerSlipFamily(f,2,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='minimumDipoleHeightScrew ('//PLASTICITY_NONLOCAL_label//')') - if (peierlsStressPerSlipFamily(f,1,instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='peierlsStressEdge ('//PLASTICITY_NONLOCAL_label//')') - if (peierlsStressPerSlipFamily(f,2,instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') + endif enddo if (atomicVolume(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='atomicVolume ('//PLASTICITY_NONLOCAL_label//')') - if (Dsd0(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='selfDiffusionPrefactor ('//PLASTICITY_NONLOCAL_label//')') if (rhoSglScatter(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') if (rhoSglRandom(instance) < 0.0_pReal) & @@ -830,8 +790,18 @@ extmsg = trim(extmsg)//' surfaceTransmissivity' if (prm%grainboundaryTransmissivity > 1.0_pReal) extmsg = trim(extmsg)//' grainboundaryTransmissivity' if (prm%fEdgeMultiplication < 0.0_pReal .or. prm%fEdgeMultiplication > 1.0_pReal) & extmsg = trim(extmsg)//' surfaceTransmissivity' + if ( prm%Dsd0 < 0.0_pReal) extmsg = trim(extmsg)//' Dsd0' +! if (minDipoleHeightPerSlipFamily(f,1,instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='minimumDipoleHeightEdge ('//PLASTICITY_NONLOCAL_label//')') +! if (minDipoleHeightPerSlipFamily(f,2,instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='minimumDipoleHeightScrew ('//PLASTICITY_NONLOCAL_label//')') +! if (peierlsStressPerSlipFamily(f,1,instance) <= 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='peierlsStressEdge ('//PLASTICITY_NONLOCAL_label//')') +! if (peierlsStressPerSlipFamily(f,2,instance) <= 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) @@ -1007,6 +977,7 @@ extmsg = trim(extmsg)//' surfaceTransmissivity' plasticState(p)%aTolState(iGamma(1:ns,instance)) = prm%aTolShear end associate enddo + end subroutine plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- @@ -1150,6 +1121,7 @@ associate (prm => param(instance)) end associate end subroutine plastic_nonlocal_aTolState + !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- @@ -1733,31 +1705,14 @@ Lp = 0.0_pReal dLp_dMp = 0.0_pReal do s = 1_pInt,ns - Lp = Lp + gdotTotal(s) * prm%Schmid(1:3,1:3,s) - ! Schmid contributions to tangent forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & dLp_dMp(i,j,k,l) = dLp_dMp(i,j,k,l) & + prm%Schmid(i,j,s) * prm%Schmid(k,l,s) & - * sum(rhoSgl(s,1:4) * dv_dtau(s,1:4)) * prm%burgers(s) - - - ! non Schmid contributions to tangent - if (tau(s) > 0.0_pReal) then - forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & - dLp_dMp(i,j,k,l) = dLp_dMp(i,j,k,l) & - + prm%Schmid(i,j,s) & - * ( prm%nonSchmid_pos(k,l,s) * rhoSgl(s,3) * dv_dtauNS(s,3) & - - prm%nonSchmid_neg(k,l,s) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & - * prm%burgers(s) - else - forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & - dLp_dMp(i,j,k,l) = dLp_dMp(i,j,k,l) & - + prm%Schmid(i,j,s) & - * ( prm%nonSchmid_neg(k,l,s) * rhoSgl(s,3) * dv_dtauNS(s,3) & - - prm%nonSchmid_pos(k,l,s) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & - * prm%burgers(s) - endif + * sum(rhoSgl(s,1:4) * dv_dtau(s,1:4)) * prm%burgers(s) & + + prm%Schmid(i,j,s) & + * ( prm%nonSchmid_pos(k,l,s) * rhoSgl(s,3) * dv_dtauNS(s,3) & + - prm%nonSchmid_neg(k,l,s) * rhoSgl(s,4) * dv_dtauNS(s,4)) * prm%burgers(s) enddo @@ -1946,6 +1901,7 @@ forall (s = 1:ns, c = 1_pInt:2_pInt) & end subroutine plastic_nonlocal_deltaState + !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- @@ -2188,7 +2144,7 @@ if (lattice_structure(ph) == LATTICE_bcc_ID) then endforall else ! ALL OTHER STRUCTURES - if (probabilisticMultiplication(instance)) then + if (prm%probabilisticMultiplication) then meshlength = mesh_ipVolume(ip,el)**0.333_pReal where(sum(rhoSgl(1:ns,1:4),2) > 0.0_pReal) nSources = (sum(rhoSgl(1:ns,1:2),2) * prm%fEdgeMultiplication + sum(rhoSgl(1:ns,3:4),2)) & From a896ed91f859ce3f25a4e18376e139ee22a1b4e8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Feb 2019 07:33:19 +0100 Subject: [PATCH 260/309] simplified/not needed --- src/constitutive.f90 | 2 +- src/plastic_nonlocal.f90 | 135 +++++++++++++++------------------------ 2 files changed, 52 insertions(+), 85 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index beeae9e87..d49fcec6e 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1108,7 +1108,7 @@ function constitutive_postResults(S, Fi, FeArray, ipc, ip, el) case (PLASTICITY_NONLOCAL_ID) plasticityType constitutive_postResults(startPos:endPos) = & - plastic_nonlocal_postResults (Mp,FeArray,ip,el) + plastic_nonlocal_postResults (Mp,ip,el) end select plasticityType SourceLoop: do i = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 7f4788b79..0aa254fb2 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -463,11 +463,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s if (rhoSglRandomBinning(instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') - - - !*** determine total number of active slip systems - Nslip(1:lattice_maxNslipFamily,instance) = min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase), & - Nslip(1:lattice_maxNslipFamily,instance) ) ! we can't use more slip systems per family than specified in lattice totalNslip(instance) = sum(Nslip(1:lattice_maxNslipFamily,instance)) endif myPhase enddo sanityChecks @@ -1943,8 +1938,6 @@ use material, only: homogenization_maxNgrains, & PLASTICITY_NONLOCAL_ID use lattice, only: lattice_sd, & lattice_st ,& - lattice_mu, & - lattice_nu, & lattice_structure, & LATTICE_bcc_ID, & LATTICE_fcc_ID @@ -2116,9 +2109,9 @@ do s = 1_pInt,ns ! loop over slip systems enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = lattice_mu(ph) * prm%burgers(1:ns) & - / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) -dUpper(1:ns,2) = lattice_mu(ph) * prm%burgers(1:ns) & +dUpper(1:ns,1) = prm%mu * prm%burgers(1:ns) & + / (8.0_pReal * pi * (1.0_pReal - prm%nu) * abs(tau)) +dUpper(1:ns,2) = prm%mu * prm%burgers(1:ns) & / (4.0_pReal * pi * abs(tau)) forall (c = 1_pInt:2_pInt) where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& @@ -2650,7 +2643,7 @@ end subroutine plastic_nonlocal_updateCompatibility !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_nonlocal_postResults(Mp,Fe,ip,el) +function plastic_nonlocal_postResults(Mp,ip,el) result(postResults) use prec, only: & dNeq0 use math, only: & @@ -2660,28 +2653,19 @@ function plastic_nonlocal_postResults(Mp,Fe,ip,el) use mesh, only: & theMesh use material, only: & - homogenization_maxNgrains, & material_phase, & phaseAt, phasememberAt, & plasticState, & phase_plasticityInstance - use lattice, only: & - lattice_sd, & - lattice_st, & - lattice_sn, & - lattice_mu, & - lattice_nu implicit none real(pReal), dimension(3,3), intent(in) :: Mp !< MandelStress - real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & - Fe !< elastic deformation gradient integer(pInt), intent(in) :: & ip, & !< integration point el !< element real(pReal), dimension(sum(plastic_nonlocal_sizePostResult(:,phase_plasticityInstance(material_phase(1_pInt,ip,el))))) :: & - plastic_nonlocal_postResults + postResults integer(pInt) :: & ph, & @@ -2709,20 +2693,14 @@ function plastic_nonlocal_postResults(Mp,Fe,ip,el) rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) rhoDotDip, & !< evolution rate of dipole dislocation densities (screw and edge dipoles) dLower, & !< minimum stable dipole distance for edges and screws - dUpper !< current maximum stable dipole distance for edges and screws - real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & - m, & !< direction of dislocation motion for edge and screw (unit vector) - m_currentconf !< direction of dislocation motion for edge and screw (unit vector) in current configuration - real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & - n_currentconf !< slip system normal (unit vector) in current configuration - + dUpper !< current maximum stable dipole distance for edges and screws + ph = phaseAt(1,ip,el) of = phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) ns = totalNslip(instance) cs = 0_pInt -plastic_nonlocal_postResults = 0.0_pReal associate(prm => param(instance)) !* short hand notations for state variables @@ -2756,9 +2734,9 @@ do s = 1_pInt,ns enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = lattice_mu(ph) * prm%burgers(1:ns) & - / (8.0_pReal * pi * (1.0_pReal - lattice_nu(ph)) * abs(tau)) -dUpper(1:ns,2) = lattice_mu(ph) * prm%burgers(1:ns) & +dUpper(1:ns,1) = prm%mu * prm%burgers(1:ns) & + / (8.0_pReal * pi * (1.0_pReal - prm%nu) * abs(tau)) +dUpper(1:ns,2) = prm%mu * prm%burgers(1:ns) & / (4.0_pReal * pi * abs(tau)) forall (c = 1_pInt:2_pInt) where(dNeq0(sqrt(rhoSgl(1:ns,2*c-1)+rhoSgl(1:ns,2*c)+abs(rhoSgl(1:ns,2*c+3))& @@ -2770,177 +2748,166 @@ end forall dUpper = max(dUpper,dLower) -!*** dislocation motion - -m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),ph) -m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),ph) -forall (c = 1_pInt:2_pInt, s = 1_pInt:ns) & - m_currentconf(1:3,s,c) = math_mul33x3(Fe(1:3,1:3,1_pInt,ip,el), m(1:3,s,c)) -forall (s = 1_pInt:ns) & - n_currentconf(1:3,s) = math_mul33x3(Fe(1:3,1:3,1_pInt,ip,el), & - lattice_sn(1:3,slipSystemLattice(s,instance),ph)) - - outputsLoop: do o = 1_pInt,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (rho_sgl_edge_pos_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) + postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) cs = cs + ns case (rho_sgl_edge_pos_immobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,5) + postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,5) cs = cs + ns case (rho_sgl_edge_neg_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) + postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) cs = cs + ns case (rho_sgl_edge_neg_immobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,6) + postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,6) cs = cs + ns case (rho_dip_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,1) + postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,1) cs = cs + ns case (rho_sgl_screw_pos_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) + postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) cs = cs + ns case (rho_sgl_screw_pos_immobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,7) + postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,7) cs = cs + ns case (rho_sgl_screw_neg_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) + postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) cs = cs + ns case (rho_sgl_screw_neg_immobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,8) + postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,8) cs = cs + ns case (rho_dip_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,2) + postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,2) cs = cs + ns case (rho_forest_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoForest + postResults(cs+1_pInt:cs+ns) = rhoForest cs = cs + ns case (shearrate_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(gdot,2) + postResults(cs+1_pInt:cs+ns) = sum(gdot,2) cs = cs + ns case (resolvedstress_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = tau + postResults(cs+1_pInt:cs+ns) = tau cs = cs + ns case (resolvedstress_back_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = tauBack + postResults(cs+1_pInt:cs+ns) = tauBack cs = cs + ns case (resolvedstress_external_ID) do s = 1_pInt,ns - plastic_nonlocal_postResults(cs+s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + postResults(cs+s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) enddo cs = cs + ns case (resistance_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = tauThreshold + postResults(cs+1_pInt:cs+ns) = tauThreshold cs = cs + ns case (rho_dot_sgl_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & - + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) + postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) & + + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) cs = cs + ns case (rho_dot_sgl_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) + postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) cs = cs + ns case (rho_dot_dip_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotDip,2) + postResults(cs+1_pInt:cs+ns) = sum(rhoDotDip,2) cs = cs + ns case (rho_dot_gen_ID) ! Obsolete - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) & - + rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) & + + rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_gen_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) cs = cs + ns case (rho_dot_gen_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_sgl2dip_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) cs = cs + ns case (rho_dot_sgl2dip_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_ann_ath_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & - + rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & + + rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_ann_the_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) cs = cs + ns case (rho_dot_ann_the_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) cs = cs + ns case (rho_dot_edgejogs_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) cs = cs + ns case (rho_dot_flux_mobile_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) + postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) cs = cs + ns case (rho_dot_flux_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,1_pInt,ip,el),2) & + postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,1_pInt,ip,el),2) & + sum(rhoDotFluxOutput(1:ns,5:6,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2) cs = cs + ns case (rho_dot_flux_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,3:4,1_pInt,ip,el),2) & + postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,3:4,1_pInt,ip,el),2) & + sum(rhoDotFluxOutput(1:ns,7:8,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,7:8)),2) cs = cs + ns case (velocity_edge_pos_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,1) + postResults(cs+1_pInt:cs+ns) = v(1:ns,1) cs = cs + ns case (velocity_edge_neg_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,2) + postResults(cs+1_pInt:cs+ns) = v(1:ns,2) cs = cs + ns case (velocity_screw_pos_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,3) + postResults(cs+1_pInt:cs+ns) = v(1:ns,3) cs = cs + ns case (velocity_screw_neg_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,4) + postResults(cs+1_pInt:cs+ns) = v(1:ns,4) cs = cs + ns case (maximumdipoleheight_edge_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,1) + postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,1) cs = cs + ns case (maximumdipoleheight_screw_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,2) + postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,2) cs = cs + ns case(accumulatedshear_ID) - plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = plasticState(ph)%state(iGamma(1:ns,instance),of) + postResults(cs+1_pInt:cs+ns) = plasticState(ph)%state(iGamma(1:ns,instance),of) cs = cs + ns end select From d29b37f517556c12e3ed72ee9d6acb9296b662c0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Feb 2019 07:53:34 +0100 Subject: [PATCH 261/309] provide slip system components as functions --- src/lattice.f90 | 169 +++++++++++++++++++++++++++--------------------- 1 file changed, 94 insertions(+), 75 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 0c9ed52cf..ee4273a53 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -698,7 +698,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA) real(pReal), dimension(3,lattice_maxNslip) :: & sd, sn integer(pInt) :: & - j, i, & + i, & myNslip, myNcleavage lattice_C66(1:6,1:6,myPhase) = lattice_symmetrizeC66(lattice_structure(myPhase),& @@ -2211,6 +2211,64 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid end function lattice_SchmidMatrix_cleavage +!-------------------------------------------------------------------------------------------------- +!> @brief Normal direction of slip systems (n) +!-------------------------------------------------------------------------------------------------- +function lattice_slip_normal(Nslip,structure,cOverA) result(n) + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,sum(Nslip)) :: n + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) + n = coordinateSystem(1:3,1,1:sum(Nslip)) + +end function lattice_slip_normal + + +!-------------------------------------------------------------------------------------------------- +!> @brief Slip direction of slip systems (|| b) +!> @details: t = b x n +!-------------------------------------------------------------------------------------------------- +function lattice_slip_direction(Nslip,structure,cOverA) result(d) + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,sum(Nslip)) :: d + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) + d = coordinateSystem(1:3,2,1:sum(Nslip)) + +end function lattice_slip_direction + + +!-------------------------------------------------------------------------------------------------- +!> @brief Transverse direction of slip systems (||t, t = b x n) +!-------------------------------------------------------------------------------------------------- +function lattice_slip_transverse(Nslip,structure,cOverA) result(t) + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,sum(Nslip)) :: t + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) + t = coordinateSystem(1:3,3,1:sum(Nslip)) + +end function lattice_slip_transverse + + !-------------------------------------------------------------------------------------------------- !> @brief Projection of the transverse direction onto the slip plane !> @details: This projection is used to calculate forest hardening for edge dislocations and for @@ -2219,8 +2277,6 @@ end function lattice_SchmidMatrix_cleavage function slipProjection_transverse(Nslip,structure,cOverA) result(projection) use math, only: & math_mul3x3 - use IO, only: & - IO_error implicit none integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family @@ -2229,36 +2285,9 @@ function slipProjection_transverse(Nslip,structure,cOverA) result(projection) real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - real(pReal), dimension(:,:), allocatable :: slipSystems - integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt) :: i, j - - if (len_trim(structure) /= 3_pInt) & - call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - NslipMax = LATTICE_FCC_NSLIPSYSTEM - slipSystems = LATTICE_FCC_SYSTEMSLIP - case('bcc') - NslipMax = LATTICE_BCC_NSLIPSYSTEM - slipSystems = LATTICE_BCC_SYSTEMSLIP - case('hex') - NslipMax = LATTICE_HEX_NSLIPSYSTEM - slipSystems = LATTICE_HEX_SYSTEMSLIP - case('bct') - NslipMax = LATTICE_BCT_NSLIPSYSTEM - slipSystems = LATTICE_BCT_SYSTEMSLIP - case default - call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) - end select - - if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & - call IO_error(145_pInt,ext_msg='Nslip '//trim(structure)) - if (any(Nslip < 0_pInt)) & - call IO_error(144_pInt,ext_msg='Nslip '//trim(structure)) - - coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) + + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j))) @@ -2275,8 +2304,6 @@ end function slipProjection_transverse function slipProjection_direction(Nslip,structure,cOverA) result(projection) use math, only: & math_mul3x3 - use IO, only: & - IO_error implicit none integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family @@ -2285,36 +2312,9 @@ function slipProjection_direction(Nslip,structure,cOverA) result(projection) real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - real(pReal), dimension(:,:), allocatable :: slipSystems - integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt) :: i, j - - if (len_trim(structure) /= 3_pInt) & - call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - NslipMax = LATTICE_FCC_NSLIPSYSTEM - slipSystems = LATTICE_FCC_SYSTEMSLIP - case('bcc') - NslipMax = LATTICE_BCC_NSLIPSYSTEM - slipSystems = LATTICE_BCC_SYSTEMSLIP - case('hex') - NslipMax = LATTICE_HEX_NSLIPSYSTEM - slipSystems = LATTICE_HEX_SYSTEMSLIP - case('bct') - NslipMax = LATTICE_BCT_NSLIPSYSTEM - slipSystems = LATTICE_BCT_SYSTEMSLIP - case default - call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) - end select - - if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & - call IO_error(145_pInt,ext_msg='Nslip '//trim(structure)) - if (any(Nslip < 0_pInt)) & - call IO_error(144_pInt,ext_msg='Nslip '//trim(structure)) - - coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) + + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,1,j))) @@ -2330,8 +2330,6 @@ end function slipProjection_direction function slipProjection_normal(Nslip,structure,cOverA) result(projection) use math, only: & math_mul3x3 - use IO, only: & - IO_error implicit none integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family @@ -2340,12 +2338,37 @@ function slipProjection_normal(Nslip,structure,cOverA) result(projection) real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - real(pReal), dimension(:,:), allocatable :: slipSystems - integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt) :: i, j + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) + + do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) + projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,j))) + enddo; enddo + +end function slipProjection_normal + + +!-------------------------------------------------------------------------------------------------- +!> @brief build a local coordinate system on slip systems +!> @details Order: Direction, plane (normal), and common perpendicular +!-------------------------------------------------------------------------------------------------- +function coordinateSystem_slip(Nslip,structure,cOverA) result(coordinateSystem) + use math, only: & + math_mul3x3 + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + real(pReal), dimension(:,:), allocatable :: slipSystems + integer(pInt), dimension(:), allocatable :: NslipMax + if (len_trim(structure) /= 3_pInt) & - call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) + call IO_error(137_pInt,ext_msg='coordinateSystem_slip: '//trim(structure)) select case(structure(1:3)) case('fcc') @@ -2361,7 +2384,7 @@ function slipProjection_normal(Nslip,structure,cOverA) result(projection) NslipMax = LATTICE_BCT_NSLIPSYSTEM slipSystems = LATTICE_BCT_SYSTEMSLIP case default - call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) + call IO_error(137_pInt,ext_msg='coordinateSystem_slip: '//trim(structure)) end select if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & @@ -2371,11 +2394,7 @@ function slipProjection_normal(Nslip,structure,cOverA) result(projection) coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) - do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) - projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,j))) - enddo; enddo - -end function slipProjection_normal +end function coordinateSystem_slip !-------------------------------------------------------------------------------------------------- @@ -2417,7 +2436,7 @@ end function buildInteraction !-------------------------------------------------------------------------------------------------- -!> @brief build a local coordinate system in a slip, twin, trans, cleavage system +!> @brief build a local coordinate system on slip, twin, trans, cleavage systems !> @details Order: Direction, plane (normal), and common perpendicular !-------------------------------------------------------------------------------------------------- function buildCoordinateSystem(active,complete,system,structure,cOverA) From e6e019e48a3cb14283e1529235ee4c1e390f7d02 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Feb 2019 09:13:50 +0100 Subject: [PATCH 262/309] transition to param structure --- src/plastic_nonlocal.f90 | 66 ++++++++++++++++++++++------------------ 1 file changed, 37 insertions(+), 29 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 0aa254fb2..42ed24ad2 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -43,7 +43,6 @@ module plastic_nonlocal colinearSystem !< colinear system to the active slip system (only valid for fcc!) real(pReal), dimension(:), allocatable, private :: & - atomicVolume, & !< atomic volume rhoSglScatter, & !< standard deviation of scatter in initial dislocation density rhoSglRandom, & rhoSglRandomBinning @@ -58,13 +57,6 @@ module plastic_nonlocal lambda0PerSlipFamily, & !< mean free path prefactor for each family and instance lambda0 !< mean free path prefactor for each slip system and instance - - real(pReal), dimension(:,:,:), allocatable, private :: & - minDipoleHeightPerSlipFamily, & !< minimum stable edge/screw dipole height for each family and instance - minDipoleHeight, & !< minimum stable edge/screw dipole height for each slip system and instance - peierlsStressPerSlipFamily, & !< Peierls stress (edge and screw) - peierlsStress !< Peierls stress (edge and screw) - real(pReal), dimension(:,:,:,:), allocatable, private :: & rhoDotEdgeJogsOutput, & sourceProbability @@ -152,7 +144,10 @@ module plastic_nonlocal nu real(pReal), dimension(:), allocatable :: & - + minDipoleHeight_edge, & !< minimum stable edge dipole height + minDipoleHeight_screw, & !< minimum stable screw dipole height + peierlsstress_edge, & + peierlsstress_screw, & rhoSglEdgePos0, & !< initial edge_pos dislocation density per slip system for each family and instance rhoSglEdgeNeg0, & !< initial edge_neg dislocation density per slip system for each family and instance rhoSglScrewPos0, & !< initial screw_pos dislocation density per slip system for each family and instance @@ -163,6 +158,8 @@ module plastic_nonlocal burgers !< absolute length of burgers vector [m] for each slip system and instance real(pReal), dimension(:,:), allocatable :: & + minDipoleHeight, & ! edge and screw + peierlsstress, & ! edge and screw interactionSlipSlip ,& !< coefficients for slip-slip interaction for each interaction type and instance forestProjection_Edge, & !< matrix of forest projections of edge dislocations for each instance forestProjection_Screw !< matrix of forest projections of screw dislocations for each instance @@ -343,7 +340,6 @@ allocate(Nslip(lattice_maxNslipFamily,maxNinstances), source=0_pInt) allocate(slipFamily(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(totalNslip(maxNinstances), source=0_pInt) -allocate(atomicVolume(maxNinstances), source=0.0_pReal) allocate(rhoSglScatter(maxNinstances), source=0.0_pReal) allocate(rhoSglRandom(maxNinstances), source=0.0_pReal) allocate(rhoSglRandomBinning(maxNinstances), source=1.0_pReal) @@ -355,8 +351,6 @@ allocate(rhoSglScrewNeg0(lattice_maxNslipFamily,maxNinstances), s allocate(rhoDipEdge0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) allocate(rhoDipScrew0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) allocate(lambda0PerSlipFamily(lattice_maxNslipFamily,maxNinstances), source=0.0_pReal) -allocate(minDipoleHeightPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=-1.0_pReal) -allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=0.0_pReal) rewind(fileUnit) @@ -418,8 +412,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s do f = 1_pInt, Nchunks_SlipFamilies lambda0PerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) enddo - case('atomicvolume') - atomicVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglscatter') rhoSglScatter(instance) = IO_floatValue(line,chunkPos,2_pInt) case('rhosglrandom') @@ -454,8 +446,6 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s endif enddo - if (atomicVolume(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='atomicVolume ('//PLASTICITY_NONLOCAL_label//')') if (rhoSglScatter(instance) < 0.0_pReal) & call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') if (rhoSglRandom(instance) < 0.0_pReal) & @@ -483,7 +473,6 @@ allocate(iTauF(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) allocate(lambda0(maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(minDipoleHeight(maxTotalNslip,2,maxNinstances), source=-1.0_pReal) allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=2.0_pReal) @@ -502,7 +491,6 @@ allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,theMesh%el allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(peierlsStress(maxTotalNslip,2,maxNinstances), source=0.0_pReal) allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) initializeInstances: do phase = 1_pInt, size(phase_plasticity) @@ -627,8 +615,6 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), !*** burgers vector, mean free path prefactor and minimum dipole distance for each slip system lambda0(s1,instance) = lambda0PerSlipFamily(f,instance) - minDipoleHeight(s1,1:2,instance) = minDipoleHeightPerSlipFamily(f,1:2,instance) - peierlsStress(s1,1:2,instance) = peierlsStressPerSlipFamily(f,1:2,instance) do s2 = 1_pInt,ns @@ -713,10 +699,12 @@ param(instance)%probabilisticMultiplication = .false. config%getFloat('c/a',defaultVal=0.0_pReal)) prm%forestProjection_screw = lattice_forestProjection_screw (prm%Nslip,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - minDipoleHeightPerSlipFamily(:,1_pInt,instance) = config_phase(p)%getFloats('minimumdipoleheightedge')!,'ddipminedge') - minDipoleHeightPerSlipFamily(:,2_pInt,instance) = config_phase(p)%getFloats('minimumdipoleheightscrew')!,'ddipminscrew') - peierlsStressPerSlipFamily(:,1_pInt,instance) = config_phase(p)%getFloat('peierlsstressedge')!,'peierlsstress_edge') - peierlsStressPerSlipFamily(:,2_pInt,instance) = config_phase(p)%getFloat('peierlsstressscrew')!,'peierlsstress_screw') + + prm%minDipoleHeight_edge = config_phase(p)%getFloats('minimumdipoleheightedge')!,'ddipminedge') + prm%minDipoleHeight_screw = config_phase(p)%getFloats('minimumdipoleheightscrew')!,'ddipminscrew') + + prm%peierlsstress_edge = config_phase(p)%getFloats('peierlsstressedge')!,'peierlsstress_edge') + prm%peierlsstress_screw = config_phase(p)%getFloats('peierlsstressscrew')!,'peierlsstress_screw') prm%atomicVolume = config_phase(p)%getFloat('atomicvolume') prm%Dsd0 = config_phase(p)%getFloat('selfdiffusionprefactor') !,'dsd0') @@ -744,6 +732,18 @@ param(instance)%probabilisticMultiplication = .false. prm%q = config_phase(p)%getFloat('q') + prm%minDipoleHeight_edge = math_expand(prm%minDipoleHeight_edge,prm%Nslip) + prm%minDipoleHeight_screw = math_expand(prm%minDipoleHeight_screw,prm%Nslip) + allocate(prm%minDipoleHeight(prm%totalNslip,2)) + prm%minDipoleHeight(:,1) = prm%minDipoleHeight_edge + prm%minDipoleHeight(:,2) = prm%minDipoleHeight_screw + + prm%peierlsstress_edge = math_expand(prm%peierlsstress_edge,prm%Nslip) + prm%peierlsstress_screw = math_expand(prm%peierlsstress_screw,prm%Nslip) + allocate(prm%peierlsstress(prm%totalNslip,2)) + prm%peierlsstress(:,1) = prm%peierlsstress_edge + prm%peierlsstress(:,2) = prm%peierlsstress_screw + prm%viscosity = config_phase(p)%getFloat('viscosity')!,'glideviscosity') prm%fattack = config_phase(p)%getFloat('attackfrequency')!,'fattack') @@ -787,7 +787,8 @@ extmsg = trim(extmsg)//' surfaceTransmissivity' extmsg = trim(extmsg)//' surfaceTransmissivity' if ( prm%Dsd0 < 0.0_pReal) extmsg = trim(extmsg)//' Dsd0' - + ! if (atomicVolume(instance) <= 0.0_pReal) & + ! call IO_error(211_pInt,ext_msg='atomicVolume ('//PLASTICITY_NONLOCAL_label//')') ! if (minDipoleHeightPerSlipFamily(f,1,instance) < 0.0_pReal) & ! call IO_error(211_pInt,ext_msg='minimumDipoleHeightEdge ('//PLASTICITY_NONLOCAL_label//')') ! if (minDipoleHeightPerSlipFamily(f,2,instance) < 0.0_pReal) & @@ -1485,7 +1486,7 @@ if (Temperature > 0.0_pReal) then jumpWidth_P = prm%burgers(s) activationLength_P = prm%doublekinkwidth *prm%burgers(s) activationVolume_P = activationLength_P * jumpWidth_P * prm%burgers(s) - criticalStress_P = peierlsStress(s,c,instance) + criticalStress_P = prm%peierlsStress(s,c) activationEnergy_P = criticalStress_P * activationVolume_P tauRel_P = min(1.0_pReal, tauEff / criticalStress_P) ! ensure that the activation probability cannot become greater than one tPeierls = 1.0_pReal / prm%fattack & @@ -1834,7 +1835,7 @@ do s = 1_pInt,prm%totalNslip tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo -dLower = minDipoleHeight(1:ns,1:2,instance) +dLower = prm%minDipoleHeight(1:ns,1:2) dUpper(1:ns,1) = prm%mu * prm%burgers & / (8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau)) dUpper(1:ns,2) = prm%mu * prm%burgers / (4.0_pReal * PI * abs(tau)) @@ -2108,7 +2109,7 @@ do s = 1_pInt,ns ! loop over slip systems if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo -dLower = minDipoleHeight(1:ns,1:2,instance) +dLower = prm%minDipoleHeight(1:ns,1:2) dUpper(1:ns,1) = prm%mu * prm%burgers(1:ns) & / (8.0_pReal * pi * (1.0_pReal - prm%nu) * abs(tau)) dUpper(1:ns,2) = prm%mu * prm%burgers(1:ns) & @@ -2138,6 +2139,13 @@ if (lattice_structure(ph) == LATTICE_bcc_ID) then else ! ALL OTHER STRUCTURES if (prm%probabilisticMultiplication) then + !################################################################################################# + !################################################################################################# + ! ToDo: MD: to me, this whole procedure looks extremly time step and integrator dependent + ! Just using FPI instead of Euler gives you a higher chance of multiplication if I understand it correctly + ! I suggest to remove + !################################################################################################# + !################################################################################################# meshlength = mesh_ipVolume(ip,el)**0.333_pReal where(sum(rhoSgl(1:ns,1:4),2) > 0.0_pReal) nSources = (sum(rhoSgl(1:ns,1:2),2) * prm%fEdgeMultiplication + sum(rhoSgl(1:ns,3:4),2)) & @@ -2733,7 +2741,7 @@ do s = 1_pInt,ns if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo -dLower = minDipoleHeight(1:ns,1:2,instance) +dLower = prm%minDipoleHeight(1:ns,1:2) dUpper(1:ns,1) = prm%mu * prm%burgers(1:ns) & / (8.0_pReal * pi * (1.0_pReal - prm%nu) * abs(tau)) dUpper(1:ns,2) = prm%mu * prm%burgers(1:ns) & From 838faca8191dcd982663e329f82290a92ea2fafb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Feb 2019 13:32:08 +0100 Subject: [PATCH 263/309] using structure for output avoids waste of memory in case of multiple instances avoids explicit dependence on ip and el --- src/plastic_nonlocal.f90 | 123 ++++++++++++++++++++------------------- 1 file changed, 63 insertions(+), 60 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 42ed24ad2..477bfee04 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -37,7 +37,7 @@ module plastic_nonlocal totalNslip !< total number of active slip systems for each instance integer(pInt), dimension(:,:), allocatable, private :: & - Nslip, & !< number of active slip systems for each family and instance + Nslip, & !< number of active slip systems slipFamily, & !< lookup table relating active slip system to slip family for each instance slipSystemLattice, & !< lookup table relating active slip system index to lattice slip system index for each instance colinearSystem !< colinear system to the active slip system (only valid for fcc!) @@ -48,26 +48,18 @@ module plastic_nonlocal rhoSglRandomBinning real(pReal), dimension(:,:), allocatable, private :: & - rhoSglEdgePos0, & !< initial edge_pos dislocation density per slip system for each family and instance - rhoSglEdgeNeg0, & !< initial edge_neg dislocation density per slip system for each family and instance - rhoSglScrewPos0, & !< initial screw_pos dislocation density per slip system for each family and instance - rhoSglScrewNeg0, & !< initial screw_neg dislocation density per slip system for each family and instance - rhoDipEdge0, & !< initial edge dipole dislocation density per slip system for each family and instance - rhoDipScrew0, & !< initial screw dipole dislocation density per slip system for each family and instance - lambda0PerSlipFamily, & !< mean free path prefactor for each family and instance - lambda0 !< mean free path prefactor for each slip system and instance + rhoSglEdgePos0, & !< initial edge_pos dislocation density + rhoSglEdgeNeg0, & !< initial edge_neg dislocation density + rhoSglScrewPos0, & !< initial screw_pos dislocation density + rhoSglScrewNeg0, & !< initial screw_neg dislocation density + rhoDipEdge0, & !< initial edge dipole dislocation density + rhoDipScrew0, & !< initial screw dipole dislocation density + lambda0PerSlipFamily, & !< mean free path prefactor + lambda0 !< mean free path prefactor real(pReal), dimension(:,:,:,:), allocatable, private :: & - rhoDotEdgeJogsOutput, & sourceProbability - real(pReal), dimension(:,:,:,:,:), allocatable, private :: & - rhoDotFluxOutput, & - rhoDotMultiplicationOutput, & - rhoDotSingle2DipoleGlideOutput, & - rhoDotAthermalAnnihilationOutput, & - rhoDotThermalAnnihilationOutput !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) - real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & compatibility !< slip system compatibility between me and my neighbors @@ -182,8 +174,21 @@ module plastic_nonlocal integer(kind(undefined_ID)), dimension(:), allocatable :: & outputID !< ID of each post result output + end type tParameters + type, private :: tOutput !< container type for storage of output results + real(pReal), dimension(:,:), allocatable, private :: & + rhoDotEdgeJogs + real(pReal), dimension(:,:,:), allocatable, private :: & + rhoDotFlux, & + rhoDotMultiplication, & + rhoDotSingle2DipoleGlide, & + rhoDotAthermalAnnihilation, & + rhoDotThermalAnnihilation + end type + + type, private :: tNonlocalState real(pReal), pointer, dimension(:,:) :: & @@ -216,13 +221,15 @@ module plastic_nonlocal rhoSglEdge, & accumulatedshear end type tNonlocalState + type(tNonlocalState), allocatable, dimension(:), private :: & deltaState, & dotState, & state - type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tOutput), dimension(:), allocatable, private :: results integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & plastic_nonlocal_outputID !< ID of each post result output @@ -331,6 +338,7 @@ allocate(param(maxNinstances)) allocate(state(maxNinstances)) allocate(dotState(maxNinstances)) allocate(deltaState(maxNinstances)) +allocate(results(maxNinstances)) allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0_pInt) allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) @@ -476,19 +484,6 @@ allocate(lambda0(maxTotalNslip,maxNinstances), allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=2.0_pReal) -allocate(rhoDotFluxOutput(maxTotalNslip,8,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & - source=0.0_pReal) -allocate(rhoDotMultiplicationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & - source=0.0_pReal) -allocate(rhoDotSingle2DipoleGlideOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & - source=0.0_pReal) -allocate(rhoDotAthermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & - source=0.0_pReal) -allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & - source=0.0_pReal) -allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & - source=0.0_pReal) - allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) @@ -651,7 +646,7 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), stt => state(instance), & del => deltaState(instance), & config => config_phase(p)) - + NofMyPhase=count(material_phase==p) prm%mu = lattice_mu(p) prm%nu = lattice_nu(p) structure = config_phase(p)%getString('lattice_structure') @@ -971,7 +966,17 @@ extmsg = trim(extmsg)//' surfaceTransmissivity' dot%rhoDipScrew => plasticState(p)%dotState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) del%rhoDipScrew => plasticState(p)%deltaState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) plasticState(p)%aTolState(iGamma(1:ns,instance)) = prm%aTolShear + + allocate(results(instance)%rhoDotFlux(prm%totalNslip,8,NofMyPhase)) + allocate(results(instance)%rhoDotMultiplication(prm%totalNslip,2,NofMyPhase)) + allocate(results(instance)%rhoDotSingle2DipoleGlide(prm%totalNslip,2,NofMyPhase)) + allocate(results(instance)%rhoDotAthermalAnnihilation(prm%totalNslip,2,NofMyPhase)) + allocate(results(instance)%rhoDotThermalAnnihilation(prm%totalNslip,2,NofMyPhase)) + allocate(results(instance)%rhoDotEdgeJogs(prm%totalNslip,NofMyPhase)) end associate + + + enddo end subroutine plastic_nonlocal_init @@ -1421,7 +1426,7 @@ use material, only: material_phase, & implicit none -!*** input variables + integer(pInt), intent(in) :: ip, & !< current integration point el, & !< current element number c !< dislocation character (1:edge, 2:screw) @@ -1431,13 +1436,11 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt tauNS, & !< resolved external shear stress (including non Schmid effects) tauThreshold !< threshold shear stress -!*** output variables real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))), & intent(out) :: v, & !< velocity dv_dtau, & !< velocity derivative with respect to resolved shear stress (without non Schmid contributions) dv_dtauNS !< velocity derivative with respect to resolved shear stress (including non Schmid contributions) -!*** local variables integer(pInt) :: instance, & !< current instance of this plasticity ns, & !< short notation for the total number of active slip systems s !< index of my current slip system @@ -1577,7 +1580,7 @@ use material, only: material_phase, & implicit none -!*** input variables + integer(pInt), intent(in) :: ip, & !< current integration point el !< current element number real(pReal), intent(in) :: Temperature, & !< temperature @@ -1585,11 +1588,10 @@ volume !< volume of the materialpoint real(pReal), dimension(3,3), intent(in) :: Mp -!*** output variables real(pReal), dimension(3,3), intent(out) :: Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp !< derivative of Lp with respect to Tstar (9x9 matrix) -!*** local variables + integer(pInt) instance, & !< current instance of this plasticity ns, & !< short notation for the total number of active slip systems i, & @@ -2429,12 +2431,13 @@ rhoDot = rhoDotFlux & + rhoDotAthermalAnnihilation & + rhoDotThermalAnnihilation -rhoDotFluxOutput(1:ns,1:8,1_pInt,ip,el) = rhoDotFlux(1:ns,1:8) -rhoDotMultiplicationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotMultiplication(1:ns,[1,3]) -rhoDotSingle2DipoleGlideOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotSingle2DipoleGlide(1:ns,9:10) -rhoDotAthermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotAthermalAnnihilation(1:ns,9:10) -rhoDotThermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotThermalAnnihilation(1:ns,9:10) -rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) +results(instance)%rhoDotFlux(1:ns,1:8,o) = rhoDotFlux(1:ns,1:8) + +results(instance)%rhoDotMultiplication(1:ns,1:2,o) = rhoDotMultiplication(1:ns,[1,3]) +results(instance)%rhoDotSingle2DipoleGlide(1:ns,1:2,o) = rhoDotSingle2DipoleGlide(1:ns,9:10) +results(instance)%rhoDotAthermalAnnihilation(1:ns,1:2,o) = rhoDotAthermalAnnihilation(1:ns,9:10) +results(instance)%rhoDotThermalAnnihilation(1:ns,1:2,o) = rhoDotThermalAnnihilation(1:ns,9:10) +results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) #ifdef DEBUG @@ -2839,55 +2842,55 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) cs = cs + ns case (rho_dot_gen_ID) ! Obsolete - postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) & - + rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotMultiplication(1:ns,1,of) & + + results(instance)%rhoDotMultiplication(1:ns,2,of) cs = cs + ns case (rho_dot_gen_edge_ID) - postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotMultiplication(1:ns,1,of) cs = cs + ns case (rho_dot_gen_screw_ID) - postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotMultiplication(1:ns,2,of) cs = cs + ns case (rho_dot_sgl2dip_edge_ID) - postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotSingle2DipoleGlide(1:ns,1,of) cs = cs + ns case (rho_dot_sgl2dip_screw_ID) - postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotSingle2DipoleGlide(1:ns,2,of) cs = cs + ns case (rho_dot_ann_ath_ID) - postResults(cs+1_pInt:cs+ns) = rhoDotAthermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & - + rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotAthermalAnnihilation(1:ns,1,of) & + + results(instance)%rhoDotAthermalAnnihilation(1:ns,2,of) cs = cs + ns case (rho_dot_ann_the_edge_ID) - postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotThermalAnnihilation(1:ns,1,of) cs = cs + ns case (rho_dot_ann_the_screw_ID) - postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotThermalAnnihilation(1:ns,2,of) cs = cs + ns case (rho_dot_edgejogs_ID) - postResults(cs+1_pInt:cs+ns) = rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) + postResults(cs+1_pInt:cs+ns) = results(instance)%rhoDotEdgeJogs(1:ns,of) cs = cs + ns case (rho_dot_flux_mobile_ID) - postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) + postResults(cs+1_pInt:cs+ns) = sum(results(instance)%rhoDotFlux(1:ns,1:4,of),2) cs = cs + ns case (rho_dot_flux_edge_ID) - postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,1_pInt,ip,el),2) & - + sum(rhoDotFluxOutput(1:ns,5:6,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2) + postResults(cs+1_pInt:cs+ns) = sum(results(instance)%rhoDotFlux(1:ns,1:2,of),2) & + + sum(results(instance)%rhoDotFlux(1:ns,5:6,of)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2) cs = cs + ns case (rho_dot_flux_screw_ID) - postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,3:4,1_pInt,ip,el),2) & - + sum(rhoDotFluxOutput(1:ns,7:8,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,7:8)),2) + postResults(cs+1_pInt:cs+ns) = sum(results(instance)%rhoDotFlux(1:ns,3:4,of),2) & + + sum(results(instance)%rhoDotFlux(1:ns,7:8,of)*sign(1.0_pReal,rhoSgl(1:ns,7:8)),2) cs = cs + ns case (velocity_edge_pos_ID) From eb394b3139368253ad77f8bebd21ef2f06309a7a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Feb 2019 14:54:26 +0100 Subject: [PATCH 264/309] same name in all models --- src/constitutive.f90 | 2 +- src/plastic_nonlocal.f90 | 13 ++++++++++--- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index d49fcec6e..7e6cdee7a 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -358,7 +358,7 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) PLASTICITY_disloucla_ID, & PLASTICITY_nonlocal_ID use plastic_nonlocal, only: & - plastic_nonlocal_microstructure + plastic_nonlocal_dependentState use plastic_dislotwin, only: & plastic_dislotwin_dependentState use plastic_disloUCLA, only: & diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 477bfee04..8652baf88 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -238,7 +238,7 @@ module plastic_nonlocal plastic_nonlocal_init, & plastic_nonlocal_stateInit, & plastic_nonlocal_aTolState, & - plastic_nonlocal_microstructure, & + plastic_nonlocal_dependentState, & plastic_nonlocal_LpAndItsTangent, & plastic_nonlocal_dotState, & plastic_nonlocal_deltaState, & @@ -1126,7 +1126,7 @@ end subroutine plastic_nonlocal_aTolState !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- -subroutine plastic_nonlocal_microstructure(Fe, Fp, ip, el) +subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el) use prec, only: & dEq0 use IO, only: & @@ -1284,6 +1284,13 @@ forall (s = 1_pInt:ns) & tauBack = 0.0_pReal + !################################################################################################# + !################################################################################################# + ! ToDo: MD: this is most likely only correct for F_i = I + !################################################################################################# + !################################################################################################# + + if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then invFe = math_inv33(Fe) invFp = math_inv33(Fp) @@ -1406,7 +1413,7 @@ plasticState(ph)%state(iTauB(1:ns,instance),of) = tauBack endif #endif end associate -end subroutine plastic_nonlocal_microstructure +end subroutine plastic_nonlocal_dependentState !-------------------------------------------------------------------------------------------------- From 871ba90654c1de4af9bb057594b88c02e6c0bad0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Feb 2019 17:50:26 +0100 Subject: [PATCH 265/309] initialization can be done internally --- src/constitutive.f90 | 8 +- src/plastic_nonlocal.f90 | 305 +++++++++++++-------------------------- 2 files changed, 106 insertions(+), 207 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 7e6cdee7a..6f07446f9 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -150,10 +150,8 @@ subroutine constitutive_init() if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init - if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then - call plastic_nonlocal_init(FILEUNIT) - call plastic_nonlocal_stateInit() - endif + if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) call plastic_nonlocal_init(FILEUNIT) + !-------------------------------------------------------------------------------------------------- ! parse source mechanisms from config file @@ -392,7 +390,7 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_disloUCLA_dependentState(instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_microstructure (Fe,Fp,ip,el) + call plastic_nonlocal_dependentState (Fe,Fp,ip,el) end select plasticityType end subroutine constitutive_microstructure diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 8652baf88..a70bdafeb 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -48,12 +48,6 @@ module plastic_nonlocal rhoSglRandomBinning real(pReal), dimension(:,:), allocatable, private :: & - rhoSglEdgePos0, & !< initial edge_pos dislocation density - rhoSglEdgeNeg0, & !< initial edge_neg dislocation density - rhoSglScrewPos0, & !< initial screw_pos dislocation density - rhoSglScrewNeg0, & !< initial screw_neg dislocation density - rhoDipEdge0, & !< initial edge dipole dislocation density - rhoDipScrew0, & !< initial screw dipole dislocation density lambda0PerSlipFamily, & !< mean free path prefactor lambda0 !< mean free path prefactor @@ -236,8 +230,6 @@ module plastic_nonlocal public :: & plastic_nonlocal_init, & - plastic_nonlocal_stateInit, & - plastic_nonlocal_aTolState, & plastic_nonlocal_dependentState, & plastic_nonlocal_LpAndItsTangent, & plastic_nonlocal_dotState, & @@ -352,12 +344,6 @@ allocate(rhoSglScatter(maxNinstances), source=0.0_pReal) allocate(rhoSglRandom(maxNinstances), source=0.0_pReal) allocate(rhoSglRandomBinning(maxNinstances), source=1.0_pReal) -allocate(rhoSglEdgePos0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) -allocate(rhoSglEdgeNeg0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) -allocate(rhoSglScrewPos0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) -allocate(rhoSglScrewNeg0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) -allocate(rhoDipEdge0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) -allocate(rhoDipScrew0(lattice_maxNslipFamily,maxNinstances), source=-1.0_pReal) allocate(lambda0PerSlipFamily(lattice_maxNslipFamily,maxNinstances), source=0.0_pReal) @@ -392,30 +378,6 @@ allocate(lambda0PerSlipFamily(lattice_maxNslipFamily,maxNinstances), s do f = 1_pInt, Nchunks_SlipFamilies Nslip(f,instance) = IO_intValue(line,chunkPos,1_pInt+f) enddo - case ('rhosgledgepos0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoSglEdgePos0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo - case ('rhosgledgeneg0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoSglEdgeNeg0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo - case ('rhosglscrewpos0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoSglScrewPos0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo - case ('rhosglscrewneg0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoSglScrewNeg0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo - case ('rhodipedge0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoDipEdge0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo - case ('rhodipscrew0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoDipScrew0(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo case ('lambda0') do f = 1_pInt, Nchunks_SlipFamilies lambda0PerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) @@ -437,21 +399,8 @@ allocate(lambda0PerSlipFamily(lattice_maxNslipFamily,maxNinstances), s call IO_error(211_pInt,ext_msg='Nslip ('//PLASTICITY_NONLOCAL_label//')') do f = 1_pInt,lattice_maxNslipFamily if (Nslip(f,instance) > 0_pInt) then - if (rhoSglEdgePos0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglEdgePos0 ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglEdgeNeg0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglEdgeNeg0 ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglScrewPos0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglScrewPos0 ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglScrewNeg0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglScrewNeg0 ('//PLASTICITY_NONLOCAL_label//')') - if (rhoDipEdge0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoDipEdge0 ('//PLASTICITY_NONLOCAL_label//')') - if (rhoDipScrew0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoDipScrew0 ('//PLASTICITY_NONLOCAL_label//')') if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') - endif enddo if (rhoSglScatter(instance) < 0.0_pReal) & @@ -622,17 +571,7 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), enddo enddo - - !*** combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) - !* four types t: - !* 1) positive screw at positive resolved stress - !* 2) positive screw at negative resolved stress - !* 3) negative screw at positive resolved stress - !* 4) negative screw at negative resolved stress - - - call plastic_nonlocal_aTolState(phase,instance) endif myPhase2 enddo initializeInstances @@ -793,6 +732,20 @@ extmsg = trim(extmsg)//' surfaceTransmissivity' ! if (peierlsStressPerSlipFamily(f,2,instance) <= 0.0_pReal) & ! call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') + +! if (rhoSglEdgePos0(f,instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoSglEdgePos0 ('//PLASTICITY_NONLOCAL_label//')') +! if (rhoSglEdgeNeg0(f,instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoSglEdgeNeg0 ('//PLASTICITY_NONLOCAL_label//')') +! if (rhoSglScrewPos0(f,instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoSglScrewPos0 ('//PLASTICITY_NONLOCAL_label//')') +! if (rhoSglScrewNeg0(f,instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoSglScrewNeg0 ('//PLASTICITY_NONLOCAL_label//')') +! if (rhoDipEdge0(f,instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoDipEdge0 ('//PLASTICITY_NONLOCAL_label//')') +! if (rhoDipScrew0(f,instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoDipScrew0 ('//PLASTICITY_NONLOCAL_label//')') + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) @@ -976,151 +929,99 @@ plasticState(p)%aTolState(iGamma(1:ns,instance)) = prm%aTolShear end associate - + if (NofMyPhase > 0_pInt) call stateInit(p,NofMyPhase) + plasticState(p)%state0 = plasticState(p)%state enddo + + contains + +subroutine stateInit(phase,NofMyPhase) + use math, only: & + math_sampleGaussVar + use mesh, only: & + theMesh, & + mesh_ipVolume + use material, only: & + material_phase, & + phase_plasticityInstance, & + phasememberAt + implicit none + + integer(pInt),intent(in) ::& + phase, & + NofMyPhase + integer(pInt) :: & + e, & + i, & + f, & + from, & + upto, & + s, & + instance, & + phasemember + real(pReal), dimension(2) :: & + noise, & + rnd + real(pReal) :: & + meanDensity, & + totalVolume, & + densityBinning, & + minimumIpVolume + real(pReal), dimension(NofMyPhase) :: & + volume + + + instance = phase_plasticityInstance(phase) + associate(prm => param(instance), stt => state(instance)) + + ! randomly distribute dislocation segments on random slip system and of random type in the volume + if (prm%rhoSglRandom > 0.0_pReal) then + + ! get the total volume of the instance + do e = 1_pInt,theMesh%nElems + do i = 1_pInt,theMesh%elem%nIPs + if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = mesh_ipVolume(i,e) + enddo + enddo + totalVolume = sum(volume) + minimumIPVolume = minval(volume) + densityBinning = prm%rhoSglRandomBinning / minimumIpVolume ** (2.0_pReal / 3.0_pReal) + + ! subsequently fill random ips with dislocation segments until we reach the desired overall density + meanDensity = 0.0_pReal + do while(meanDensity < prm%rhoSglRandom) + call random_number(rnd) + phasemember = nint(rnd(1)*real(NofMyPhase,pReal) + 0.5_pReal,pInt) + s = nint(rnd(2)*real(prm%totalNslip,pReal)*4.0_pReal + 0.5_pReal,pInt) + meanDensity = meanDensity + densityBinning * volume(phasemember) / totalVolume + stt%rhoSglMobile(s,phasemember) = densityBinning + enddo + ! homogeneous distribution of density with some noise + else + do e = 1_pInt, NofMyPhase + do f = 1_pInt,size(prm%Nslip,1) + from = 1_pInt + sum(prm%Nslip(1:f-1_pInt)) + upto = sum(prm%Nslip(1:f)) + do s = from,upto + noise = [math_sampleGaussVar(0.0_pReal, prm%rhoSglScatter), & + math_sampleGaussVar(0.0_pReal, prm%rhoSglScatter)] + stt%rhoSglEdgeMobilePos(s,e) = prm%rhoSglEdgePos0(f) + noise(1) + stt%rhoSglEdgeMobileNeg(s,e) = prm%rhoSglEdgeNeg0(f) + noise(1) + stt%rhoSglScrewMobilePos(s,e) = prm%rhoSglScrewPos0(f) + noise(2) + stt%rhoSglScrewMobileNeg(s,e) = prm%rhoSglScrewNeg0(f) + noise(2) + enddo + stt%rhoDipEdge(from:upto,e) = prm%rhoDipEdge0(f) + stt%rhoDipScrew(from:upto,e) = prm%rhoDipScrew0(f) + enddo + enddo + endif + + end associate + +end subroutine stateInit end subroutine plastic_nonlocal_init -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- - -subroutine plastic_nonlocal_stateInit() -use IO, only: IO_error -use lattice, only: lattice_maxNslipFamily -use math, only: math_sampleGaussVar -use mesh, only: mesh_ipVolume, & - theMesh -use material, only: material_phase, & - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt, & - phase_plasticity ,& - PLASTICITY_NONLOCAL_ID -implicit none - -integer(pInt) :: e, & - i, & - ns, & ! short notation for total number of active slip systems - f, & ! index of lattice family - from, & - upto, & - s, & ! index of slip system - t, & - j, & - instance, & - maxNinstances -real(pReal), dimension(2) :: noise -real(pReal), dimension(4) :: rnd -real(pReal) meanDensity, & - totalVolume, & - densityBinning, & - minimumIpVolume - -maxNinstances = int(count(phase_plasticity == PLASTICITY_NONLOCAL_ID),pInt) - -do instance = 1_pInt,maxNinstances - ns = totalNslip(instance) - - ! randomly distribute dislocation segments on random slip system and of random type in the volume - if (rhoSglRandom(instance) > 0.0_pReal) then - - ! get the total volume of the instance - - minimumIpVolume = huge(1.0_pReal) - totalVolume = 0.0_pReal - do e = 1_pInt,theMesh%nElems - do i = 1_pInt,theMesh%elem%nIPs - if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & - .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then - totalVolume = totalVolume + mesh_ipVolume(i,e) - minimumIpVolume = min(minimumIpVolume, mesh_ipVolume(i,e)) - endif - enddo - enddo - densityBinning = rhoSglRandomBinning(instance) / minimumIpVolume ** (2.0_pReal / 3.0_pReal) - - ! subsequently fill random ips with dislocation segments until we reach the desired overall density - - meanDensity = 0.0_pReal - do while(meanDensity < rhoSglRandom(instance)) - call random_number(rnd) - e = nint(rnd(1)*real(theMesh%nElems,pReal)+0.5_pReal,pInt) - i = nint(rnd(2)*real(theMesh%elem%nIPs,pReal)+0.5_pReal,pInt) - if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & - .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then - s = nint(rnd(3)*real(ns,pReal)+0.5_pReal,pInt) - t = nint(rnd(4)*4.0_pReal+0.5_pReal,pInt) - meanDensity = meanDensity + densityBinning * mesh_ipVolume(i,e) / totalVolume - plasticState(phaseAt(1,i,e))%state0(iRhoU(s,t,instance),phaseAt(1,i,e)) = & - plasticState(phaseAt(1,i,e))%state0(iRhoU(s,t,instance),phaseAt(1,i,e)) & - + densityBinning - endif - enddo - ! homogeneous distribution of density with some noise - else - do e = 1_pInt,theMesh%nElems - do i = 1_pInt,theMesh%elem%nIPs - if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & - .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then - do f = 1_pInt,lattice_maxNslipFamily - from = 1_pInt + sum(Nslip(1:f-1_pInt,instance)) - upto = sum(Nslip(1:f,instance)) - do s = from,upto - do j = 1_pInt,2_pInt - noise(j) = math_sampleGaussVar(0.0_pReal, rhoSglScatter(instance)) - enddo - plasticState(phaseAt(1,i,e))%state0(iRhoU(s,1,instance),phasememberAt(1,i,e)) = & - rhoSglEdgePos0(f,instance) + noise(1) - plasticState(phaseAt(1,i,e))%state0(iRhoU(s,2,instance),phasememberAt(1,i,e)) = & - rhoSglEdgeNeg0(f,instance) + noise(1) - plasticState(phaseAt(1,i,e))%state0(iRhoU(s,3,instance),phasememberAt(1,i,e)) = & - rhoSglScrewPos0(f,instance) + noise(2) - plasticState(phaseAt(1,i,e))%state0(iRhoU(s,4,instance),phasememberAt(1,i,e)) = & - rhoSglScrewNeg0(f,instance) + noise(2) - enddo - plasticState(phaseAt(1,i,e))%state0(iRhoD(from:upto,1,instance),phasememberAt(1,i,e)) = & - rhoDipEdge0(f,instance) - plasticState(phaseAt(1,i,e))%state0(iRhoD(from:upto,2,instance),phasememberAt(1,i,e)) = & - rhoDipScrew0(f,instance) - enddo - endif - enddo - enddo - endif -enddo - -end subroutine plastic_nonlocal_stateInit - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_nonlocal_aTolState(ph,instance) - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - ph - integer(pInt) :: & - ns, & - t, c - -associate (prm => param(instance)) - ns = totalNslip(instance) - forall (t = 1_pInt:4_pInt) - plasticState(ph)%aTolState(iRhoU(1:ns,t,instance)) = prm%aTolRho - plasticState(ph)%aTolState(iRhoB(1:ns,t,instance)) = prm%aTolRho - end forall - forall (c = 1_pInt:2_pInt) & - plasticState(ph)%aTolState(iRhoD(1:ns,c,instance)) = prm%aTolRho - - plasticState(ph)%aTolState(iGamma(1:ns,instance)) = prm%aTolShear - -end associate -end subroutine plastic_nonlocal_aTolState !-------------------------------------------------------------------------------------------------- From 6f135ea632a1e1ad6a067f9b94f176cae9df5a73 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Feb 2019 17:58:11 +0100 Subject: [PATCH 266/309] no random-multiplication anymore from our current understanding, the implementation of random nucleation was strongly dependent on the numerical method and the time stepping --- src/plastic_nonlocal.f90 | 51 ++-------------------------------------- 1 file changed, 2 insertions(+), 49 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index a70bdafeb..3248e6928 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -50,9 +50,6 @@ module plastic_nonlocal real(pReal), dimension(:,:), allocatable, private :: & lambda0PerSlipFamily, & !< mean free path prefactor lambda0 !< mean free path prefactor - - real(pReal), dimension(:,:,:,:), allocatable, private :: & - sourceProbability real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & compatibility !< slip system compatibility between me and my neighbors @@ -430,8 +427,7 @@ allocate(iTauF(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) allocate(lambda0(maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & - source=2.0_pReal) + allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) @@ -591,7 +587,6 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), structure = config_phase(p)%getString('lattice_structure') param(instance)%shortRangeStressCorrection = .false. -param(instance)%probabilisticMultiplication = .false. prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyInt) prm%totalNslip = sum(prm%Nslip) @@ -694,7 +689,6 @@ param(instance)%probabilisticMultiplication = .false. prm%fEdgeMultiplication = config_phase(p)%getFloat('edgemultiplication')!,'edgemultiplicationfactor','fedgemultiplication') prm%shortRangeStressCorrection = config_phase(p)%getInt('shortrangestresscorrection' ) > 0_pInt - prm%probabilisticMultiplication = config_phase(p)%keyExists('/probabilisticmultiplication/' )!,'randomsources','randommultiplication','discretesources') ! sanity checks if ( any(prm%burgers <= 0.0_pReal)) extmsg = trim(extmsg)//' burgers' @@ -2035,7 +2029,6 @@ dUpper = max(dUpper,dLower) !**************************************************************************** !*** calculate dislocation multiplication - rhoDotMultiplication = 0.0_pReal if (lattice_structure(ph) == LATTICE_bcc_ID) then ! BCC forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) @@ -2048,49 +2041,9 @@ if (lattice_structure(ph) == LATTICE_bcc_ID) then endforall else ! ALL OTHER STRUCTURES - if (prm%probabilisticMultiplication) then - !################################################################################################# - !################################################################################################# - ! ToDo: MD: to me, this whole procedure looks extremly time step and integrator dependent - ! Just using FPI instead of Euler gives you a higher chance of multiplication if I understand it correctly - ! I suggest to remove - !################################################################################################# - !################################################################################################# - meshlength = mesh_ipVolume(ip,el)**0.333_pReal - where(sum(rhoSgl(1:ns,1:4),2) > 0.0_pReal) - nSources = (sum(rhoSgl(1:ns,1:2),2) * prm%fEdgeMultiplication + sum(rhoSgl(1:ns,3:4),2)) & - / sum(rhoSgl(1:ns,1:4),2) * meshlength / lambda0(1:ns,instance)*sqrt(rhoForest(1:ns)) - elsewhere - nSources = meshlength / lambda0(1:ns,instance) * sqrt(rhoForest(1:ns)) - endwhere - do s = 1_pInt,ns - if (nSources(s) < 1.0_pReal) then - if (sourceProbability(s,1_pInt,ip,el) > 1.0_pReal) then - call random_number(rnd) - sourceProbability(s,1_pInt,ip,el) = rnd - !$OMP FLUSH(sourceProbability) - endif - if (sourceProbability(s,1_pInt,ip,el) > 1.0_pReal - nSources(s)) then - rhoDotMultiplication(s,1:4) = sum(rhoSglOriginal(s,1:4) * abs(v(s,1:4))) / meshlength - endif - else - sourceProbability(s,1_pInt,ip,el) = 2.0_pReal - rhoDotMultiplication(s,1:4) = & - (sum(abs(gdot(s,1:2))) * prm%fEdgeMultiplication + sum(abs(gdot(s,3:4)))) & - /prm%burgers(s) * sqrt(rhoForest(s)) / lambda0(s,instance) - endif - enddo -#ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) & - write(6,'(a,/,4(12x,12(f12.5,1x),/,/))') '<< CONST >> sources', nSources -#endif - else - rhoDotMultiplication(1:ns,1:4) = spread( & + rhoDotMultiplication(1:ns,1:4) = spread( & (sum(abs(gdot(1:ns,1:2)),2) * prm%fEdgeMultiplication + sum(abs(gdot(1:ns,3:4)),2)) & * sqrt(rhoForest(1:ns)) / lambda0(1:ns,instance) / prm%burgers(1:ns), 2, 4) - endif endif From 2d51c0595bd69d944e06cdee4c3d1f07834dc336 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Feb 2019 19:03:20 +0100 Subject: [PATCH 267/309] don't parse material.config any more --- src/constitutive.f90 | 15 ++- src/lattice.f90 | 5 +- src/plastic_nonlocal.f90 | 225 ++++++++++++--------------------------- 3 files changed, 80 insertions(+), 165 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6f07446f9..e5dc6a1cc 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -137,11 +137,6 @@ subroutine constitutive_init() logical :: knownPlasticity, knownSource, nonlocalConstitutionPresent nonlocalConstitutionPresent = .false. -!-------------------------------------------------------------------------------------------------- -! open material.config - if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... - call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file - !-------------------------------------------------------------------------------------------------- ! parse plasticities from config file if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init @@ -150,12 +145,16 @@ subroutine constitutive_init() if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init - if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) call plastic_nonlocal_init(FILEUNIT) - + if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) call plastic_nonlocal_init + + +!-------------------------------------------------------------------------------------------------- +! open material.config + if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... + call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file !-------------------------------------------------------------------------------------------------- ! parse source mechanisms from config file - call IO_checkAndRewind(FILEUNIT) if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init(FILEUNIT) if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init(FILEUNIT) if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init diff --git a/src/lattice.f90 b/src/lattice.f90 index ee4273a53..7ec4c5470 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -550,7 +550,10 @@ module lattice lattice_forestProjection_screw, & lattice_slipProjection_modeI, & lattice_slipProjection_modeII, & - lattice_slipProjection_modeIII + lattice_slipProjection_modeIII, & + lattice_slip_normal, & + lattice_slip_direction, & + lattice_slip_transverse contains diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 3248e6928..85800f7d7 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -41,15 +41,7 @@ module plastic_nonlocal slipFamily, & !< lookup table relating active slip system to slip family for each instance slipSystemLattice, & !< lookup table relating active slip system index to lattice slip system index for each instance colinearSystem !< colinear system to the active slip system (only valid for fcc!) - - real(pReal), dimension(:), allocatable, private :: & - rhoSglScatter, & !< standard deviation of scatter in initial dislocation density - rhoSglRandom, & - rhoSglRandomBinning - - real(pReal), dimension(:,:), allocatable, private :: & - lambda0PerSlipFamily, & !< mean free path prefactor - lambda0 !< mean free path prefactor + real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & compatibility !< slip system compatibility between me and my neighbors @@ -141,6 +133,9 @@ module plastic_nonlocal burgers !< absolute length of burgers vector [m] for each slip system and instance real(pReal), dimension(:,:), allocatable :: & + slip_normal, & + slip_direction, & + slip_transverse, & minDipoleHeight, & ! edge and screw peierlsstress, & ! edge and screw interactionSlipSlip ,& !< coefficients for slip-slip interaction for each interaction type and instance @@ -244,28 +239,18 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine plastic_nonlocal_init(fileUnit) +subroutine plastic_nonlocal_init use prec, only: dEq use math, only: math_Voigt66to3333, & math_mul3x3, & math_expand -use IO, only: IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_EOF +use IO, only: IO_error + use debug, only: debug_level, & debug_constitutive, & debug_levelBasic use mesh, only: theMesh use material, only: phase_plasticity, & - homogenization_maxNgrains, & phase_plasticityInstance, & phase_Noutput, & PLASTICITY_NONLOCAL_label, & @@ -279,30 +264,24 @@ use lattice implicit none -integer(pInt), intent(in) :: fileUnit character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] !*** local variables -integer(pInt), allocatable, dimension(:) :: chunkPos -integer(pInt) :: phase, & +integer(pInt) :: ns, phase, & maxNinstances, & maxTotalNslip, p, i, & f, & ! index of my slip family instance, & ! index of my instance of this plasticity l, & - ns, & ! short notation for total number of active slip systems for the current instance o, & ! index of my output s, & ! index of my slip system s1, & ! index of my slip system s2, & ! index of my slip system t, & ! index of dislocation type - c, & ! index of dislocation character - Nchunks_SlipFamilies - character(len=65536) :: & - tag = '', & - line = '' + c ! index of dislocation character + integer(pInt) :: sizeState, sizeDotState,sizeDependentState, sizeDeltaState integer(kind(undefined_ID)) :: & @@ -337,80 +316,16 @@ allocate(Nslip(lattice_maxNslipFamily,maxNinstances), source=0_pInt) allocate(slipFamily(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(totalNslip(maxNinstances), source=0_pInt) -allocate(rhoSglScatter(maxNinstances), source=0.0_pReal) -allocate(rhoSglRandom(maxNinstances), source=0.0_pReal) -allocate(rhoSglRandomBinning(maxNinstances), source=1.0_pReal) - -allocate(lambda0PerSlipFamily(lattice_maxNslipFamily,maxNinstances), source=0.0_pReal) - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through phases of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase - phase = phase + 1_pInt ! advance phase section counter - if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) & - Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) - cycle - endif - if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then ! one of my phases. do not short-circuit here (.and. with next if statement). It's not safe in Fortran - instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('nslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_LABEL//')') - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt - do f = 1_pInt, Nchunks_SlipFamilies - Nslip(f,instance) = IO_intValue(line,chunkPos,1_pInt+f) - enddo - case ('lambda0') - do f = 1_pInt, Nchunks_SlipFamilies - lambda0PerSlipFamily(f,instance) = IO_floatValue(line,chunkPos,1_pInt+f) - enddo - case('rhosglscatter') - rhoSglScatter(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('rhosglrandom') - rhoSglRandom(instance) = IO_floatValue(line,chunkPos,2_pInt) - case('rhosglrandombinning') - rhoSglRandomBinning(instance) = IO_floatValue(line,chunkPos,2_pInt) - end select - endif; endif - enddo parsingFile - - sanityChecks: do phase = 1_pInt, size(phase_plasticity) - myPhase: if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then - instance = phase_plasticityInstance(phase) - if (sum(Nslip(:,instance)) <= 0_pInt) & - call IO_error(211_pInt,ext_msg='Nslip ('//PLASTICITY_NONLOCAL_label//')') - do f = 1_pInt,lattice_maxNslipFamily - if (Nslip(f,instance) > 0_pInt) then - if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') - endif - enddo - if (rhoSglScatter(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglRandom(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglRandom ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglRandomBinning(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') - - totalNslip(instance) = sum(Nslip(1:lattice_maxNslipFamily,instance)) - endif myPhase -enddo sanityChecks - + do p=1_pInt, size(config_phase) + if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle + instance = phase_plasticityInstance(p) + param(instance)%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyInt) + Nslip(1:size(param(instance)%Nslip),instance) = param(instance)%Nslip + totalNslip(instance) = sum(Nslip(1:lattice_maxNslipFamily,instance)) + enddo + !*** allocation of variables whose size depends on the total number of active slip systems @@ -426,8 +341,6 @@ allocate(iRhoF(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iTauF(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) -allocate(lambda0(maxTotalNslip,maxNinstances), source=0.0_pReal) - allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) @@ -551,10 +464,6 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), do s1 = 1_pInt,ns f = slipFamily(s1,instance) - - !*** burgers vector, mean free path prefactor and minimum dipole distance for each slip system - - lambda0(s1,instance) = lambda0PerSlipFamily(f,instance) do s2 = 1_pInt,ns @@ -588,7 +497,7 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), param(instance)%shortRangeStressCorrection = .false. - prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyInt) + prm%totalNslip = sum(prm%Nslip) prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& config%getFloat('c/a',defaultVal=0.0_pReal)) @@ -661,6 +570,13 @@ param(instance)%shortRangeStressCorrection = .false. prm%q = config_phase(p)%getFloat('q') + prm%slip_direction = lattice_slip_direction(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + + prm%slip_normal = lattice_slip_normal(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) prm%minDipoleHeight_edge = math_expand(prm%minDipoleHeight_edge,prm%Nslip) prm%minDipoleHeight_screw = math_expand(prm%minDipoleHeight_screw,prm%Nslip) allocate(prm%minDipoleHeight(prm%totalNslip,2)) @@ -726,7 +642,12 @@ extmsg = trim(extmsg)//' surfaceTransmissivity' ! if (peierlsStressPerSlipFamily(f,2,instance) <= 0.0_pReal) & ! call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') - +! do f = 1_pInt,lattice_maxNslipFamily +! if (Nslip(f,instance) > 0_pInt) then +! if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') +! endif +! enddo ! if (rhoSglEdgePos0(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,ext_msg='rhoSglEdgePos0 ('//PLASTICITY_NONLOCAL_label//')') ! if (rhoSglEdgeNeg0(f,instance) < 0.0_pReal) & @@ -739,6 +660,14 @@ extmsg = trim(extmsg)//' surfaceTransmissivity' ! call IO_error(211_pInt,ext_msg='rhoDipEdge0 ('//PLASTICITY_NONLOCAL_label//')') ! if (rhoDipScrew0(f,instance) < 0.0_pReal) & ! call IO_error(211_pInt,ext_msg='rhoDipScrew0 ('//PLASTICITY_NONLOCAL_label//')') +! if (rhoSglScatter(instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') +! if (rhoSglRandom(instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoSglRandom ('//PLASTICITY_NONLOCAL_label//')') +! if (rhoSglRandomBinning(instance) <= 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') + + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) @@ -1052,11 +981,9 @@ use material, only: & phaseAt, phasememberAt, & phase_plasticityInstance use lattice, only: & - lattice_sd, & - lattice_st, & - lattice_structure, & LATTICE_bcc_ID, & - LATTICE_fcc_ID + LATTICE_fcc_ID, & + lattice_structure implicit none @@ -1072,13 +999,10 @@ real(pReal), dimension(3,3), intent(in) :: & np, & !< neighbor phase no !< nieghbor offset -integer(pInt) neighbor_el, & ! element number of neighboring material point +integer(pInt) ns, neighbor_el, & ! element number of neighboring material point neighbor_ip, & ! integration point of neighboring material point instance, & ! my instance of this plasticity neighbor_instance, & ! instance of this plasticity of neighboring material point - neighbor_phase, & - ns, & ! total number of active slip systems at my material point - neighbor_ns, & ! total number of active slip systems at neighboring material point c, & ! index of dilsocation character (edge, screw) s, & ! slip system index t, & ! index of dilsocation type (e+, e-, s+, s-, used e+, used e-, used s+, used s-) @@ -1243,8 +1167,8 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then !* 1. interpolation of the excess density in the neighorhood !* 2. interpolation of the dead dislocation density in the central volume - m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),ph) - m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),ph) + m(1:3,1:ns,1) = prm%slip_direction + m(1:3,1:ns,2) = -prm%slip_transverse do s = 1_pInt,ns @@ -1656,8 +1580,7 @@ integer(pInt) ::instance, & ! current instance of this plasticity ns, & ! short notation for the total number of active slip systems c, & ! character of dislocation t, & ! type of dislocation - s, & ! index of my current slip system - sLattice ! index of my current slip system according to lattice order + s ! index of my current slip system real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & deltaRho, & ! density increment deltaRhoRemobilization, & ! density increment by remobilization @@ -1841,9 +1764,7 @@ use material, only: homogenization_maxNgrains, & phaseAt, phasememberAt, & phase_plasticity ,& PLASTICITY_NONLOCAL_ID -use lattice, only: lattice_sd, & - lattice_st ,& - lattice_structure, & +use lattice, only: lattice_structure, & LATTICE_bcc_ID, & LATTICE_fcc_ID @@ -1894,7 +1815,6 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) rhoSglOriginal, & neighbor_rhoSgl, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles) - rhoSgl0, & !< single dislocation densities at start of cryst inc (positive/negative screw and edge without dipoles) my_rhoSgl !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),4) :: & v, & !< current dislocation glide velocity @@ -1906,8 +1826,8 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt tauThreshold, & !< threshold shear stress tau, & !< current resolved shear stress tauBack, & !< current back stress from pileups on same slip system - vClimb, & !< climb velocity of edge dipoles - nSources + vClimb !< climb velocity of edge dipoles + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) rhoDipOriginal, & @@ -1927,9 +1847,8 @@ real(pReal), dimension(3) :: normal_neighbor2me, & real(pReal) area, & !< area of the current interface transmissivity, & !< overall transmissivity of dislocation flux to neighboring material point lineLength, & !< dislocation line length leaving the current interface - selfDiffusion, & !< self diffusion - rnd, & - meshlength + selfDiffusion !< self diffusion + logical considerEnteringFlux, & considerLeavingFlux @@ -2033,17 +1952,17 @@ rhoDotMultiplication = 0.0_pReal if (lattice_structure(ph) == LATTICE_bcc_ID) then ! BCC forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / prm%burgers(s) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path + * sqrt(rhoForest(s)) / prm%lambda0(s) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) /prm%burgers(s) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path + * sqrt(rhoForest(s)) / prm%lambda0(s) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation endforall else ! ALL OTHER STRUCTURES rhoDotMultiplication(1:ns,1:4) = spread( & (sum(abs(gdot(1:ns,1:2)),2) * prm%fEdgeMultiplication + sum(abs(gdot(1:ns,3:4)),2)) & - * sqrt(rhoForest(1:ns)) / lambda0(1:ns,instance) / prm%burgers(1:ns), 2, 4) + * sqrt(rhoForest(1:ns)) / prm%lambda0 / prm%burgers(1:ns), 2, 4) endif @@ -2079,10 +1998,10 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then !*** be aware of the definition of lattice_st = lattice_sd x lattice_sn !!! !*** opposite sign to our p vector in the (s,p,n) triplet !!! - m(1:3,1:ns,1) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph) - m(1:3,1:ns,2) = -lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph) - m(1:3,1:ns,3) = -lattice_st(1:3, slipSystemLattice(1:ns,instance), ph) - m(1:3,1:ns,4) = lattice_st(1:3, slipSystemLattice(1:ns,instance), ph) + m(1:3,1:ns,1) = prm%slip_direction + m(1:3,1:ns,2) = -prm%slip_direction + m(1:3,1:ns,3) = -prm%slip_transverse + m(1:3,1:ns,4) = prm%slip_transverse my_Fe = Fe(1:3,1:3,1_pInt,ip,el) my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,1_pInt,ip,el)) @@ -2293,7 +2212,6 @@ rhoDot = rhoDotFlux & + rhoDotThermalAnnihilation results(instance)%rhoDotFlux(1:ns,1:8,o) = rhoDotFlux(1:ns,1:8) - results(instance)%rhoDotMultiplication(1:ns,1:2,o) = rhoDotMultiplication(1:ns,[1,3]) results(instance)%rhoDotSingle2DipoleGlide(1:ns,1:2,o) = rhoDotSingle2DipoleGlide(1:ns,9:10) results(instance)%rhoDotAthermalAnnihilation(1:ns,1:2,o) = rhoDotAthermalAnnihilation(1:ns,9:10) @@ -2368,9 +2286,7 @@ use material, only: material_phase, & homogenization_maxNgrains use mesh, only: mesh_ipNeighborhood, & theMesh -use lattice, only: lattice_sn, & - lattice_sd, & - lattice_qDisorientation +use lattice, only: lattice_qDisorientation implicit none @@ -2397,11 +2313,8 @@ real(pReal), dimension(4) :: absoluteMisorientation real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& theMesh%elem%nIPneighbors) :: & - my_compatibility ! my_compatibility for current element and ip -real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & - slipNormal, & - slipDirection -real(pReal) my_compatibilitySum, & + my_compatibility ! my_compatibility for current element and ip +real(pReal) :: my_compatibilitySum, & thresholdValue, & nThresholdValues logical, dimension(totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & @@ -2413,8 +2326,6 @@ ph = material_phase(1,i,e) textureID = material_texture(1,i,e) instance = phase_plasticityInstance(ph) ns = totalNslip(instance) -slipNormal(1:3,1:ns) = lattice_sn(1:3, slipSystemLattice(1:ns,instance), ph) -slipDirection(1:3,1:ns) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph) associate(prm => param(instance)) !*** start out fully compatible @@ -2480,10 +2391,14 @@ neighbors: do n = 1_pInt,Nneighbors orientation(1:4,1,neighbor_i,neighbor_e)) ! no symmetry mySlipSystems: do s1 = 1_pInt,ns neighborSlipSystems: do s2 = 1_pInt,ns - my_compatibility(1,s2,s1,n) = math_mul3x3(slipNormal(1:3,s1), math_qRot(absoluteMisorientation, slipNormal(1:3,s2))) & - * abs(math_mul3x3(slipDirection(1:3,s1), math_qRot(absoluteMisorientation, slipDirection(1:3,s2)))) - my_compatibility(2,s2,s1,n) = abs(math_mul3x3(slipNormal(1:3,s1), math_qRot(absoluteMisorientation, slipNormal(1:3,s2)))) & - * abs(math_mul3x3(slipDirection(1:3,s1), math_qRot(absoluteMisorientation, slipDirection(1:3,s2)))) + my_compatibility(1,s2,s1,n) = math_mul3x3(prm%slip_normal(1:3,s1), & + math_qRot(absoluteMisorientation, prm%slip_normal(1:3,s2))) & + * abs(math_mul3x3(prm%slip_direction(1:3,s1), & + math_qRot(absoluteMisorientation, prm%slip_direction(1:3,s2)))) + my_compatibility(2,s2,s1,n) = abs(math_mul3x3(prm%slip_normal(1:3,s1), & + math_qRot(absoluteMisorientation, prm%slip_normal(1:3,s2)))) & + * abs(math_mul3x3(prm%slip_direction(1:3,s1), & + math_qRot(absoluteMisorientation, prm%slip_direction(1:3,s2)))) enddo neighborSlipSystems my_compatibilitySum = 0.0_pReal @@ -2522,8 +2437,6 @@ function plastic_nonlocal_postResults(Mp,ip,el) result(postResults) math_mul33x3, & math_mul33xx33, & pi - use mesh, only: & - theMesh use material, only: & material_phase, & phaseAt, phasememberAt, & From 3fa699ad2200e1e6d57bdd94c8d7558e454a9757 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 20 Feb 2019 20:17:55 +0100 Subject: [PATCH 268/309] indices were mixed up --- src/lattice.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 7ec4c5470..c3cb9d489 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -2228,7 +2228,7 @@ function lattice_slip_normal(Nslip,structure,cOverA) result(n) real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) - n = coordinateSystem(1:3,1,1:sum(Nslip)) + n = coordinateSystem(1:3,2,1:sum(Nslip)) end function lattice_slip_normal @@ -2248,7 +2248,7 @@ function lattice_slip_direction(Nslip,structure,cOverA) result(d) real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) - d = coordinateSystem(1:3,2,1:sum(Nslip)) + d = coordinateSystem(1:3,1,1:sum(Nslip)) end function lattice_slip_direction From cb2d2b02dcaec30554ead5e11c37077478764021 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Feb 2019 00:24:35 +0100 Subject: [PATCH 269/309] re-ordered and cleaned --- src/math.f90 | 5 + src/plastic_nonlocal.f90 | 797 +++++++++++++++++++-------------------- 2 files changed, 397 insertions(+), 405 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index a6339d9c1..1fff21016 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -70,6 +70,10 @@ module math !-------------------------------------------------------------------------------------------------- ! Provide deprecated names for compatibility + interface math_cross + module procedure math_crossproduct + end interface math_cross + ! ToDo MD: Our naming scheme was a little bit odd: We use essentially the re-ordering according to Nye ! (convenient because Abaqus and Marc want to have 12 on position 4) ! but weight the shear components according to Mandel (convenient for matrix multiplications) @@ -119,6 +123,7 @@ module math math_identity4th, & math_civita, & math_delta, & + math_cross, & math_crossproduct, & math_tensorproduct33, & math_mul3x3, & diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 85800f7d7..1ef0a22c7 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -240,107 +240,400 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_init -use prec, only: dEq -use math, only: math_Voigt66to3333, & - math_mul3x3, & - math_expand -use IO, only: IO_error + use prec, only: & + dEq0, dNeq0, dEq + use math, only: & + math_expand, math_cross + use IO, only: & + IO_error + use debug, only: & + debug_level, & + debug_constitutive, & + debug_levelBasic + use mesh, only: & + theMesh + use material, only: & + phase_plasticity, & + phase_plasticityInstance, & + phase_Noutput, & + PLASTICITY_NONLOCAL_label, & + PLASTICITY_NONLOCAL_ID, & + plasticState, & + material_phase, & + material_allocatePlasticState + use config + use lattice -use debug, only: debug_level, & - debug_constitutive, & - debug_levelBasic -use mesh, only: theMesh -use material, only: phase_plasticity, & - phase_plasticityInstance, & - phase_Noutput, & - PLASTICITY_NONLOCAL_label, & - PLASTICITY_NONLOCAL_ID, & - plasticState, & - material_phase, & - material_allocatePlasticState -use config -use lattice + implicit none + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] + integer(pInt) :: & + ns, phase, & + maxNinstances, & + maxTotalNslip, p, i, & + f, & ! index of my slip family + instance, & ! index of my instance of this plasticity + l, & + o, & ! index of my output + s, & ! index of my slip system + s1, & ! index of my slip system + s2, & ! index of my slip system + t, & ! index of dislocation type + c ! index of dislocation character - -implicit none - - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] - real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] -!*** local variables -integer(pInt) :: ns, phase, & - maxNinstances, & - maxTotalNslip, p, i, & - f, & ! index of my slip family - instance, & ! index of my instance of this plasticity - l, & - o, & ! index of my output - s, & ! index of my slip system - s1, & ! index of my slip system - s2, & ! index of my slip system - t, & ! index of dislocation type - c ! index of dislocation character - - - integer(pInt) :: sizeState, sizeDotState,sizeDependentState, sizeDeltaState - integer(kind(undefined_ID)) :: & - outputID !< ID of each post result output - character(len=512) :: & - extmsg = '', & - structure - character(len=65536), dimension(:), allocatable :: outputs - - integer(pInt) :: NofMyPhase + integer(pInt) :: sizeState, sizeDotState,sizeDependentState, sizeDeltaState + integer(kind(undefined_ID)) :: & + outputID + character(len=512) :: & + extmsg = '', & + structure + character(len=65536), dimension(:), allocatable :: outputs + integer(pInt) :: NofMyPhase - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_label//' init -+>>>' + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_label//' init -+>>>' maxNinstances = int(count(phase_plasticity == PLASTICITY_NONLOCAL_ID),pInt) - if (maxNinstances == 0) return ! we don't have to do anything if there's no instance for this constitutive law + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances -!*** memory allocation for global variables -allocate(param(maxNinstances)) -allocate(state(maxNinstances)) -allocate(dotState(maxNinstances)) -allocate(deltaState(maxNinstances)) -allocate(results(maxNinstances)) + allocate(param(maxNinstances)) + allocate(state(maxNinstances)) + allocate(dotState(maxNinstances)) + allocate(deltaState(maxNinstances)) + allocate(results(maxNinstances)) -allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0_pInt) -allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) - plastic_nonlocal_output = '' -allocate(plastic_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID) -allocate(Nslip(lattice_maxNslipFamily,maxNinstances), source=0_pInt) -allocate(slipFamily(lattice_maxNslip,maxNinstances), source=0_pInt) -allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) -allocate(totalNslip(maxNinstances), source=0_pInt) + allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0_pInt) + allocate(plastic_nonlocal_output(maxval(phase_Noutput), maxNinstances)) + plastic_nonlocal_output = '' + allocate(plastic_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID) + allocate(Nslip(lattice_maxNslipFamily,maxNinstances), source=0_pInt) + allocate(slipFamily(lattice_maxNslip,maxNinstances), source=0_pInt) + allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) + allocate(totalNslip(maxNinstances), source=0_pInt) do p=1_pInt, size(config_phase) - if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle - instance = phase_plasticityInstance(p) - param(instance)%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyInt) - Nslip(1:size(param(instance)%Nslip),instance) = param(instance)%Nslip - totalNslip(instance) = sum(Nslip(1:lattice_maxNslipFamily,instance)) - enddo + if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle + associate(prm => param(phase_plasticityInstance(p)), & + dot => dotState(phase_plasticityInstance(p)), & + stt => state(phase_plasticityInstance(p)), & + del => deltaState(phase_plasticityInstance(p)), & + res => results(phase_plasticityInstance(p)), & + config => config_phase(p)) + + prm%aTolRho = config%getFloat('atol_rho', defaultVal=0.0_pReal) + prm%aTolShear = config%getFloat('atol_shear', defaultVal=0.0_pReal) + + structure = config%getString('lattice_structure') + + ! This data is read in already in lattice + prm%mu = lattice_mu(p) + prm%nu = lattice_nu(p) + + + prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) + prm%totalNslip = sum(prm%Nslip) + slipActive: if (prm%totalNslip > 0_pInt) then + prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + + if(trim(config%getString('lattice_structure')) == 'bcc') then + prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray) + prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) + prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) + else + prm%nonSchmid_pos = prm%Schmid + prm%nonSchmid_neg = prm%Schmid + endif + + prm%interactionSlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & + config%getFloats('interaction_slipslip'), & + config%getString('lattice_structure')) + + prm%forestProjection_edge = lattice_forestProjection_edge (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%forestProjection_screw = lattice_forestProjection_screw(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + + prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + + ! collinear systems (only for octahedral slip systems in fcc) + allocate(prm%colinearSystem(prm%totalNslip)) + do s1 = 1_pInt, prm%totalNslip + do s2 = 1_pInt, prm%totalNslip + if (all(dEq0 (math_cross(prm%slip_direction(1:3,s1),prm%slip_direction(1:3,s2)))) .and. & + all(dNeq0(math_cross(prm%slip_normal (1:3,s1),prm%slip_normal (1:3,s2))))) & + prm%colinearSystem(s1) = s2 + enddo + enddo + + prm%rhoSglEdgePos0 = config%getFloats('rhosgledgepos0', requiredSize=size(prm%Nslip)) + prm%rhoSglEdgeNeg0 = config%getFloats('rhosgledgeneg0', requiredSize=size(prm%Nslip)) + prm%rhoSglScrewPos0 = config%getFloats('rhosglscrewpos0', requiredSize=size(prm%Nslip)) + prm%rhoSglScrewNeg0 = config%getFloats('rhosglscrewneg0', requiredSize=size(prm%Nslip)) + prm%rhoDipEdge0 = config%getFloats('rhodipedge0', requiredSize=size(prm%Nslip)) + prm%rhoDipScrew0 = config%getFloats('rhodipscrew0', requiredSize=size(prm%Nslip)) + + prm%lambda0 = config%getFloats('lambda0', requiredSize=size(prm%Nslip)) + prm%burgers = config%getFloats('burgers', requiredSize=size(prm%Nslip)) + + prm%lambda0 = math_expand(prm%lambda0,prm%Nslip) + prm%burgers = math_expand(prm%burgers,prm%Nslip) + + prm%minDipoleHeight_edge = config%getFloats('minimumdipoleheightedge', requiredSize=size(prm%Nslip)) + prm%minDipoleHeight_screw = config%getFloats('minimumdipoleheightscrew', requiredSize=size(prm%Nslip)) + prm%minDipoleHeight_edge = math_expand(prm%minDipoleHeight_edge,prm%Nslip) + prm%minDipoleHeight_screw = math_expand(prm%minDipoleHeight_screw,prm%Nslip) + allocate(prm%minDipoleHeight(prm%totalNslip,2)) + prm%minDipoleHeight(:,1) = prm%minDipoleHeight_edge + prm%minDipoleHeight(:,2) = prm%minDipoleHeight_screw + + prm%peierlsstress_edge = config%getFloats('peierlsstressedge', requiredSize=size(prm%Nslip)) + prm%peierlsstress_screw = config%getFloats('peierlsstressscrew', requiredSize=size(prm%Nslip)) + prm%peierlsstress_edge = math_expand(prm%peierlsstress_edge,prm%Nslip) + prm%peierlsstress_screw = math_expand(prm%peierlsstress_screw,prm%Nslip) + allocate(prm%peierlsstress(prm%totalNslip,2)) + prm%peierlsstress(:,1) = prm%peierlsstress_edge + prm%peierlsstress(:,2) = prm%peierlsstress_screw + + prm%significantRho = config%getFloat('significantrho') + prm%significantN = config%getFloat('significantn', 0.0_pReal) + prm%CFLfactor = config%getFloat('cflfactor',defaultVal=2.0_pReal) + + prm%atomicVolume = config%getFloat('atomicvolume') + prm%Dsd0 = config%getFloat('selfdiffusionprefactor') !,'dsd0') + prm%selfDiffusionEnergy = config%getFloat('selfdiffusionenergy') !,'qsd') + prm%linetensionEffect = config%getFloat('linetension') + prm%edgeJogFactor = config%getFloat('edgejog')!,'edgejogs' + prm%doublekinkwidth = config%getFloat('doublekinkwidth') + prm%solidSolutionEnergy = config%getFloat('solidsolutionenergy') + prm%solidSolutionSize = config%getFloat('solidsolutionsize') + prm%solidSolutionConcentration = config%getFloat('solidsolutionconcentration') + + prm%p = config%getFloat('p') + prm%q = config%getFloat('q') + prm%viscosity = config%getFloat('viscosity') + prm%fattack = config%getFloat('attackfrequency') + + prm%rhoSglScatter = config%getFloat('rhosglscatter') + prm%rhoSglRandom = config%getFloat('rhosglrandom',0.0_pReal) + if (config%keyExists('rhosglrandom')) & + prm%rhoSglRandomBinning = config%getFloat('rhosglrandombinning',0.0_pReal) !ToDo: useful default? + + prm%surfaceTransmissivity = config%getFloat('surfacetransmissivity',defaultVal=1.0_pReal) + prm%grainboundaryTransmissivity = config%getFloat('grainboundarytransmissivity',defaultVal=-1.0_pReal) + prm%fEdgeMultiplication = config%getFloat('edgemultiplication') + prm%shortRangeStressCorrection = config%getInt('shortrangestresscorrection',defaultVal=0_pInt ) > 0_pInt ! ToDo: use /flag/ type key + +!-------------------------------------------------------------------------------------------------- +! sanity checks + if (any(prm%burgers < 0.0_pReal)) extmsg = trim(extmsg)//' burgers' + if (any(prm%rhoSglEdgePos0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglEdgePos0' + if (any(prm%rhoSglEdgeNeg0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglEdgeNeg0' + if (any(prm%rhoSglScrewPos0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglScrewPos0' + if (any(prm%rhoSglScrewNeg0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglScrewNeg0' + if (any(prm%rhoDipEdge0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoDipEdge0' + if (any(prm%rhoDipScrew0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoDipScrew0' + if (any(prm%peierlsstress < 0.0_pReal)) extmsg = trim(extmsg)//' peierlsstress' + if (any(prm%minDipoleHeight < 0.0_pReal)) extmsg = trim(extmsg)//' minDipoleHeight' + + if (prm%viscosity <= 0.0_pReal) extmsg = trim(extmsg)//' viscosity' + if (prm%selfDiffusionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' selfDiffusionEnergy' + if (prm%fattack <= 0.0_pReal) extmsg = trim(extmsg)//' fattack' + if (prm%doublekinkwidth <= 0.0_pReal) extmsg = trim(extmsg)//' doublekinkwidth' + if (prm%Dsd0 < 0.0_pReal) extmsg = trim(extmsg)//' Dsd0' + + if (prm%significantN < 0.0_pReal) extmsg = trim(extmsg)//' significantN' + if (prm%significantrho < 0.0_pReal) extmsg = trim(extmsg)//' significantrho' + if (prm%atolshear <= 0.0_pReal) extmsg = trim(extmsg)//' atolshear' + if (prm%atolrho <= 0.0_pReal) extmsg = trim(extmsg)//' atolrho' + if (prm%CFLfactor < 0.0_pReal) extmsg = trim(extmsg)//' CFLfactor' + + if (prm%p <= 0.0_pReal .or. prm%p > 1.0_pReal) extmsg = trim(extmsg)//' p' + if (prm%q < 1.0_pReal .or. prm%q > 2.0_pReal) extmsg = trim(extmsg)//' q' + + if (prm%linetensionEffect < 0.0_pReal .or. prm%linetensionEffect > 1.0_pReal) & + extmsg = trim(extmsg)//' edgeJogFactor' + if (prm%edgeJogFactor < 0.0_pReal .or. prm%edgeJogFactor > 1.0_pReal) & + extmsg = trim(extmsg)//' edgeJogFactor' + + if (prm%solidSolutionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionEnergy' + if (prm%solidSolutionSize <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionSize' + if (prm%solidSolutionConcentration <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionConcentration' + + + + if (prm%grainboundaryTransmissivity > 1.0_pReal) extmsg = trim(extmsg)//' grainboundaryTransmissivity' + if (prm%surfaceTransmissivity < 0.0_pReal .or. prm%surfaceTransmissivity > 1.0_pReal) & + extmsg = trim(extmsg)//' surfaceTransmissivity' + if (prm%fEdgeMultiplication < 0.0_pReal .or. prm%fEdgeMultiplication > 1.0_pReal) & +extmsg = trim(extmsg)//' fEdgeMultiplication' -!*** allocation of variables whose size depends on the total number of active slip systems -maxTotalNslip = maxval(totalNslip) + ! if (atomicVolume(instance) <= 0.0_pReal) & -allocate(iRhoU(maxTotalNslip,4,maxNinstances), source=0_pInt) -allocate(iRhoB(maxTotalNslip,4,maxNinstances), source=0_pInt) -allocate(iRhoD(maxTotalNslip,2,maxNinstances), source=0_pInt) -allocate(iV(maxTotalNslip,4,maxNinstances), source=0_pInt) -allocate(iD(maxTotalNslip,2,maxNinstances), source=0_pInt) -allocate(iGamma(maxTotalNslip,maxNinstances), source=0_pInt) -allocate(iRhoF(maxTotalNslip,maxNinstances), source=0_pInt) -allocate(iTauF(maxTotalNslip,maxNinstances), source=0_pInt) -allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) +! do f = 1_pInt,lattice_maxNslipFamily +! if (Nslip(f,instance) > 0_pInt) then +! if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') +! endif +! enddo +! if (rhoSglScatter(instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') +! if (rhoSglRandom(instance) < 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoSglRandom ('//PLASTICITY_NONLOCAL_label//')') +! if (rhoSglRandomBinning(instance) <= 0.0_pReal) & +! call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') + + endif slipActive + +!-------------------------------------------------------------------------------------------------- +! output pararameters + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(trim(outputs(i))) + case ('rho_sgl_edge_pos_mobile') + outputID = merge(rho_sgl_edge_pos_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_sgl_edge_neg_mobile') + outputID = merge(rho_sgl_edge_neg_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_sgl_screw_pos_mobile') + outputID = merge(rho_sgl_screw_pos_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_sgl_screw_neg_mobile') + outputID = merge(rho_sgl_screw_neg_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_sgl_edge_pos_immobile') + outputID = merge(rho_sgl_edge_pos_immobile_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_sgl_edge_neg_immobile') + outputID = merge(rho_sgl_edge_neg_immobile_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_sgl_screw_pos_immobile') + outputID = merge(rho_sgl_screw_pos_immobile_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_sgl_screw_neg_immobile') + outputID = merge(rho_sgl_screw_neg_immobile_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dip_edge') + outputID = merge(rho_dip_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dip_screw') + outputID = merge(rho_dip_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_forest') + outputID = merge(rho_forest_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('shearrate') + outputID = merge(shearrate_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('resolvedstress') + outputID = merge(resolvedstress_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('resolvedstress_external') + outputID = merge(resolvedstress_external_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('resolvedstress_back') + outputID = merge(resolvedstress_back_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('resistance') + outputID = merge(resistance_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_sgl') + outputID = merge(rho_dot_sgl_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_sgl_mobile') + outputID = merge(rho_dot_sgl_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_dip') + outputID = merge(rho_dot_dip_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_gen') + outputID = merge(rho_dot_gen_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_gen_edge') + outputID = merge(rho_dot_gen_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_gen_screw') + outputID = merge(rho_dot_gen_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_sgl2dip_edge') + outputID = merge(rho_dot_sgl2dip_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_sgl2dip_screw') + outputID = merge(rho_dot_sgl2dip_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_ann_ath') + outputID = merge(rho_dot_ann_ath_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_ann_the_edge') + outputID = merge(rho_dot_ann_the_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_ann_the_screw') + outputID = merge(rho_dot_ann_the_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_edgejogs') + outputID = merge(rho_dot_edgejogs_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_flux_mobile') + outputID = merge(rho_dot_flux_mobile_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_flux_edge') + outputID = merge(rho_dot_flux_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('rho_dot_flux_screw') + outputID = merge(rho_dot_flux_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('velocity_edge_pos') + outputID = merge(velocity_edge_pos_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('velocity_edge_neg') + outputID = merge(velocity_edge_neg_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('velocity_screw_pos') + outputID = merge(velocity_screw_pos_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('velocity_screw_neg') + outputID = merge(velocity_screw_neg_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('maximumdipoleheight_edge') + outputID = merge(maximumdipoleheight_edge_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('maximumdipoleheight_screw') + outputID = merge(maximumdipoleheight_screw_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('accumulatedshear','accumulated_shear') + outputID = merge(accumulatedshear_ID,undefined_ID,prm%totalNslip>0_pInt) + end select + + if (outputID /= undefined_ID) then + plastic_nonlocal_output(i,phase_plasticityInstance(p)) = outputs(i) + plastic_nonlocal_sizePostResult(i,phase_plasticityInstance(p)) = prm%totalNslip + prm%outputID = [prm%outputID , outputID] + endif + + enddo + +!-------------------------------------------------------------------------------------------------- +! allocate state arrays + NofMyPhase=count(material_phase==p) + sizeDotState = int(size([ 'rhoSglEdgePosMobile ','rhoSglEdgeNegMobile ', & + 'rhoSglScrewPosMobile ','rhoSglScrewNegMobile ', & + 'rhoSglEdgePosImmobile ','rhoSglEdgeNegImmobile ', & + 'rhoSglScrewPosImmobile','rhoSglScrewNegImmobile', & + 'rhoDipEdge ','rhoDipScrew ', & + 'accumulatedshear ' ]),pInt) * prm%totalNslip !< "basic" microstructural state variables that are independent from other state variables + + sizeDependentState = int(size([ 'rhoForest ', 'tauThreshold', & + 'tauBack ' ]),pInt) * prm%totalNslip !< microstructural state variables that depend on other state variables + + sizeState = sizeDotState + sizeDependentState & + + int(size([ 'velocityEdgePos ','velocityEdgeNeg ', & + 'velocityScrewPos ','velocityScrewNeg ', & + 'maxDipoleHeightEdge ','maxDipoleHeightScrew' ]),pInt) * prm%totalNslip !< other dependent state variables that are not updated by microstructure + + sizeDeltaState = sizeDotState + call material_allocatePlasticState(p,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & + prm%totalNslip,0_pInt,0_pInt) + plasticState(p)%nonlocal = .true. + plasticState(p)%offsetDeltaState = 0_pInt ! ToDo: state structure does not follow convention + + Nslip(1:size(prm%Nslip),phase_plasticityInstance(p)) = prm%Nslip ! ToDo: DEPRECATED + totalNslip(phase_plasticityInstance(p)) = sum(Nslip(1:size(prm%Nslip),phase_plasticityInstance(p))) ! ToDo: DEPRECATED + + end associate + + enddo + +! BEGIN DEPRECATED---------------------------------------------------------------------------------- + maxTotalNslip = maxval(totalNslip) + allocate(iRhoU(maxTotalNslip,4,maxNinstances), source=0_pInt) + allocate(iRhoB(maxTotalNslip,4,maxNinstances), source=0_pInt) + allocate(iRhoD(maxTotalNslip,2,maxNinstances), source=0_pInt) + allocate(iV(maxTotalNslip,4,maxNinstances), source=0_pInt) + allocate(iD(maxTotalNslip,2,maxNinstances), source=0_pInt) + allocate(iGamma(maxTotalNslip,maxNinstances), source=0_pInt) + allocate(iRhoF(maxTotalNslip,maxNinstances), source=0_pInt) + allocate(iTauF(maxTotalNslip,maxNinstances), source=0_pInt) + allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) +! END DEPRECATED------------------------------------------------------------------------------------ allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) @@ -350,40 +643,8 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), NofMyPhase=count(material_phase==phase) myPhase2: if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then instance = phase_plasticityInstance(phase) - - - !*** determine size of state array - - ns = totalNslip(instance) +ns = param(instance)%totalNslip - sizeDotState = int(size(& - ['rhoSglEdgePosMobile ', & - 'rhoSglEdgeNegMobile ', & - 'rhoSglScrewPosMobile ', & - 'rhoSglScrewNegMobile ', & - 'rhoSglEdgePosImmobile ', & - 'rhoSglEdgeNegImmobile ', & - 'rhoSglScrewPosImmobile', & - 'rhoSglScrewNegImmobile', & - 'rhoDipEdge ', & - 'rhoDipScrew ', & - 'accumulatedshear ' ] & !< list of "basic" microstructural state variables that are independent from other state variables - &),pInt) * ns - sizeDependentState = int(size(& - ['rhoForest ', & - 'tauThreshold ', & - 'tauBack ' ]& !< list of microstructural state variables that depend on other state variables - &),pInt) * ns - sizeState = sizeDotState + sizeDependentState & - + int(size(& - ['velocityEdgePos ', & - 'velocityEdgeNeg ', & - 'velocityScrewPos ', & - 'velocityScrewNeg ', & - 'maxDipoleHeightEdge ', & - 'maxDipoleHeightScrew' ] & !< list of other dependent state variables that are not updated by microstructure - &),pInt) * ns - sizeDeltaState = sizeDotState !*** determine indices to state array @@ -434,17 +695,10 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), iD(s,c,instance) = l enddo enddo - if (iD(ns,2,instance) /= sizeState) & ! check if last index is equal to size of state + if (iD(ns,2,instance) /= plasticState(phase)%sizeState) & ! check if last index is equal to size of state call IO_error(0_pInt, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') - - plasticState(phase)%nonlocal = .true. - call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & - totalNslip(instance),0_pInt,0_pInt) - - plasticState(phase)%offsetDeltaState = 0_pInt - plasticState(phase)%slipRate => & plasticState(phase)%dotState(iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) plasticState(phase)%accumulatedSlip => & @@ -485,280 +739,13 @@ allocate(colinearSystem(maxTotalNslip,maxNinstances), do p=1_pInt, size(config_phase) if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle instance = phase_plasticityInstance(p) - associate(prm => param(instance), & - dot => dotState(instance), & - stt => state(instance), & - del => deltaState(instance), & - config => config_phase(p)) - NofMyPhase=count(material_phase==p) - prm%mu = lattice_mu(p) - prm%nu = lattice_nu(p) - structure = config_phase(p)%getString('lattice_structure') - -param(instance)%shortRangeStressCorrection = .false. - - - prm%totalNslip = sum(prm%Nslip) - prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - if(structure=='bcc') then - prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& - defaultVal = emptyRealArray) - prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) - prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) - else - prm%nonSchmid_pos = prm%Schmid - prm%nonSchmid_neg = prm%Schmid - endif - prm%interactionSlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & - config%getFloats('interaction_slipslip'), & - structure(1:3)) - - - - prm%rhoSglEdgePos0 = config_phase(p)%getFloats('rhosgledgepos0') - prm%rhoSglEdgeNeg0 = config_phase(p)%getFloats('rhosgledgeneg0') - prm%rhoSglScrewPos0 = config_phase(p)%getFloats('rhosglscrewpos0') - prm%rhoSglScrewNeg0 = config_phase(p)%getFloats('rhosglscrewneg0') - - prm%rhoDipEdge0 = config_phase(p)%getFloats('rhodipedge0') - prm%rhoDipScrew0 = config_phase(p)%getFloats('rhodipscrew0') - prm%lambda0 = config_phase(p)%getFloats('lambda0') - - if(size(prm%lambda0)/= size(prm%Nslip)) call IO_error(211_pInt,ext_msg='lambda0') - prm%lambda0 = math_expand(prm%lambda0,prm%Nslip) - - - prm%burgers = config_phase(p)%getFloats('burgers', requiredSize=size(prm%Nslip)) - - - prm%burgers = math_expand(prm%burgers,prm%Nslip) - prm%forestProjection_edge = lattice_forestProjection_edge (prm%Nslip,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%forestProjection_screw = lattice_forestProjection_screw (prm%Nslip,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - - prm%minDipoleHeight_edge = config_phase(p)%getFloats('minimumdipoleheightedge')!,'ddipminedge') - prm%minDipoleHeight_screw = config_phase(p)%getFloats('minimumdipoleheightscrew')!,'ddipminscrew') - - prm%peierlsstress_edge = config_phase(p)%getFloats('peierlsstressedge')!,'peierlsstress_edge') - prm%peierlsstress_screw = config_phase(p)%getFloats('peierlsstressscrew')!,'peierlsstress_screw') - - prm%atomicVolume = config_phase(p)%getFloat('atomicvolume') - prm%Dsd0 = config_phase(p)%getFloat('selfdiffusionprefactor') !,'dsd0') - prm%selfDiffusionEnergy = config_phase(p)%getFloat('selfdiffusionenergy') !,'qsd') - - prm%aTolRho = config_phase(p)%getFloat('atol_rho') - prm%aTolShear = config_phase(p)%getFloat('atol_shear') - - - prm%significantRho = config_phase(p)%getFloat('significantrho')!,'significant_rho','significantdensity','significant_density') - prm%significantN = config_phase(p)%getFloat('significantn', 0.0_pReal)!,'significant_n','significantdislocations','significant_dislcations') - - - - prm%linetensionEffect = config_phase(p)%getFloat('linetension')!,'linetensioneffect','linetension_effect') - prm%edgeJogFactor = config_phase(p)%getFloat('edgejog')!,'edgejogs','edgejogeffect','edgejog_effect') - prm%doublekinkwidth = config_phase(p)%getFloat('doublekinkwidth') - - prm%solidSolutionEnergy = config_phase(p)%getFloat('solidsolutionenergy') - prm%solidSolutionSize = config_phase(p)%getFloat('solidsolutionsize') - prm%solidSolutionConcentration = config_phase(p)%getFloat('solidsolutionconcentration') - - - prm%p = config_phase(p)%getFloat('p') - prm%q = config_phase(p)%getFloat('q') - - - prm%slip_direction = lattice_slip_direction(prm%Nslip,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - - prm%slip_normal = lattice_slip_normal(prm%Nslip,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%minDipoleHeight_edge = math_expand(prm%minDipoleHeight_edge,prm%Nslip) - prm%minDipoleHeight_screw = math_expand(prm%minDipoleHeight_screw,prm%Nslip) - allocate(prm%minDipoleHeight(prm%totalNslip,2)) - prm%minDipoleHeight(:,1) = prm%minDipoleHeight_edge - prm%minDipoleHeight(:,2) = prm%minDipoleHeight_screw - - prm%peierlsstress_edge = math_expand(prm%peierlsstress_edge,prm%Nslip) - prm%peierlsstress_screw = math_expand(prm%peierlsstress_screw,prm%Nslip) - allocate(prm%peierlsstress(prm%totalNslip,2)) - prm%peierlsstress(:,1) = prm%peierlsstress_edge - prm%peierlsstress(:,2) = prm%peierlsstress_screw - - prm%viscosity = config_phase(p)%getFloat('viscosity')!,'glideviscosity') - prm%fattack = config_phase(p)%getFloat('attackfrequency')!,'fattack') - - prm%rhoSglScatter = config_phase(p)%getFloat('rhosglscatter') - prm%rhoSglRandom = config_phase(p)%getFloat('rhosglrandom',0.0_pReal) - - if (config_phase(p)%keyExists('rhosglrandom')) & - prm%rhoSglRandomBinning = config_phase(p)%getFloat('rhosglrandombinning',0.0_pReal) !ToDo: useful default? - - - prm%surfaceTransmissivity = config_phase(p)%getFloat('surfacetransmissivity',defaultVal=1.0_pReal) - prm%grainboundaryTransmissivity = config_phase(p)%getFloat('grainboundarytransmissivity',defaultVal=-1.0_pReal) - prm%CFLfactor = config_phase(p)%getFloat('cflfactor',defaultVal=2.0_pReal) - - prm%fEdgeMultiplication = config_phase(p)%getFloat('edgemultiplication')!,'edgemultiplicationfactor','fedgemultiplication') - prm%shortRangeStressCorrection = config_phase(p)%getInt('shortrangestresscorrection' ) > 0_pInt - - ! sanity checks - if ( any(prm%burgers <= 0.0_pReal)) extmsg = trim(extmsg)//' burgers' - if ( prm%viscosity <= 0.0_pReal) extmsg = trim(extmsg)//' viscosity' - if ( prm%significantN < 0.0_pReal) extmsg = trim(extmsg)//' significantN' - if ( prm%significantrho < 0.0_pReal) extmsg = trim(extmsg)//' significantrho' - if ( prm%selfDiffusionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' selfDiffusionEnergy' - if ( prm%fattack <= 0.0_pReal) extmsg = trim(extmsg)//' fattack' - if (prm%edgeJogFactor < 0.0_pReal .or. prm%edgeJogFactor > 1.0_pReal) extmsg = trim(extmsg)//' edgeJogFactor' - if ( prm%solidSolutionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionEnergy' - if ( prm%solidSolutionSize <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionSize' - if ( prm%solidSolutionConcentration <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionConcentration' - if ( prm%CFLfactor < 0.0_pReal) extmsg = trim(extmsg)//' CFLfactor' - if ( prm%doublekinkwidth <= 0.0_pReal) extmsg = trim(extmsg)//' doublekinkwidth' - if ( prm%atolshear <= 0.0_pReal) extmsg = trim(extmsg)//' atolshear' - if ( prm%atolrho <= 0.0_pReal) extmsg = trim(extmsg)//' atolrho' - if (prm%linetensionEffect < 0.0_pReal .or. prm%linetensionEffect > 1.0_pReal) extmsg = trim(extmsg)//' edgeJogFactor' - if (prm%p <= 0.0_pReal .or. prm%p > 1.0_pReal) extmsg = trim(extmsg)//' p' - if (prm%q < 1.0_pReal .or. prm%q > 2.0_pReal) extmsg = trim(extmsg)//' q' - if (prm%surfaceTransmissivity < 0.0_pReal .or. prm%surfaceTransmissivity > 1.0_pReal) & -extmsg = trim(extmsg)//' surfaceTransmissivity' - if (prm%grainboundaryTransmissivity > 1.0_pReal) extmsg = trim(extmsg)//' grainboundaryTransmissivity' - if (prm%fEdgeMultiplication < 0.0_pReal .or. prm%fEdgeMultiplication > 1.0_pReal) & -extmsg = trim(extmsg)//' surfaceTransmissivity' - if ( prm%Dsd0 < 0.0_pReal) extmsg = trim(extmsg)//' Dsd0' - - ! if (atomicVolume(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,ext_msg='atomicVolume ('//PLASTICITY_NONLOCAL_label//')') -! if (minDipoleHeightPerSlipFamily(f,1,instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='minimumDipoleHeightEdge ('//PLASTICITY_NONLOCAL_label//')') -! if (minDipoleHeightPerSlipFamily(f,2,instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='minimumDipoleHeightScrew ('//PLASTICITY_NONLOCAL_label//')') -! if (peierlsStressPerSlipFamily(f,1,instance) <= 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='peierlsStressEdge ('//PLASTICITY_NONLOCAL_label//')') -! if (peierlsStressPerSlipFamily(f,2,instance) <= 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') - -! do f = 1_pInt,lattice_maxNslipFamily -! if (Nslip(f,instance) > 0_pInt) then -! if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') -! endif -! enddo -! if (rhoSglEdgePos0(f,instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoSglEdgePos0 ('//PLASTICITY_NONLOCAL_label//')') -! if (rhoSglEdgeNeg0(f,instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoSglEdgeNeg0 ('//PLASTICITY_NONLOCAL_label//')') -! if (rhoSglScrewPos0(f,instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoSglScrewPos0 ('//PLASTICITY_NONLOCAL_label//')') -! if (rhoSglScrewNeg0(f,instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoSglScrewNeg0 ('//PLASTICITY_NONLOCAL_label//')') -! if (rhoDipEdge0(f,instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoDipEdge0 ('//PLASTICITY_NONLOCAL_label//')') -! if (rhoDipScrew0(f,instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoDipScrew0 ('//PLASTICITY_NONLOCAL_label//')') -! if (rhoSglScatter(instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') -! if (rhoSglRandom(instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoSglRandom ('//PLASTICITY_NONLOCAL_label//')') -! if (rhoSglRandomBinning(instance) <= 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') - - - - outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) - allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) - outputID = undefined_ID - select case(trim(outputs(i))) - case ('rho_sgl_edge_pos_mobile') - outputID = rho_sgl_edge_pos_mobile_ID - case ('rho_sgl_edge_neg_mobile') - outputID = rho_sgl_edge_neg_mobile_ID - case ('rho_sgl_screw_pos_mobile') - outputID = rho_sgl_screw_pos_mobile_ID - case ('rho_sgl_screw_neg_mobile') - outputID = rho_sgl_screw_neg_mobile_ID - case ('rho_sgl_edge_pos_immobile') - outputID = rho_sgl_edge_pos_immobile_ID - case ('rho_sgl_edge_neg_immobile') - outputID = rho_sgl_edge_neg_immobile_ID - case ('rho_sgl_screw_pos_immobile') - outputID = rho_sgl_screw_pos_immobile_ID - case ('rho_sgl_screw_neg_immobile') - outputID = rho_sgl_screw_neg_immobile_ID - case ('rho_dip_edge') - outputID = rho_dip_edge_ID - case ('rho_dip_screw') - outputID = rho_dip_screw_ID - case ('rho_forest') - outputID = rho_forest_ID - case ('shearrate') - outputID = shearrate_ID - case ('resolvedstress') - outputID = resolvedstress_ID - case ('resolvedstress_external') - outputID = resolvedstress_external_ID - case ('resolvedstress_back') - outputID = resolvedstress_back_ID - case ('resistance') - outputID = resistance_ID - case ('rho_dot_sgl') - outputID = rho_dot_sgl_ID - case ('rho_dot_sgl_mobile') - outputID = rho_dot_sgl_mobile_ID - case ('rho_dot_dip') - outputID = rho_dot_dip_ID - case ('rho_dot_gen') - outputID = rho_dot_gen_ID - case ('rho_dot_gen_edge') - outputID = rho_dot_gen_edge_ID - case ('rho_dot_gen_screw') - outputID = rho_dot_gen_screw_ID - case ('rho_dot_sgl2dip_edge') - outputID = rho_dot_sgl2dip_edge_ID - case ('rho_dot_sgl2dip_screw') - outputID = rho_dot_sgl2dip_screw_ID - case ('rho_dot_ann_ath') - outputID = rho_dot_ann_ath_ID - case ('rho_dot_ann_the_edge') - outputID = rho_dot_ann_the_edge_ID - case ('rho_dot_ann_the_screw') - outputID = rho_dot_ann_the_screw_ID - case ('rho_dot_edgejogs') - outputID = rho_dot_edgejogs_ID - case ('rho_dot_flux_mobile') - outputID = rho_dot_flux_mobile_ID - case ('rho_dot_flux_edge') - outputID = rho_dot_flux_edge_ID - case ('rho_dot_flux_screw') - outputID = rho_dot_flux_screw_ID - case ('velocity_edge_pos') - outputID = velocity_edge_pos_ID - case ('velocity_edge_neg') - outputID = velocity_edge_neg_ID - case ('velocity_screw_pos') - outputID = velocity_screw_pos_ID - case ('velocity_screw_neg') - outputID = velocity_screw_neg_ID - case ('maximumdipoleheight_edge') - outputID = maximumdipoleheight_edge_ID - case ('maximumdipoleheight_screw') - outputID = maximumdipoleheight_screw_ID - case ('accumulatedshear','accumulated_shear') - outputID = accumulatedshear_ID - end select - - if (outputID /= undefined_ID) then - plastic_nonlocal_output(i,instance) = outputs(i) - plastic_nonlocal_sizePostResult(i,instance) = prm%totalNslip - prm%outputID = [prm%outputID , outputID] - endif - - enddo + associate(prm => param(phase_plasticityInstance(p)), & + dot => dotState(phase_plasticityInstance(p)), & + stt => state(phase_plasticityInstance(p)), & + del => deltaState(phase_plasticityInstance(p)), & + res => results(phase_plasticityInstance(p)), & + config => config_phase(p)) + NofMyPhase=count(material_phase==p) plasticState(p)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,instance)) @@ -843,12 +830,12 @@ extmsg = trim(extmsg)//' surfaceTransmissivity' del%rhoDipScrew => plasticState(p)%deltaState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) plasticState(p)%aTolState(iGamma(1:ns,instance)) = prm%aTolShear - allocate(results(instance)%rhoDotFlux(prm%totalNslip,8,NofMyPhase)) - allocate(results(instance)%rhoDotMultiplication(prm%totalNslip,2,NofMyPhase)) - allocate(results(instance)%rhoDotSingle2DipoleGlide(prm%totalNslip,2,NofMyPhase)) - allocate(results(instance)%rhoDotAthermalAnnihilation(prm%totalNslip,2,NofMyPhase)) - allocate(results(instance)%rhoDotThermalAnnihilation(prm%totalNslip,2,NofMyPhase)) - allocate(results(instance)%rhoDotEdgeJogs(prm%totalNslip,NofMyPhase)) + allocate(res%rhoDotFlux(prm%totalNslip,8,NofMyPhase)) + allocate(res%rhoDotMultiplication(prm%totalNslip,2,NofMyPhase)) + allocate(res%rhoDotSingle2DipoleGlide(prm%totalNslip,2,NofMyPhase)) + allocate(res%rhoDotAthermalAnnihilation(prm%totalNslip,2,NofMyPhase)) + allocate(res%rhoDotThermalAnnihilation(prm%totalNslip,2,NofMyPhase)) + allocate(res%rhoDotEdgeJogs(prm%totalNslip,NofMyPhase)) end associate From 21d0ef2fb5888876377ad7ad58331e03068d0c9a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Feb 2019 05:55:03 +0100 Subject: [PATCH 270/309] use microstructure/dependent state introduced only partly, otherwise the uncommon calling sequence in nonlocal leads to a change in behavior --- src/plastic_nonlocal.f90 | 98 ++++++++++++++++------------------------ 1 file changed, 40 insertions(+), 58 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 1ef0a22c7..653ed0027 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -23,9 +23,7 @@ module plastic_nonlocal integer(pInt), dimension(:,:), allocatable, private :: & iGamma, & !< state indices for accumulated shear - iRhoF, & !< state indices for forest density - iTauF, & !< state indices for critical resolved shear stress - iTauB !< state indices for backstress + iRhoF !< state indices for forest density integer(pInt), dimension(:,:,:), allocatable, private :: & iRhoU, & !< state indices for unblocked density iRhoB, & !< state indices for blocked density @@ -162,6 +160,13 @@ module plastic_nonlocal outputID !< ID of each post result output end type tParameters + + type, private :: tNonlocalMicrostructure + real(pReal), allocatable, dimension(:,:) :: & + tau_Threshold, & + tau_Back + + end type tNonlocalMicrostructure type, private :: tOutput !< container type for storage of output results real(pReal), dimension(:,:), allocatable, private :: & @@ -216,7 +221,7 @@ module plastic_nonlocal type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) type(tOutput), dimension(:), allocatable, private :: results - + type(tNonlocalMicrostructure), dimension(:), allocatable, private :: microstructure integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & plastic_nonlocal_outputID !< ID of each post result output @@ -303,6 +308,7 @@ subroutine plastic_nonlocal_init allocate(state(maxNinstances)) allocate(dotState(maxNinstances)) allocate(deltaState(maxNinstances)) + allocate(microstructure(maxNinstances)) allocate(results(maxNinstances)) allocate(plastic_nonlocal_sizePostResult(maxval(phase_Noutput), maxNinstances), source=0_pInt) @@ -601,8 +607,7 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' 'rhoDipEdge ','rhoDipScrew ', & 'accumulatedshear ' ]),pInt) * prm%totalNslip !< "basic" microstructural state variables that are independent from other state variables - sizeDependentState = int(size([ 'rhoForest ', 'tauThreshold', & - 'tauBack ' ]),pInt) * prm%totalNslip !< microstructural state variables that depend on other state variables + sizeDependentState = int(size([ 'rhoForest ']),pInt) * prm%totalNslip !< microstructural state variables that depend on other state variables sizeState = sizeDotState + sizeDependentState & + int(size([ 'velocityEdgePos ','velocityEdgeNeg ', & @@ -631,8 +636,6 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' allocate(iD(maxTotalNslip,2,maxNinstances), source=0_pInt) allocate(iGamma(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iRhoF(maxTotalNslip,maxNinstances), source=0_pInt) - allocate(iTauF(maxTotalNslip,maxNinstances), source=0_pInt) - allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) ! END DEPRECATED------------------------------------------------------------------------------------ allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & @@ -675,14 +678,6 @@ ns = param(instance)%totalNslip l = l + 1_pInt iRhoF(s,instance) = l enddo - do s = 1_pInt,ns - l = l + 1_pInt - iTauF(s,instance) = l - enddo - do s = 1_pInt,ns - l = l + 1_pInt - iTauB(s,instance) = l - enddo do t = 1_pInt,4_pInt do s = 1_pInt,ns l = l + 1_pInt @@ -744,6 +739,7 @@ ns = param(instance)%totalNslip stt => state(phase_plasticityInstance(p)), & del => deltaState(phase_plasticityInstance(p)), & res => results(phase_plasticityInstance(p)), & + dst => microstructure(phase_plasticityInstance(p)), & config => config_phase(p)) NofMyPhase=count(material_phase==p) @@ -830,6 +826,10 @@ ns = param(instance)%totalNslip del%rhoDipScrew => plasticState(p)%deltaState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) plasticState(p)%aTolState(iGamma(1:ns,instance)) = prm%aTolShear + + allocate(dst%tau_Threshold(prm%totalNslip,NofMyPhase),source=0.0_pReal) + allocate(dst%tau_Back(prm%totalNslip,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotFlux(prm%totalNslip,8,NofMyPhase)) allocate(res%rhoDotMultiplication(prm%totalNslip,2,NofMyPhase)) allocate(res%rhoDotSingle2DipoleGlide(prm%totalNslip,2,NofMyPhase)) @@ -1006,9 +1006,7 @@ real(pReal), dimension(2) :: rhoExcessGradient, & real(pReal), dimension(3) :: rhoExcessDifferences, & normal_latticeConf real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & - rhoForest, & ! forest dislocation density - tauBack, & ! back stress from pileup on same slip system - tauThreshold ! threshold shear stress + rhoForest ! forest dislocation density real(pReal), dimension(3,3) :: invFe, & ! inverse of elastic deformation gradient invFp, & ! inverse of plastic deformation gradient connections, & @@ -1033,7 +1031,7 @@ real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pI ph = phaseAt(1,ip,el) of = phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) -associate(prm => param(instance)) +associate(prm => param(instance),dst => microstructure(instance)) ns = prm%totalNslip @@ -1081,14 +1079,14 @@ if (lattice_structure(ph) == LATTICE_bcc_ID .or. lattice_structure(ph) == LATTI enddo endif forall (s = 1_pInt:ns) & - tauThreshold(s) = prm%mu * prm%burgers(s) & + dst%tau_threshold(s,of) = prm%mu * prm%burgers(s) & * sqrt(dot_product((sum(abs(rhoSgl),2) + sum(abs(rhoDip),2)), myInteractionMatrix(s,1:ns))) !*** calculate the dislocation stress of the neighboring excess dislocation densities !*** zero for material points of local plasticity -tauBack = 0.0_pReal + dst%tau_back(:,of) = 0.0_pReal !################################################################################################# !################################################################################################# @@ -1195,7 +1193,7 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then !* gives the local stress correction when multiplied with a factor - tauBack(s) = - prm%mu * prm%burgers(s) / (2.0_pReal * pi) & + dst%tau_back(s,of) = - prm%mu * prm%burgers(s) / (2.0_pReal * pi) & * (rhoExcessGradient_over_rho(1) / (1.0_pReal - prm%nu) & + rhoExcessGradient_over_rho(2)) @@ -1205,8 +1203,6 @@ endif !*** set dependent states plasticState(ph)%state(iRhoF(1:ns,instance),of) = rhoForest -plasticState(ph)%state(iTauF(1:ns,instance),of) = tauThreshold -plasticState(ph)%state(iTauB(1:ns,instance),of) = tauBack #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & @@ -1214,8 +1210,8 @@ plasticState(ph)%state(iTauB(1:ns,instance),of) = tauBack .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_microstructure at el ip ',el,ip write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', rhoForest - write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold*1e-6 - write(6,'(a,/,12x,12(f10.5,1x),/)') '<< CONST >> tauBack / MPa', tauBack*1e-6 + write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', dst%tau_threshold(:,of)*1e-6 + write(6,'(a,/,12x,12(f10.5,1x),/)') '<< CONST >> tauBack / MPa', dst%tau_back(:,of)*1e-6 endif #endif end associate @@ -1424,9 +1420,8 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt dv_dtauNS !< velocity derivative with respect to the shear stress real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & tau, & !< resolved shear stress including backstress terms - gdotTotal, & !< shear rate - tauBack, & !< back stress from dislocation gradients on same slip system - tauThreshold !< threshold shear stress + gdotTotal !< shear rate + !*** shortcut for mapping ph = phaseAt(1_pInt,ip,el) of = phasememberAt(1_pInt,ip,el) @@ -1434,7 +1429,7 @@ of = phasememberAt(1_pInt,ip,el) instance = phase_plasticityInstance(ph) -associate(prm => param(instance)) +associate(prm => param(instance),dst=>microstructure(instance)) ns = prm%totalNslip !*** shortcut to state variables @@ -1448,9 +1443,6 @@ where (abs(rhoSgl) * volume ** 0.667_pReal < prm%significantN & .or. abs(rhoSgl) < prm%significantRho) & rhoSgl = 0.0_pReal -tauBack = plasticState(ph)%state(iTauB(1:ns,instance),of) -tauThreshold = plasticState(ph)%state(iTauF(1:ns,instance),of) - !*** get resolved shear stress !*** for screws possible non-schmid contributions are also taken into account @@ -1468,15 +1460,15 @@ do s = 1_pInt,ns endif enddo forall (t = 1_pInt:4_pInt) & - tauNS(1:ns,t) = tauNS(1:ns,t) + tauBack ! add backstress -tau = tau + tauBack ! add backstress + tauNS(1:ns,t) = tauNS(1:ns,t) + dst%tau_back(:,of) +tau = tau + dst%tau_back(:,of) !*** get dislocation velocity and its tangent and store the velocity in the state array ! edges call plastic_nonlocal_kinetics(v(1:ns,1), dv_dtau(1:ns,1), dv_dtauNS(1:ns,1), & - tau(1:ns), tauNS(1:ns,1), tauThreshold(1:ns), & + tau(1:ns), tauNS(1:ns,1), dst%tau_Threshold(1:ns,of), & 1_pInt, Temperature, ip, el) v(1:ns,2) = v(1:ns,1) dv_dtau(1:ns,2) = dv_dtau(1:ns,1) @@ -1492,7 +1484,7 @@ if (size(prm%nonSchmidCoeff) == 0_pInt) then else ! take non-Schmid contributions into account do t = 3_pInt,4_pInt call plastic_nonlocal_kinetics(v(1:ns,t), dv_dtau(1:ns,t), dv_dtauNS(1:ns,t), & - tau(1:ns), tauNS(1:ns,t), tauThreshold(1:ns), & + tau(1:ns), tauNS(1:ns,t), dst%tau_Threshold(1:ns,of), & 2_pInt , Temperature, ip, el) enddo endif @@ -1577,8 +1569,7 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & v ! dislocation glide velocity real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - tau, & ! current resolved shear stress - tauBack ! current back stress from pileups on same slip system + tau ! current resolved shear stress real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & rhoDip, & ! current dipole dislocation densities (screw and edge dipoles) dLower, & ! minimum stable dipole distance for edges and screws @@ -1596,7 +1587,7 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e ph = phaseAt(1,ip,el) of = phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) - associate(prm => param(instance)) + associate(prm => param(instance),dst => microstructure(instance)) ns = totalNslip(instance) @@ -1611,7 +1602,6 @@ forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) rhoDip(s,c) = max(plasticState(ph)%state(iRhoD(s,c,instance),of), 0.0_pReal) ! ensure positive dipole densities dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),of) endforall - tauBack = plasticState(ph)%state(iTauB(1:ns,instance),of) where (abs(rhoSgl) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & .or. abs(rhoSgl) < prm%significantRho) & @@ -1646,7 +1636,7 @@ enddo !*** calculate limits for stable dipole height do s = 1_pInt,prm%totalNslip - tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + tauBack(s) + tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) +dst%tau_back(s,of) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo dLower = prm%minDipoleHeight(1:ns,1:2) @@ -1810,9 +1800,7 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt gdot !< shear rates real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & rhoForest, & !< forest dislocation density - tauThreshold, & !< threshold shear stress tau, & !< current resolved shear stress - tauBack, & !< current back stress from pileups on same slip system vClimb !< climb velocity of edge dipoles real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & @@ -1854,7 +1842,7 @@ logical considerEnteringFlux, & ph = material_phase(1_pInt,ip,el) instance = phase_plasticityInstance(ph) -associate(prm => param(instance)) +associate(prm => param(instance),dst => microstructure(instance)) ns = totalNslip(instance) tau = 0.0_pReal @@ -1873,8 +1861,6 @@ forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) rhoDip(s,c) = max(plasticState(p)%state(iRhoD(s,c,instance),o), 0.0_pReal) ! ensure positive dipole densities endforall rhoForest = plasticState(p)%state(iRhoF(1:ns,instance),o) -tauThreshold = plasticState(p)%state(iTauF(1:ns,instance),o) -tauBack = plasticState(p)%state(iTauB(1:ns,instance),o) rhoSglOriginal = rhoSgl rhoDipOriginal = rhoDip @@ -1915,7 +1901,7 @@ forall (t = 1_pInt:4_pInt) & !*** calculate limits for stable dipole height do s = 1_pInt,ns ! loop over slip systems - tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + tauBack(s) + tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + dst%tau_back(s,o) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo @@ -2458,9 +2444,7 @@ function plastic_nonlocal_postResults(Mp,ip,el) result(postResults) v !< velocities real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & rhoForest, & !< forest dislocation density - tauThreshold, & !< threshold shear stress - tau, & !< current resolved shear stress - tauBack !< back stress from pileups on same slip system + tau !< current resolved shear stress real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) rhoDotDip, & !< evolution rate of dipole dislocation densities (screw and edge dipoles) @@ -2474,7 +2458,7 @@ ns = totalNslip(instance) cs = 0_pInt -associate(prm => param(instance)) +associate(prm => param(instance),dst => microstructure(instance)) !* short hand notations for state variables forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) @@ -2489,8 +2473,6 @@ forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) rhoDotDip(s,c) = plasticState(ph)%dotState(iRhoD(s,c,instance),of) endforall rhoForest = plasticState(ph)%State(iRhoF(1:ns,instance),of) -tauThreshold = plasticState(ph)%State(iTauF(1:ns,instance),of) -tauBack = plasticState(ph)%State(iTauB(1:ns,instance),of) !* Calculate shear rate @@ -2501,7 +2483,7 @@ forall (t = 1_pInt:4_pInt) & !* calculate limits for stable dipole height do s = 1_pInt,ns - tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + tauBack(s) + tau(s) = math_mul33xx33(Mp, prm%Schmid(1:3,1:3,s)) + dst%tau_back(s,of) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo @@ -2576,7 +2558,7 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) cs = cs + ns case (resolvedstress_back_ID) - postResults(cs+1_pInt:cs+ns) = tauBack + postResults(cs+1_pInt:cs+ns) = dst%tau_back(:,of) cs = cs + ns case (resolvedstress_external_ID) @@ -2586,7 +2568,7 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) cs = cs + ns case (resistance_ID) - postResults(cs+1_pInt:cs+ns) = tauThreshold + postResults(cs+1_pInt:cs+ns) = dst%tau_Threshold(:,of) cs = cs + ns case (rho_dot_sgl_ID) From 907f7ca56045a2416f65f62c03fb26f66263d353 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Feb 2019 12:36:27 +0100 Subject: [PATCH 271/309] transition to new class --- python/damask/orientation.py | 441 ++++++++++++++++++++++++++++++++--- 1 file changed, 411 insertions(+), 30 deletions(-) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 442a98f6e..03c69291f 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -242,8 +242,11 @@ class Rotation: If a quaternion is given, it needs to comply with the convection. Use .fromQuaternion to check the input. """ - self.quaternion = Quaternion2(q=quaternion[0],p=quaternion[1:4]) - self.quaternion.homomorph() # ToDo: Needed? + if isinstance(quaternion,Quaternion2): + self.quaternion = quaternion.copy() + else: + self.quaternion = Quaternion2(q=quaternion[0],p=quaternion[1:4]) + self.quaternion.homomorph() # ToDo: Needed? def __repr__(self): """Value in selected representation""" @@ -253,6 +256,7 @@ class Rotation: 'Bunge Eulers / deg: {}'.format('\t'.join(list(map(str,self.asEulers(degrees=True)))) ), ]) + ################################################################################################ # convert to different orientation representations (numpy arrays) @@ -261,7 +265,11 @@ class Rotation: def asEulers(self, degrees = False): - return np.degrees(qu2eu(self.quaternion.asArray())) if degrees else qu2eu(self.quaternion.asArray()) + + eu = qu2eu(self.quaternion.asArray()) + if degrees: eu = np.degrees(eu) + + return eu def asAngleAxis(self, degrees = False): @@ -370,7 +378,7 @@ class Rotation: """ Multiplication - Rotation: Details needed (active/passive), more rotation of (3,3,3,3) should be considered + Rotation: Details needed (active/passive), rotation of (3,3,3,3)-matrix should be considered """ if isinstance(other, Rotation): # rotate a rotation return self.__class__((self.quaternion * other.quaternion).asArray()) @@ -416,7 +424,12 @@ class Rotation: def inversed(self): """In-place inverse rotation/backward rotation""" - return self.__class__(self.quaternion.conjugated().asArray()) + return self.__class__(self.quaternion.conjugated()) + + + def misorientation(self,other): + """Misorientation""" + return self.__class__(other.quaternion*self.quaternion.conjugated()) # ****************************************************************************************** @@ -810,11 +823,15 @@ class Quaternion: # ****************************************************************************************** class Symmetry: + """ + Symmetry operations for lattice systems + + https://en.wikipedia.org/wiki/Crystal_system + """ lattices = [None,'orthorhombic','tetragonal','hexagonal','cubic',] def __init__(self, symmetry = None): - """Lattice with given symmetry, defaults to None""" if isinstance(symmetry, str) and symmetry.lower() in Symmetry.lattices: self.lattice = symmetry.lower() else: @@ -927,25 +944,29 @@ class Symmetry: def inFZ(self,R): """Check whether given Rodrigues vector falls into fundamental zone of own symmetry.""" - if isinstance(R, Quaternion): R = R.asRodrigues() # translate accidentally passed quaternion # fundamental zone in Rodrigues space is point symmetric around origin - R = abs(R) + + if R.shape[0]==4: # transition old (length not stored separately) to new + Rabs = abs(R[0:3]*R[3]) + else: + Rabs = abs(R) + if self.lattice == 'cubic': - return math.sqrt(2.0)-1.0 >= R[0] \ - and math.sqrt(2.0)-1.0 >= R[1] \ - and math.sqrt(2.0)-1.0 >= R[2] \ - and 1.0 >= R[0] + R[1] + R[2] + return math.sqrt(2.0)-1.0 >= Rabs[0] \ + and math.sqrt(2.0)-1.0 >= Rabs[1] \ + and math.sqrt(2.0)-1.0 >= Rabs[2] \ + and 1.0 >= Rabs[0] + Rabs[1] + Rabs[2] elif self.lattice == 'hexagonal': - return 1.0 >= R[0] and 1.0 >= R[1] and 1.0 >= R[2] \ - and 2.0 >= math.sqrt(3)*R[0] + R[1] \ - and 2.0 >= math.sqrt(3)*R[1] + R[0] \ - and 2.0 >= math.sqrt(3) + R[2] + return 1.0 >= Rabs[0] and 1.0 >= Rabs[1] and 1.0 >= Rabs[2] \ + and 2.0 >= math.sqrt(3)*Rabs[0] + Rabs[1] \ + and 2.0 >= math.sqrt(3)*Rabs[1] + Rabs[0] \ + and 2.0 >= math.sqrt(3) + Rabs[2] elif self.lattice == 'tetragonal': - return 1.0 >= R[0] and 1.0 >= R[1] \ - and math.sqrt(2.0) >= R[0] + R[1] \ - and math.sqrt(2.0) >= R[2] + 1.0 + return 1.0 >= Rabs[0] and 1.0 >= Rabs[1] \ + and math.sqrt(2.0) >= Rabs[0] + Rabs[1] \ + and math.sqrt(2.0) >= Rabs[2] + 1.0 elif self.lattice == 'orthorhombic': - return 1.0 >= R[0] and 1.0 >= R[1] and 1.0 >= R[2] + return 1.0 >= Rabs[0] and 1.0 >= Rabs[1] and 1.0 >= Rabs[2] else: return True @@ -1067,6 +1088,373 @@ class Symmetry: # suggested reading: http://web.mit.edu/2.998/www/QuaternionReport1.pdf +# ****************************************************************************************** +class Lattice: + """ + Lattice system + + Currently, this contains only a mapping from Bravais lattice to symmetry + and orientation relationships. It could include twin and slip systems. + https://en.wikipedia.org/wiki/Bravais_lattice + """ + + lattices = { + 'triclinic':{'symmetry':None}, + 'bct':{'symmetry':'tetragonal'}, + 'hex':{'symmetry':'hexagonal'}, + 'fcc':{'symmetry':'cubic','c/a':1.0}, + 'bcc':{'symmetry':'cubic','c/a':1.0}, + } + + + def __init__(self, lattice): + self.lattice = lattice + self.symmetry = Symmetry(self.lattices[lattice]['symmetry']) + + + def __repr__(self): + """Report basic lattice information""" + return 'Bravais lattice {} ({} symmetry)'.format(self.lattice,self.symmetry) + + + # Kurdjomov--Sachs orientation relationship for fcc <-> bcc transformation + # from S. Morito et al./Journal of Alloys and Compounds 5775 (2013) S587-S592 + # also see K. Kitahara et al./Acta Materialia 54 (2006) 1279-1288 + KS = {'mapping':{'fcc':0,'bcc':1}, + 'planes': np.array([ + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, -1],[ 0, 1, 1]], + [[ 1, 1, -1],[ 0, 1, 1]], + [[ 1, 1, -1],[ 0, 1, 1]], + [[ 1, 1, -1],[ 0, 1, 1]], + [[ 1, 1, -1],[ 0, 1, 1]], + [[ 1, 1, -1],[ 0, 1, 1]]],dtype='float'), + 'directions': np.array([ + [[ -1, 0, 1],[ -1, -1, 1]], + [[ -1, 0, 1],[ -1, 1, -1]], + [[ 0, 1, -1],[ -1, -1, 1]], + [[ 0, 1, -1],[ -1, 1, -1]], + [[ 1, -1, 0],[ -1, -1, 1]], + [[ 1, -1, 0],[ -1, 1, -1]], + [[ 1, 0, -1],[ -1, -1, 1]], + [[ 1, 0, -1],[ -1, 1, -1]], + [[ -1, -1, 0],[ -1, -1, 1]], + [[ -1, -1, 0],[ -1, 1, -1]], + [[ 0, 1, 1],[ -1, -1, 1]], + [[ 0, 1, 1],[ -1, 1, -1]], + [[ 0, -1, 1],[ -1, -1, 1]], + [[ 0, -1, 1],[ -1, 1, -1]], + [[ -1, 0, -1],[ -1, -1, 1]], + [[ -1, 0, -1],[ -1, 1, -1]], + [[ 1, 1, 0],[ -1, -1, 1]], + [[ 1, 1, 0],[ -1, 1, -1]], + [[ -1, 1, 0],[ -1, -1, 1]], + [[ -1, 1, 0],[ -1, 1, -1]], + [[ 0, -1, -1],[ -1, -1, 1]], + [[ 0, -1, -1],[ -1, 1, -1]], + [[ 1, 0, 1],[ -1, -1, 1]], + [[ 1, 0, 1],[ -1, 1, -1]]],dtype='float')} + + # Greninger--Troiano orientation relationship for fcc <-> bcc transformation + # from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 + GT = {'mapping':{'fcc':0,'bcc':1}, + 'planes': np.array([ + [[ 1, 1, 1],[ 1, 0, 1]], + [[ 1, 1, 1],[ 1, 1, 0]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ -1, -1, 1],[ -1, 0, 1]], + [[ -1, -1, 1],[ -1, -1, 0]], + [[ -1, -1, 1],[ 0, -1, 1]], + [[ -1, 1, 1],[ -1, 0, 1]], + [[ -1, 1, 1],[ -1, 1, 0]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 1, 0, 1]], + [[ 1, -1, 1],[ 1, -1, 0]], + [[ 1, -1, 1],[ 0, -1, 1]], + [[ 1, 1, 1],[ 1, 1, 0]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 1, 0, 1]], + [[ -1, -1, 1],[ -1, -1, 0]], + [[ -1, -1, 1],[ 0, -1, 1]], + [[ -1, -1, 1],[ -1, 0, 1]], + [[ -1, 1, 1],[ -1, 1, 0]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ -1, 0, 1]], + [[ 1, -1, 1],[ 1, -1, 0]], + [[ 1, -1, 1],[ 0, -1, 1]], + [[ 1, -1, 1],[ 1, 0, 1]]],dtype='float'), + 'directions': np.array([ + [[ -5,-12, 17],[-17, -7, 17]], + [[ 17, -5,-12],[ 17,-17, -7]], + [[-12, 17, -5],[ -7, 17,-17]], + [[ 5, 12, 17],[ 17, 7, 17]], + [[-17, 5,-12],[-17, 17, -7]], + [[ 12,-17, -5],[ 7,-17,-17]], + [[ -5, 12,-17],[-17, 7,-17]], + [[ 17, 5, 12],[ 17, 17, 7]], + [[-12,-17, 5],[ -7,-17, 17]], + [[ 5,-12,-17],[ 17, -7,-17]], + [[-17, -5, 12],[-17,-17, 7]], + [[ 12, 17, 5],[ 7, 17, 17]], + [[ -5, 17,-12],[-17, 17, -7]], + [[-12, -5, 17],[ -7,-17, 17]], + [[ 17,-12, -5],[ 17, -7,-17]], + [[ 5,-17,-12],[ 17,-17, -7]], + [[ 12, 5, 17],[ 7, 17, 17]], + [[-17, 12, -5],[-17, 7,-17]], + [[ -5,-17, 12],[-17,-17, 7]], + [[-12, 5,-17],[ -7, 17,-17]], + [[ 17, 12, 5],[ 17, 7, 17]], + [[ 5, 17, 12],[ 17, 17, 7]], + [[ 12, -5,-17],[ 7,-17,-17]], + [[-17,-12, 5],[-17, 7, 17]]],dtype='float')} + + # Greninger--Troiano' orientation relationship for fcc <-> bcc transformation + # from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 + GTdash = {'mapping':{'fcc':0,'bcc':1}, + 'planes': np.array([ + [[ 7, 17, 17],[ 12, 5, 17]], + [[ 17, 7, 17],[ 17, 12, 5]], + [[ 17, 17, 7],[ 5, 17, 12]], + [[ -7,-17, 17],[-12, -5, 17]], + [[-17, -7, 17],[-17,-12, 5]], + [[-17,-17, 7],[ -5,-17, 12]], + [[ 7,-17,-17],[ 12, -5,-17]], + [[ 17, -7,-17],[ 17,-12, -5]], + [[ 17,-17, -7],[ 5,-17,-12]], + [[ -7, 17,-17],[-12, 5,-17]], + [[-17, 7,-17],[-17, 12, -5]], + [[-17, 17, -7],[ -5, 17,-12]], + [[ 7, 17, 17],[ 12, 17, 5]], + [[ 17, 7, 17],[ 5, 12, 17]], + [[ 17, 17, 7],[ 17, 5, 12]], + [[ -7,-17, 17],[-12,-17, 5]], + [[-17, -7, 17],[ -5,-12, 17]], + [[-17,-17, 7],[-17, -5, 12]], + [[ 7,-17,-17],[ 12,-17, -5]], + [[ 17, -7,-17],[ 5, -12,-17]], + [[ 17,-17, 7],[ 17, -5,-12]], + [[ -7, 17,-17],[-12, 17, -5]], + [[-17, 7,-17],[ -5, 12,-17]], + [[-17, 17, -7],[-17, 5,-12]]],dtype='float'), + 'directions': np.array([ + [[ 0, 1, -1],[ 1, 1, -1]], + [[ -1, 0, 1],[ -1, 1, 1]], + [[ 1, -1, 0],[ 1, -1, 1]], + [[ 0, -1, -1],[ -1, -1, -1]], + [[ 1, 0, 1],[ 1, -1, 1]], + [[ 1, -1, 0],[ 1, -1, -1]], + [[ 0, 1, -1],[ -1, 1, -1]], + [[ 1, 0, 1],[ 1, 1, 1]], + [[ -1, -1, 0],[ -1, -1, 1]], + [[ 0, -1, -1],[ 1, -1, -1]], + [[ -1, 0, 1],[ -1, -1, 1]], + [[ -1, -1, 0],[ -1, -1, -1]], + [[ 0, -1, 1],[ 1, -1, 1]], + [[ 1, 0, -1],[ 1, 1, -1]], + [[ -1, 1, 0],[ -1, 1, 1]], + [[ 0, 1, 1],[ -1, 1, 1]], + [[ -1, 0, -1],[ -1, -1, -1]], + [[ -1, 1, 0],[ -1, 1, -1]], + [[ 0, -1, 1],[ -1, -1, 1]], + [[ -1, 0, -1],[ -1, 1, -1]], + [[ 1, 1, 0],[ 1, 1, 1]], + [[ 0, 1, 1],[ 1, 1, 1]], + [[ 1, 0, -1],[ 1, -1, -1]], + [[ 1, 1, 0],[ 1, 1, -1]]],dtype='float')} + + # Nishiyama--Wassermann orientation relationship for fcc <-> bcc transformation + # from H. Kitahara et al./Materials Characterization 54 (2005) 378-386 + NW = {'mapping':{'fcc':0,'bcc':1}, + 'planes': np.array([ + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ -1, -1, 1],[ 0, 1, 1]], + [[ -1, -1, 1],[ 0, 1, 1]], + [[ -1, -1, 1],[ 0, 1, 1]]],dtype='float'), + 'directions': np.array([ + [[ 2, -1, -1],[ 0, -1, 1]], + [[ -1, 2, -1],[ 0, -1, 1]], + [[ -1, -1, 2],[ 0, -1, 1]], + [[ -2, -1, -1],[ 0, -1, 1]], + [[ 1, 2, -1],[ 0, -1, 1]], + [[ 1, -1, 2],[ 0, -1, 1]], + [[ 2, 1, -1],[ 0, -1, 1]], + [[ -1, -2, -1],[ 0, -1, 1]], + [[ -1, 1, 2],[ 0, -1, 1]], + [[ -1, 2, 1],[ 0, -1, 1]], + [[ -1, 2, 1],[ 0, -1, 1]], + [[ -1, -1, -2],[ 0, -1, 1]]],dtype='float')} + + # Pitsch orientation relationship for fcc <-> bcc transformation + # from Y. He et al./Acta Materialia 53 (2005) 1179-1190 + Pitsch = {'mapping':{'fcc':0,'bcc':1}, + 'planes': np.array([ + [[ 0, 1, 0],[ -1, 0, 1]], + [[ 0, 0, 1],[ 1, -1, 0]], + [[ 1, 0, 0],[ 0, 1, -1]], + [[ 1, 0, 0],[ 0, -1, -1]], + [[ 0, 1, 0],[ -1, 0, -1]], + [[ 0, 0, 1],[ -1, -1, 0]], + [[ 0, 1, 0],[ -1, 0, -1]], + [[ 0, 0, 1],[ -1, -1, 0]], + [[ 1, 0, 0],[ 0, -1, -1]], + [[ 1, 0, 0],[ 0, -1, 1]], + [[ 0, 1, 0],[ 1, 0, -1]], + [[ 0, 0, 1],[ -1, 1, 0]]],dtype='float'), + 'directions': np.array([ + [[ 1, 0, 1],[ 1, -1, 1]], + [[ 1, 1, 0],[ 1, 1, -1]], + [[ 0, 1, 1],[ -1, 1, 1]], + [[ 0, 1, -1],[ -1, 1, -1]], + [[ -1, 0, 1],[ -1, -1, 1]], + [[ 1, -1, 0],[ 1, -1, -1]], + [[ 1, 0, -1],[ 1, -1, -1]], + [[ -1, 1, 0],[ -1, 1, -1]], + [[ 0, -1, 1],[ -1, -1, 1]], + [[ 0, 1, 1],[ -1, 1, 1]], + [[ 1, 0, 1],[ 1, -1, 1]], + [[ 1, 1, 0],[ 1, 1, -1]]],dtype='float')} + + # Bain orientation relationship for fcc <-> bcc transformation + # from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 + Bain = {'mapping':{'fcc':0,'bcc':1}, + 'planes': np.array([ + [[ 1, 0, 0],[ 1, 0, 0]], + [[ 0, 1, 0],[ 0, 1, 0]], + [[ 0, 0, 1],[ 0, 0, 1]]],dtype='float'), + 'directions': np.array([ + [[ 0, 1, 0],[ 0, 1, 1]], + [[ 0, 0, 1],[ 1, 0, 1]], + [[ 1, 0, 0],[ 1, 1, 0]]],dtype='float')} + + def relationOperations(self,model): + + models={'KS':self.KS, 'GT':self.GT, "GT'":self.GTdash, + 'NW':self.NW, 'Pitsch': self.Pitsch, 'Bain':self.Bain} + + relationship = models[model] + + r = {'lattice':Lattice((set(relationship['mapping'])-{self.lattice}).pop()), + 'rotations':[] } + + myPlane_id = relationship['mapping'][self.lattice] + otherPlane_id = (myPlane_id+1)%2 + myDir_id = myPlane_id +2 + otherDir_id = otherPlane_id +2 + for miller in np.hstack((relationship['planes'],relationship['directions'])): + myPlane = miller[myPlane_id]/ np.linalg.norm(miller[myPlane_id]) + myDir = miller[myDir_id]/ np.linalg.norm(miller[myDir_id]) + otherPlane = miller[otherPlane_id]/ np.linalg.norm(miller[otherPlane_id]) + otherDir = miller[otherDir_id]/ np.linalg.norm(miller[otherDir_id]) + + myMatrix = np.array([myDir,np.cross(myPlane,myDir),myPlane]).T + otherMatrix = np.array([otherDir,np.cross(otherPlane,otherDir),otherPlane]).T + r['rotations'].append(Rotation.fromMatrix(np.dot(otherMatrix,myMatrix.T))) + return r + + + +class Orientation2: + """ + Crystallographic orientation + + A crystallographic orientation contains a rotation and a lattice + """ + + __slots__ = ['rotation','lattice'] + + def __repr__(self): + """Report lattice type and orientation""" + return self.lattice.__repr__()+'\n'+self.rotation.__repr__() + + def __init__(self, rotation, lattice): + + if isinstance(lattice, Lattice): + self.lattice = lattice + else: + self.lattice = Lattice(lattice) # assume string + + if isinstance(rotation, Rotation): + self.rotation = rotation + else: + self.rotation = Rotation(rotation) # assume quaternion + + def disorientation(self, + other, + SST = True): + """ + Disorientation between myself and given other orientation. + + Rotation axis falls into SST if SST == True. + (Currently requires same symmetry for both orientations. + Look into A. Heinz and P. Neumann 1991 for cases with differing sym.) + """ + #if self.lattice.symmetry != other.lattice.symmetry: + # raise NotImplementedError('disorientation between different symmetry classes not supported yet.') + + mis = other.rotation*self.rotation.inversed() + mySymEqs = self.equivalentOrientations() if SST else self.equivalentOrientations()[:1] # take all or only first sym operation + otherSymEqs = other.equivalentOrientations() + + for i,sA in enumerate(mySymEqs): + for j,sB in enumerate(otherSymEqs): + theQ = sB.rotation*mis*sA.rotation.inversed() + for k in range(2): + theQ.inversed() + breaker = self.lattice.symmetry.inFZ(theQ.asRodriques()) #and (not SST or other.symmetry.inDisorientationSST(theQ)) + if breaker: break + if breaker: break + if breaker: break + +# disorientation, own sym, other sym, self-->other: True, self<--other: False + return theQ + + def inFZ(self): + return self.lattice.symmetry.inFZ(self.rotation.asRodrigues()) + + def equivalentOrientations(self): + """List of orientations which are symmetrically equivalent""" + q = self.lattice.symmetry.symmetryQuats() + q2 = [Quaternion2(q=a.asList()[0],p=a.asList()[1:4]) for a in q] # convert Quaternion to Quaternion2 + x = [self.__class__(q3*self.rotation.quaternion,self.lattice) for q3 in q2] + return x + + def relatedOrientations(self,model): + """List of orientations related by the given orientation relationship""" + r = self.lattice.relationOperations(model) + return [self.__class__(self.rotation*o,r['lattice']) for o in r['rotations']] + + def reduced(self): + """Transform orientation to fall into fundamental zone according to symmetry""" + for me in self.equivalentOrientations(): + if self.lattice.symmetry.inFZ(me.rotation.asRodrigues()): break + + return self.__class__(me.rotation,self.lattice) # ****************************************************************************************** class Orientation: @@ -1173,7 +1561,8 @@ class Orientation: (Currently requires same symmetry for both orientations. Look into A. Heinz and P. Neumann 1991 for cases with differing sym.) """ - if self.symmetry != other.symmetry: raise TypeError('disorientation between different symmetry classes not supported yet.') + if self.symmetry != other.symmetry: + raise NotImplementedError('disorientation between different symmetry classes not supported yet.') misQ = other.quaternion*self.quaternion.conjugated() mySymQs = self.symmetry.symmetryQuats() if SST else self.symmetry.symmetryQuats()[:1] # take all or only first sym operation @@ -1266,14 +1655,6 @@ class Orientation: if relationModel not in ['KS','GT','GTdash','NW','Pitsch','Bain']: return None if int(direction) == 0: return None - # KS from S. Morito et al./Journal of Alloys and Compounds 5775 (2013) S587-S592 - # for KS rotation matrices also check K. Kitahara et al./Acta Materialia 54 (2006) 1279-1288 - # GT from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 - # GT' from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 - # NW from H. Kitahara et al./Materials Characterization 54 (2005) 378-386 - # Pitsch from Y. He et al./Acta Materialia 53 (2005) 1179-1190 - # Bain from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 - variant = int(abs(direction))-1 (me,other) = (0,1) if direction > 0 else (1,0) @@ -1789,7 +2170,7 @@ def om2qu(om): if om[2,1] < om[1,2]: qu[1] *= -1.0 if om[0,2] < om[2,0]: qu[2] *= -1.0 if om[1,0] < om[0,1]: qu[3] *= -1.0 - if any(om2ax(om)[0:3]*qu[1:4] < 0.0): print(om2ax(om),qu) # something is wrong here + if any(om2ax(om)[0:3]*qu[1:4] < 0.0): print('sign problem',om2ax(om),qu) # something is wrong here return qu From d686384d17121ce975f068e9934f20a70385f372 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Feb 2019 19:18:06 +0100 Subject: [PATCH 272/309] let lattice.f90 do the job --- src/plastic_nonlocal.f90 | 161 ++++++++++++--------------------------- 1 file changed, 47 insertions(+), 114 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 653ed0027..3777f2246 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -36,9 +36,8 @@ module plastic_nonlocal integer(pInt), dimension(:,:), allocatable, private :: & Nslip, & !< number of active slip systems - slipFamily, & !< lookup table relating active slip system to slip family for each instance - slipSystemLattice, & !< lookup table relating active slip system index to lattice slip system index for each instance - colinearSystem !< colinear system to the active slip system (only valid for fcc!) + slipFamily !< lookup table relating active slip system to slip family for each instance + real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & @@ -121,24 +120,23 @@ module plastic_nonlocal minDipoleHeight_screw, & !< minimum stable screw dipole height peierlsstress_edge, & peierlsstress_screw, & - rhoSglEdgePos0, & !< initial edge_pos dislocation density per slip system for each family and instance - rhoSglEdgeNeg0, & !< initial edge_neg dislocation density per slip system for each family and instance - rhoSglScrewPos0, & !< initial screw_pos dislocation density per slip system for each family and instance - rhoSglScrewNeg0, & !< initial screw_neg dislocation density per slip system for each family and instance - rhoDipEdge0, & !< initial edge dipole dislocation density per slip system for each family and instance - rhoDipScrew0,& !< initial screw dipole dislocation density per slip system for each family and instance - lambda0, & !< mean free path prefactor for each slip system and instance - burgers !< absolute length of burgers vector [m] for each slip system and instance - + rhoSglEdgePos0, & !< initial edge_pos dislocation density + rhoSglEdgeNeg0, & !< initial edge_neg dislocation density + rhoSglScrewPos0, & !< initial screw_pos dislocation density + rhoSglScrewNeg0, & !< initial screw_neg dislocation density + rhoDipEdge0, & !< initial edge dipole dislocation density + rhoDipScrew0,& !< initial screw dipole dislocation density + lambda0, & !< mean free path prefactor for each + burgers !< absolute length of burgers vector [m] real(pReal), dimension(:,:), allocatable :: & slip_normal, & slip_direction, & slip_transverse, & minDipoleHeight, & ! edge and screw peierlsstress, & ! edge and screw - interactionSlipSlip ,& !< coefficients for slip-slip interaction for each interaction type and instance - forestProjection_Edge, & !< matrix of forest projections of edge dislocations for each instance - forestProjection_Screw !< matrix of forest projections of screw dislocations for each instance + interactionSlipSlip ,& !< coefficients for slip-slip interaction + forestProjection_Edge, & !< matrix of forest projections of edge dislocations + forestProjection_Screw !< matrix of forest projections of screw dislocations real(pReal), dimension(:), allocatable, private :: & nonSchmidCoeff integer(pInt) :: totalNslip @@ -317,7 +315,6 @@ subroutine plastic_nonlocal_init allocate(plastic_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID) allocate(Nslip(lattice_maxNslipFamily,maxNinstances), source=0_pInt) allocate(slipFamily(lattice_maxNslip,maxNinstances), source=0_pInt) - allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(totalNslip(maxNinstances), source=0_pInt) @@ -373,11 +370,11 @@ subroutine plastic_nonlocal_init config%getFloat('c/a',defaultVal=0.0_pReal)) ! collinear systems (only for octahedral slip systems in fcc) - allocate(prm%colinearSystem(prm%totalNslip)) + allocate(prm%colinearSystem(prm%totalNslip), source = -1_pInt) do s1 = 1_pInt, prm%totalNslip do s2 = 1_pInt, prm%totalNslip if (all(dEq0 (math_cross(prm%slip_direction(1:3,s1),prm%slip_direction(1:3,s2)))) .and. & - all(dNeq0(math_cross(prm%slip_normal (1:3,s1),prm%slip_normal (1:3,s2))))) & + any(dNeq0(math_cross(prm%slip_normal (1:3,s1),prm%slip_normal (1:3,s2))))) & prm%colinearSystem(s1) = s2 enddo enddo @@ -430,10 +427,13 @@ subroutine plastic_nonlocal_init prm%viscosity = config%getFloat('viscosity') prm%fattack = config%getFloat('attackfrequency') + ! ToDo: discuss logic prm%rhoSglScatter = config%getFloat('rhosglscatter') prm%rhoSglRandom = config%getFloat('rhosglrandom',0.0_pReal) if (config%keyExists('rhosglrandom')) & prm%rhoSglRandomBinning = config%getFloat('rhosglrandombinning',0.0_pReal) !ToDo: useful default? + ! if (rhoSglRandom(instance) < 0.0_pReal) & + ! if (rhoSglRandomBinning(instance) <= 0.0_pReal) & prm%surfaceTransmissivity = config%getFloat('surfacetransmissivity',defaultVal=1.0_pReal) prm%grainboundaryTransmissivity = config%getFloat('grainboundarytransmissivity',defaultVal=-1.0_pReal) @@ -443,12 +443,15 @@ subroutine plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- ! sanity checks if (any(prm%burgers < 0.0_pReal)) extmsg = trim(extmsg)//' burgers' + if (any(prm%lambda0 <= 0.0_pReal)) extmsg = trim(extmsg)//' lambda0' + if (any(prm%rhoSglEdgePos0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglEdgePos0' if (any(prm%rhoSglEdgeNeg0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglEdgeNeg0' if (any(prm%rhoSglScrewPos0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglScrewPos0' if (any(prm%rhoSglScrewNeg0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglScrewNeg0' if (any(prm%rhoDipEdge0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoDipEdge0' if (any(prm%rhoDipScrew0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoDipScrew0' + if (any(prm%peierlsstress < 0.0_pReal)) extmsg = trim(extmsg)//' peierlsstress' if (any(prm%minDipoleHeight < 0.0_pReal)) extmsg = trim(extmsg)//' minDipoleHeight' @@ -457,6 +460,7 @@ subroutine plastic_nonlocal_init if (prm%fattack <= 0.0_pReal) extmsg = trim(extmsg)//' fattack' if (prm%doublekinkwidth <= 0.0_pReal) extmsg = trim(extmsg)//' doublekinkwidth' if (prm%Dsd0 < 0.0_pReal) extmsg = trim(extmsg)//' Dsd0' + if (prm%atomicVolume <= 0.0_pReal) extmsg = trim(extmsg)//' atomicVolume' ! ToDo: in disloUCLA/dislotwin, the atomic volume is given as a factor if (prm%significantN < 0.0_pReal) extmsg = trim(extmsg)//' significantN' if (prm%significantrho < 0.0_pReal) extmsg = trim(extmsg)//' significantrho' @@ -468,7 +472,7 @@ subroutine plastic_nonlocal_init if (prm%q < 1.0_pReal .or. prm%q > 2.0_pReal) extmsg = trim(extmsg)//' q' if (prm%linetensionEffect < 0.0_pReal .or. prm%linetensionEffect > 1.0_pReal) & - extmsg = trim(extmsg)//' edgeJogFactor' + extmsg = trim(extmsg)//' linetensionEffect' if (prm%edgeJogFactor < 0.0_pReal .or. prm%edgeJogFactor > 1.0_pReal) & extmsg = trim(extmsg)//' edgeJogFactor' @@ -476,8 +480,6 @@ subroutine plastic_nonlocal_init if (prm%solidSolutionSize <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionSize' if (prm%solidSolutionConcentration <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionConcentration' - - if (prm%grainboundaryTransmissivity > 1.0_pReal) extmsg = trim(extmsg)//' grainboundaryTransmissivity' if (prm%surfaceTransmissivity < 0.0_pReal .or. prm%surfaceTransmissivity > 1.0_pReal) & extmsg = trim(extmsg)//' surfaceTransmissivity' @@ -485,23 +487,6 @@ subroutine plastic_nonlocal_init if (prm%fEdgeMultiplication < 0.0_pReal .or. prm%fEdgeMultiplication > 1.0_pReal) & extmsg = trim(extmsg)//' fEdgeMultiplication' - - ! if (atomicVolume(instance) <= 0.0_pReal) & - -! do f = 1_pInt,lattice_maxNslipFamily -! if (Nslip(f,instance) > 0_pInt) then -! if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') -! endif -! enddo - -! if (rhoSglScatter(instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') -! if (rhoSglRandom(instance) < 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoSglRandom ('//PLASTICITY_NONLOCAL_label//')') -! if (rhoSglRandomBinning(instance) <= 0.0_pReal) & -! call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') - endif slipActive !-------------------------------------------------------------------------------------------------- @@ -606,14 +591,11 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' 'rhoSglScrewPosImmobile','rhoSglScrewNegImmobile', & 'rhoDipEdge ','rhoDipScrew ', & 'accumulatedshear ' ]),pInt) * prm%totalNslip !< "basic" microstructural state variables that are independent from other state variables - sizeDependentState = int(size([ 'rhoForest ']),pInt) * prm%totalNslip !< microstructural state variables that depend on other state variables - sizeState = sizeDotState + sizeDependentState & + int(size([ 'velocityEdgePos ','velocityEdgeNeg ', & 'velocityScrewPos ','velocityScrewNeg ', & 'maxDipoleHeightEdge ','maxDipoleHeightScrew' ]),pInt) * prm%totalNslip !< other dependent state variables that are not updated by microstructure - sizeDeltaState = sizeDotState call material_allocatePlasticState(p,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & prm%totalNslip,0_pInt,0_pInt) @@ -640,7 +622,6 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) initializeInstances: do phase = 1_pInt, size(phase_plasticity) NofMyPhase=count(material_phase==phase) @@ -699,32 +680,6 @@ ns = param(instance)%totalNslip plasticState(phase)%accumulatedSlip => & plasticState(phase)%state (iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) - - !*** Inverse lookup of my slip system family and the slip system in lattice - - l = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily - do s = 1_pInt,Nslip(f,instance) - l = l + 1_pInt - slipFamily(l,instance) = f - slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt, phase)) + s - enddo; enddo - - - do s1 = 1_pInt,ns - f = slipFamily(s1,instance) - - do s2 = 1_pInt,ns - - !*** colinear slip system (only makes sense for fcc like it is defined here) - - if ((all(dEq(lattice_sd(1:3,slipSystemLattice(s1,instance),phase), & - lattice_sd(1:3,slipSystemLattice(s2,instance),phase))) .or. all(dEq(lattice_sd(1:3,slipSystemLattice(s1,instance),phase), & - -1.0_pReal* lattice_sd(1:3,slipSystemLattice(s2,instance),phase)))) .and. s1 /= s2) & - colinearSystem(s1,instance) = s2 - enddo - - enddo endif myPhase2 @@ -947,6 +902,7 @@ use math, only: & math_mul33x3, & math_mul3x3, & math_inv33 +#ifdef DEBUG use debug, only: & debug_level, & debug_constitutive, & @@ -954,6 +910,7 @@ use debug, only: & debug_levelSelective, & debug_i, & debug_e +#endif use mesh, only: & theMesh, & mesh_ipNeighborhood, & @@ -1036,8 +993,6 @@ associate(prm => param(instance),dst => microstructure(instance)) ns = prm%totalNslip !*** get basic states - - forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) rhoSgl(s,t) = max(plasticState(ph)%state(iRhoU(s,t,instance),of), 0.0_pReal) ! ensure positive single mobile densities rhoSgl(s,t+4_pInt) = plasticState(ph)%state(iRhoB(s,t,instance),of) @@ -1157,8 +1112,7 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then do s = 1_pInt,ns - !* gradient from interpolation of neighboring excess density - + ! gradient from interpolation of neighboring excess density ... do c = 1_pInt,2_pInt do dir = 1_pInt,3_pInt neighbors(1) = 2_pInt * dir - 1_pInt @@ -1175,15 +1129,13 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then math_mul33x3(invConnections,rhoExcessDifferences)) enddo - !* plus gradient from deads - + ! ... plus gradient from deads ... do t = 1_pInt,4_pInt c = (t - 1_pInt) / 2_pInt + 1_pInt rhoExcessGradient(c) = rhoExcessGradient(c) + rhoSgl(s,t+4_pInt) / FVsize enddo - !* normalized with the total density - + ! ... normalized with the total density ... rhoExcessGradient_over_rho = 0.0_pReal forall (c = 1_pInt:2_pInt) & rhoTotal(c) = (sum(abs(rhoSgl(s,[2*c-1,2*c,2*c+3,2*c+4]))) + rhoDip(s,c) & @@ -1191,8 +1143,7 @@ if (.not. phase_localPlasticity(ph) .and. prm%shortRangeStressCorrection) then forall (c = 1_pInt:2_pInt, rhoTotal(c) > 0.0_pReal) & rhoExcessGradient_over_rho(c) = rhoExcessGradient(c) / rhoTotal(c) - !* gives the local stress correction when multiplied with a factor - + ! ... gives the local stress correction when multiplied with a factor dst%tau_back(s,of) = - prm%mu * prm%burgers(s) / (2.0_pReal * pi) & * (rhoExcessGradient_over_rho(1) / (1.0_pReal - prm%nu) & + rhoExcessGradient_over_rho(2)) @@ -1214,7 +1165,9 @@ plasticState(ph)%state(iRhoF(1:ns,instance),of) = rhoForest write(6,'(a,/,12x,12(f10.5,1x),/)') '<< CONST >> tauBack / MPa', dst%tau_back(:,of)*1e-6 endif #endif + end associate + end subroutine plastic_nonlocal_dependentState @@ -1223,13 +1176,6 @@ end subroutine plastic_nonlocal_dependentState !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, & tauThreshold, c, Temperature, ip, el) - -use debug, only: debug_level, & - debug_constitutive, & - debug_levelExtensive, & - debug_levelSelective, & - debug_i, & - debug_e use material, only: material_phase, & phase_plasticityInstance @@ -1358,11 +1304,7 @@ if (Temperature > 0.0_pReal) then endif -#ifdef DEBUG - if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip)& - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then - write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_kinetics at el ip',el,ip +#ifdef DEBUGTODO write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold * 1e-6_pReal write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tau / MPa', tau * 1e-6_pReal write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauNS / MPa', tauNS * 1e-6_pReal @@ -1381,15 +1323,15 @@ end subroutine plastic_nonlocal_kinetics subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, & Mp, Temperature, volume, ip, el) -use math, only: math_mul33xx33 -use material, only: material_phase, & + use math, only: & + math_mul33xx33 + use material, only: & + material_phase, & plasticState, & phaseAt, phasememberAt,& phase_plasticityInstance implicit none - - integer(pInt), intent(in) :: ip, & !< current integration point el !< current element number real(pReal), intent(in) :: Temperature, & !< temperature @@ -1426,8 +1368,6 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt ph = phaseAt(1_pInt,ip,el) of = phasememberAt(1_pInt,ip,el) - - instance = phase_plasticityInstance(ph) associate(prm => param(instance),dst=>microstructure(instance)) ns = prm%totalNslip @@ -1520,8 +1460,8 @@ enddo end associate -end subroutine plastic_nonlocal_LpAndItsTangent +end subroutine plastic_nonlocal_LpAndItsTangent !-------------------------------------------------------------------------------------------------- @@ -1537,7 +1477,7 @@ use debug, only: debug_level, & debug_levelSelective, & debug_i, & debug_e -use math, only: pi, & +use math, only: PI, & math_mul33xx33 use mesh, only: mesh_ipVolume use material, only: material_phase, & @@ -1713,14 +1653,15 @@ use prec, only: dNeq0, & dNeq, & dEq0 use IO, only: IO_error +#ifdef DEBUG use debug, only: debug_level, & debug_constitutive, & debug_levelBasic, & debug_levelExtensive, & debug_levelSelective, & - debug_g, & debug_i, & debug_e +#endif use math, only: math_mul3x3, & math_mul33x3, & math_mul33xx33, & @@ -1831,7 +1772,10 @@ logical considerEnteringFlux, & p = phaseAt(1,ip,el) o = phasememberAt(1,ip,el) - +if (timestep <= 0.0_pReal) then ! if illegal timestep... Why here and not on function entry?? + plasticState(p)%dotState = 0.0_pReal ! ...return without doing anything (-> zero dotState) + return +endif #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & @@ -1849,9 +1793,6 @@ tau = 0.0_pReal gdot = 0.0_pReal -!*** shortcut to state variables - - forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) rhoSgl(s,t) = max(plasticState(p)%state(iRhoU(s,t,instance),o), 0.0_pReal) ! ensure positive single mobile densities rhoSgl(s,t+4_pInt) = plasticState(p)%state(iRhoB(s,t,instance),o) @@ -1871,14 +1812,6 @@ where (abs(rhoDip) * mesh_ipVolume(ip,el) ** 0.667_pReal < prm%significantN & .or. abs(rhoDip) < prm%significantRho) & rhoDip = 0.0_pReal -!*** sanity check for timestep - -if (timestep <= 0.0_pReal) then ! if illegal timestep... Why here and not on function entry?? - plasticState(p)%dotState = 0.0_pReal ! ...return without doing anything (-> zero dotState) - return -endif - - !**************************************************************************** !*** Calculate shear rate @@ -2153,8 +2086,8 @@ forall (c=1_pInt:2_pInt) & + rhoDip(1:ns,c) * (abs(gdot(1:ns,2*c-1)) + abs(gdot(1:ns,2*c)))) ! single knocks dipole constituent ! annihilated screw dipoles leave edge jogs behind on the colinear system if (lattice_structure(ph) == LATTICE_fcc_ID) & ! only fcc - forall (s = 1:ns, colinearSystem(s,instance) > 0_pInt) & - rhoDotAthermalAnnihilation(colinearSystem(s,instance),1:2) = - rhoDotAthermalAnnihilation(s,10) & + forall (s = 1:ns, prm%colinearSystem(s) > 0_pInt) & + rhoDotAthermalAnnihilation(prm%colinearSystem(s),1:2) = - rhoDotAthermalAnnihilation(s,10) & * 0.25_pReal * sqrt(rhoForest(s)) * (dUpper(s,2) + dLower(s,2)) * prm%edgeJogFactor @@ -2194,7 +2127,7 @@ results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation #ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & - .and. ((debug_e == el .and. debug_i == ip .and. debug_g == 1_pInt)& + .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> dislocation multiplication', & rhoDotMultiplication(1:ns,1:4) * timestep From 6938864c4bb2b8bcd64e3d64f573b5f93dfe213a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Feb 2019 20:37:49 +0100 Subject: [PATCH 273/309] pointers allow easier access to state variables --- src/plastic_nonlocal.f90 | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 3777f2246..4c294db20 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -779,18 +779,27 @@ ns = param(instance)%totalNslip stt%rhoDipScrew => plasticState(p)%state (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) dot%rhoDipScrew => plasticState(p)%dotState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) del%rhoDipScrew => plasticState(p)%deltaState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) -plasticState(p)%aTolState(iGamma(1:ns,instance)) = prm%aTolShear + + s1 = 10_pInt*prm%totalNslip + 1_pInt + s2 = s1 + prm%totalNslip - 1_pInt + + stt%accumulatedshear => plasticState(p)%state (s1:s2,:) + dot%accumulatedshear => plasticState(p)%dotState (s1:s2,:) + del%accumulatedshear => plasticState(p)%deltaState (s1:s2,:) + plasticState(p)%aTolState(s1:s2) = prm%aTolShear + plasticState(p)%slipRate => plasticState(p)%dotState(s1:s2,1:NofMyPhase) + plasticState(p)%accumulatedSlip => plasticState(p)%state (s1:s2,1:NofMyPhase) allocate(dst%tau_Threshold(prm%totalNslip,NofMyPhase),source=0.0_pReal) allocate(dst%tau_Back(prm%totalNslip,NofMyPhase),source=0.0_pReal) - allocate(res%rhoDotFlux(prm%totalNslip,8,NofMyPhase)) - allocate(res%rhoDotMultiplication(prm%totalNslip,2,NofMyPhase)) - allocate(res%rhoDotSingle2DipoleGlide(prm%totalNslip,2,NofMyPhase)) - allocate(res%rhoDotAthermalAnnihilation(prm%totalNslip,2,NofMyPhase)) - allocate(res%rhoDotThermalAnnihilation(prm%totalNslip,2,NofMyPhase)) - allocate(res%rhoDotEdgeJogs(prm%totalNslip,NofMyPhase)) + allocate(res%rhoDotFlux(prm%totalNslip,8,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotMultiplication(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotSingle2DipoleGlide(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotAthermalAnnihilation(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotThermalAnnihilation(prm%totalNslip,2,NofMyPhase),source=0.0_pReal) + allocate(res%rhoDotEdgeJogs(prm%totalNslip,NofMyPhase),source=0.0_pReal) end associate From da8a1d59731a26969726bdedfe27ed3ff3f8318f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Feb 2019 21:32:22 +0100 Subject: [PATCH 274/309] leaner interface --- src/plastic_nonlocal.f90 | 41 ++++++++++++++++------------------------ 1 file changed, 16 insertions(+), 25 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 4c294db20..f0abdc179 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -20,7 +20,6 @@ module plastic_nonlocal character(len=64), dimension(:,:), allocatable, target, public :: & plastic_nonlocal_output !< name of each post result output - integer(pInt), dimension(:,:), allocatable, private :: & iGamma, & !< state indices for accumulated shear iRhoF !< state indices for forest density @@ -325,6 +324,7 @@ subroutine plastic_nonlocal_init stt => state(phase_plasticityInstance(p)), & del => deltaState(phase_plasticityInstance(p)), & res => results(phase_plasticityInstance(p)), & + dst => microstructure(phase_plasticityInstance(p)), & config => config_phase(p)) prm%aTolRho = config%getFloat('atol_rho', defaultVal=0.0_pReal) @@ -597,10 +597,12 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' 'velocityScrewPos ','velocityScrewNeg ', & 'maxDipoleHeightEdge ','maxDipoleHeightScrew' ]),pInt) * prm%totalNslip !< other dependent state variables that are not updated by microstructure sizeDeltaState = sizeDotState + call material_allocatePlasticState(p,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & prm%totalNslip,0_pInt,0_pInt) plasticState(p)%nonlocal = .true. plasticState(p)%offsetDeltaState = 0_pInt ! ToDo: state structure does not follow convention + plasticState(p)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,phase_plasticityInstance(p))) Nslip(1:size(prm%Nslip),phase_plasticityInstance(p)) = prm%Nslip ! ToDo: DEPRECATED totalNslip(phase_plasticityInstance(p)) = sum(Nslip(1:size(prm%Nslip),phase_plasticityInstance(p))) ! ToDo: DEPRECATED @@ -674,12 +676,6 @@ ns = param(instance)%totalNslip if (iD(ns,2,instance) /= plasticState(phase)%sizeState) & ! check if last index is equal to size of state call IO_error(0_pInt, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') - - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state (iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase) - endif myPhase2 @@ -698,9 +694,8 @@ ns = param(instance)%totalNslip config => config_phase(p)) NofMyPhase=count(material_phase==p) - - plasticState(p)%sizePostResults = sum(plastic_nonlocal_sizePostResult(:,instance)) - stt%rho => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) + + stt%rho => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) dot%rho => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) del%rho => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) plasticState(p)%aTolState(1:10_pInt*prm%totalNslip) = prm%aTolRho @@ -1184,29 +1179,28 @@ end subroutine plastic_nonlocal_dependentState !> @brief calculates kinetics !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, & - tauThreshold, c, Temperature, ip, el) + tauThreshold, c, Temperature, instance, of) + use material, only: material_phase, & phase_plasticityInstance implicit none -integer(pInt), intent(in) :: ip, & !< current integration point - el, & !< current element number - c !< dislocation character (1:edge, 2:screw) +integer(pInt), intent(in) :: c, & !< dislocation character (1:edge, 2:screw) + instance, of real(pReal), intent(in) :: Temperature !< temperature -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))), & +real(pReal), dimension(param(instance)%totalNslip), & intent(in) :: tau, & !< resolved external shear stress (without non Schmid effects) tauNS, & !< resolved external shear stress (including non Schmid effects) tauThreshold !< threshold shear stress -real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))), & +real(pReal), dimension(param(instance)%totalNslip), & intent(out) :: v, & !< velocity dv_dtau, & !< velocity derivative with respect to resolved shear stress (without non Schmid contributions) dv_dtauNS !< velocity derivative with respect to resolved shear stress (including non Schmid contributions) -integer(pInt) :: instance, & !< current instance of this plasticity - ns, & !< short notation for the total number of active slip systems +integer(pInt) :: ns, & !< short notation for the total number of active slip systems s !< index of my current slip system real(pReal) tauRel_P, & tauRel_S, & @@ -1230,11 +1224,8 @@ real(pReal) tauRel_P, & criticalStress_S, & !< maximum obstacle strength mobility !< dislocation mobility - -instance = phase_plasticityInstance(material_phase(1_pInt,ip,el)) -ns = totalNslip(instance) - associate(prm => param(instance)) +ns = prm%totalNslip v = 0.0_pReal dv_dtau = 0.0_pReal dv_dtauNS = 0.0_pReal @@ -1418,7 +1409,7 @@ tau = tau + dst%tau_back(:,of) ! edges call plastic_nonlocal_kinetics(v(1:ns,1), dv_dtau(1:ns,1), dv_dtauNS(1:ns,1), & tau(1:ns), tauNS(1:ns,1), dst%tau_Threshold(1:ns,of), & - 1_pInt, Temperature, ip, el) + 1_pInt, Temperature, instance, of) v(1:ns,2) = v(1:ns,1) dv_dtau(1:ns,2) = dv_dtau(1:ns,1) dv_dtauNS(1:ns,2) = dv_dtauNS(1:ns,1) @@ -1434,7 +1425,7 @@ else do t = 3_pInt,4_pInt call plastic_nonlocal_kinetics(v(1:ns,t), dv_dtau(1:ns,t), dv_dtauNS(1:ns,t), & tau(1:ns), tauNS(1:ns,t), dst%tau_Threshold(1:ns,of), & - 2_pInt , Temperature, ip, el) + 2_pInt , Temperature, instance, of) enddo endif @@ -1795,7 +1786,7 @@ endif ph = material_phase(1_pInt,ip,el) instance = phase_plasticityInstance(ph) -associate(prm => param(instance),dst => microstructure(instance)) +associate(prm => param(instance),dst => microstructure(instance),dot => dotState(instance)) ns = totalNslip(instance) tau = 0.0_pReal From beb73c78821485f3aa48480901a574295e89b754 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Feb 2019 07:37:08 +0100 Subject: [PATCH 275/309] not needed --- src/constitutive.f90 | 2 +- src/plastic_nonlocal.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e5dc6a1cc..b51ba27bf 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -882,7 +882,7 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, subfracA case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_dotState (Mp,FeArray,FpArray,temperature(ho)%p(tme), & - subdt,subfracArray,ip,el) + subdt,ip,el) end select plasticityType SourceLoop: do i = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index f0abdc179..8bac6f7a3 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -1646,7 +1646,7 @@ end subroutine plastic_nonlocal_deltaState !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & - timestep,subfrac, ip,el) + timestep,ip,el) use, intrinsic :: & IEEE_arithmetic use prec, only: dNeq0, & From 5e369aa2208a820caac0da7df9160ebfb9a4b225 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Feb 2019 08:32:12 +0100 Subject: [PATCH 276/309] avoid use of new variables in deprecated code --- src/plastic_nonlocal.f90 | 65 +++++++++++++++++----------------------- 1 file changed, 27 insertions(+), 38 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 8bac6f7a3..0a0bae79b 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -272,13 +272,9 @@ subroutine plastic_nonlocal_init real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] integer(pInt) :: & - ns, phase, & maxNinstances, & - maxTotalNslip, p, i, & - f, & ! index of my slip family - instance, & ! index of my instance of this plasticity + p, i, & l, & - o, & ! index of my output s, & ! index of my slip system s1, & ! index of my slip system s2, & ! index of my slip system @@ -612,68 +608,64 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' enddo ! BEGIN DEPRECATED---------------------------------------------------------------------------------- - maxTotalNslip = maxval(totalNslip) - allocate(iRhoU(maxTotalNslip,4,maxNinstances), source=0_pInt) - allocate(iRhoB(maxTotalNslip,4,maxNinstances), source=0_pInt) - allocate(iRhoD(maxTotalNslip,2,maxNinstances), source=0_pInt) - allocate(iV(maxTotalNslip,4,maxNinstances), source=0_pInt) - allocate(iD(maxTotalNslip,2,maxNinstances), source=0_pInt) - allocate(iGamma(maxTotalNslip,maxNinstances), source=0_pInt) - allocate(iRhoF(maxTotalNslip,maxNinstances), source=0_pInt) + allocate(iRhoU(maxval(totalNslip),4,maxNinstances), source=0_pInt) + allocate(iRhoB(maxval(totalNslip),4,maxNinstances), source=0_pInt) + allocate(iRhoD(maxval(totalNslip),2,maxNinstances), source=0_pInt) + allocate(iV(maxval(totalNslip),4,maxNinstances), source=0_pInt) + allocate(iD(maxval(totalNslip),2,maxNinstances), source=0_pInt) + allocate(iGamma(maxval(totalNslip),maxNinstances), source=0_pInt) + allocate(iRhoF(maxval(totalNslip),maxNinstances), source=0_pInt) ! END DEPRECATED------------------------------------------------------------------------------------ -allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & +allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) - initializeInstances: do phase = 1_pInt, size(phase_plasticity) - NofMyPhase=count(material_phase==phase) - myPhase2: if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then - instance = phase_plasticityInstance(phase) -ns = param(instance)%totalNslip - + initializeInstances: do p = 1_pInt, size(phase_plasticity) + NofMyPhase=count(material_phase==p) + myPhase2: if (phase_plasticity(p) == PLASTICITY_NONLOCAL_ID) then !*** determine indices to state array l = 0_pInt do t = 1_pInt,4_pInt - do s = 1_pInt,ns + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip l = l + 1_pInt - iRhoU(s,t,instance) = l + iRhoU(s,t,phase_plasticityInstance(p)) = l enddo enddo do t = 1_pInt,4_pInt - do s = 1_pInt,ns + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip l = l + 1_pInt - iRhoB(s,t,instance) = l + iRhoB(s,t,phase_plasticityInstance(p)) = l enddo enddo do c = 1_pInt,2_pInt - do s = 1_pInt,ns + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip l = l + 1_pInt - iRhoD(s,c,instance) = l + iRhoD(s,c,phase_plasticityInstance(p)) = l enddo enddo - do s = 1_pInt,ns + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip l = l + 1_pInt - iGamma(s,instance) = l + iGamma(s,phase_plasticityInstance(p)) = l enddo - do s = 1_pInt,ns + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip l = l + 1_pInt - iRhoF(s,instance) = l + iRhoF(s,phase_plasticityInstance(p)) = l enddo do t = 1_pInt,4_pInt - do s = 1_pInt,ns + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip l = l + 1_pInt - iV(s,t,instance) = l + iV(s,t,phase_plasticityInstance(p)) = l enddo enddo do c = 1_pInt,2_pInt - do s = 1_pInt,ns + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip l = l + 1_pInt - iD(s,c,instance) = l + iD(s,c,phase_plasticityInstance(p)) = l enddo enddo - if (iD(ns,2,instance) /= plasticState(phase)%sizeState) & ! check if last index is equal to size of state + if (iD(param(phase_plasticityInstance(p))%totalNslip,2,phase_plasticityInstance(p)) /= plasticState(p)%sizeState) & ! check if last index is equal to size of state call IO_error(0_pInt, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') @@ -684,7 +676,6 @@ ns = param(instance)%totalNslip do p=1_pInt, size(config_phase) if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle - instance = phase_plasticityInstance(p) associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & stt => state(phase_plasticityInstance(p)), & @@ -1694,8 +1685,6 @@ integer(pInt), intent(in) :: ip, & real(pReal), intent(in) :: Temperature, & !< temperature timestep !< substepped crystallite time increment real(pReal), dimension(3,3), intent(in) :: Mp !< MandelStress -real(pReal), dimension(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & - subfrac !< fraction of timestep at the beginning of the substepped crystallite time increment real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & Fe, & !< elastic deformation gradient Fp !< plastic deformation gradient From 4d45038358f0895bb926f3875f3b7a6c6721a6fc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Feb 2019 09:21:04 +0100 Subject: [PATCH 277/309] better readable --- src/plastic_nonlocal.f90 | 29 ++++++++++------------------- 1 file changed, 10 insertions(+), 19 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 0a0bae79b..68e059508 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -275,9 +275,8 @@ subroutine plastic_nonlocal_init maxNinstances, & p, i, & l, & + s1, s2, & s, & ! index of my slip system - s1, & ! index of my slip system - s2, & ! index of my slip system t, & ! index of dislocation type c ! index of dislocation character @@ -766,15 +765,12 @@ allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPn dot%rhoDipScrew => plasticState(p)%dotState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) del%rhoDipScrew => plasticState(p)%deltaState (9_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) - s1 = 10_pInt*prm%totalNslip + 1_pInt - s2 = s1 + prm%totalNslip - 1_pInt - - stt%accumulatedshear => plasticState(p)%state (s1:s2,:) - dot%accumulatedshear => plasticState(p)%dotState (s1:s2,:) - del%accumulatedshear => plasticState(p)%deltaState (s1:s2,:) - plasticState(p)%aTolState(s1:s2) = prm%aTolShear - plasticState(p)%slipRate => plasticState(p)%dotState(s1:s2,1:NofMyPhase) - plasticState(p)%accumulatedSlip => plasticState(p)%state (s1:s2,1:NofMyPhase) + stt%accumulatedshear => plasticState(p)%state (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) + dot%accumulatedshear => plasticState(p)%dotState (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) + del%accumulatedshear => plasticState(p)%deltaState (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) + plasticState(p)%aTolState(10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ) = prm%aTolShear + plasticState(p)%slipRate => plasticState(p)%dotState(10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) + plasticState(p)%accumulatedSlip => plasticState(p)%state (10_pInt*prm%totalNslip + 1_pInt:11_pInt*prm%totalNslip ,1:NofMyPhase) allocate(dst%tau_Threshold(prm%totalNslip,NofMyPhase),source=0.0_pReal) @@ -1172,12 +1168,7 @@ end subroutine plastic_nonlocal_dependentState subroutine plastic_nonlocal_kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, & tauThreshold, c, Temperature, instance, of) -use material, only: material_phase, & - phase_plasticityInstance - implicit none - - integer(pInt), intent(in) :: c, & !< dislocation character (1:edge, 2:screw) instance, of real(pReal), intent(in) :: Temperature !< temperature @@ -2156,7 +2147,7 @@ else forall (s = 1:ns, c = 1_pInt:2_pInt) & plasticState(p)%dotState(iRhoD(s,c,instance),o) = rhoDot(s,c+8_pInt) forall (s = 1:ns) & - plasticState(p)%dotState(iGamma(s,instance),o) = sum(gdot(s,1:4)) + dot%accumulatedshear(s,o) = sum(gdot(s,1:4)) endif end associate end subroutine plastic_nonlocal_dotState @@ -2380,7 +2371,7 @@ ns = totalNslip(instance) cs = 0_pInt -associate(prm => param(instance),dst => microstructure(instance)) +associate(prm => param(instance),dst => microstructure(instance),stt=>state(instance)) !* short hand notations for state variables forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) @@ -2583,7 +2574,7 @@ outputsLoop: do o = 1_pInt,size(param(instance)%outputID) cs = cs + ns case(accumulatedshear_ID) - postResults(cs+1_pInt:cs+ns) = plasticState(ph)%state(iGamma(1:ns,instance),of) + postResults(cs+1_pInt:cs+ns) = stt%accumulatedshear(:,of) cs = cs + ns end select From db9016d146b622a103f2f40eaba6bca87eb56ba9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Feb 2019 10:02:43 +0100 Subject: [PATCH 278/309] avoid repeated loops --- src/plastic_nonlocal.f90 | 151 +++++++++++++++++---------------------- 1 file changed, 66 insertions(+), 85 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 68e059508..eb3e4e694 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -21,7 +21,6 @@ module plastic_nonlocal plastic_nonlocal_output !< name of each post result output integer(pInt), dimension(:,:), allocatable, private :: & - iGamma, & !< state indices for accumulated shear iRhoF !< state indices for forest density integer(pInt), dimension(:,:,:), allocatable, private :: & iRhoU, & !< state indices for unblocked density @@ -602,89 +601,7 @@ extmsg = trim(extmsg)//' fEdgeMultiplication' Nslip(1:size(prm%Nslip),phase_plasticityInstance(p)) = prm%Nslip ! ToDo: DEPRECATED totalNslip(phase_plasticityInstance(p)) = sum(Nslip(1:size(prm%Nslip),phase_plasticityInstance(p))) ! ToDo: DEPRECATED - end associate - - enddo - -! BEGIN DEPRECATED---------------------------------------------------------------------------------- - allocate(iRhoU(maxval(totalNslip),4,maxNinstances), source=0_pInt) - allocate(iRhoB(maxval(totalNslip),4,maxNinstances), source=0_pInt) - allocate(iRhoD(maxval(totalNslip),2,maxNinstances), source=0_pInt) - allocate(iV(maxval(totalNslip),4,maxNinstances), source=0_pInt) - allocate(iD(maxval(totalNslip),2,maxNinstances), source=0_pInt) - allocate(iGamma(maxval(totalNslip),maxNinstances), source=0_pInt) - allocate(iRhoF(maxval(totalNslip),maxNinstances), source=0_pInt) -! END DEPRECATED------------------------------------------------------------------------------------ - -allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & - source=0.0_pReal) - - initializeInstances: do p = 1_pInt, size(phase_plasticity) - NofMyPhase=count(material_phase==p) - myPhase2: if (phase_plasticity(p) == PLASTICITY_NONLOCAL_ID) then - - !*** determine indices to state array - - l = 0_pInt - do t = 1_pInt,4_pInt - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt - iRhoU(s,t,phase_plasticityInstance(p)) = l - enddo - enddo - do t = 1_pInt,4_pInt - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt - iRhoB(s,t,phase_plasticityInstance(p)) = l - enddo - enddo - do c = 1_pInt,2_pInt - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt - iRhoD(s,c,phase_plasticityInstance(p)) = l - enddo - enddo - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt - iGamma(s,phase_plasticityInstance(p)) = l - enddo - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt - iRhoF(s,phase_plasticityInstance(p)) = l - enddo - do t = 1_pInt,4_pInt - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt - iV(s,t,phase_plasticityInstance(p)) = l - enddo - enddo - do c = 1_pInt,2_pInt - do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip - l = l + 1_pInt - iD(s,c,phase_plasticityInstance(p)) = l - enddo - enddo - if (iD(param(phase_plasticityInstance(p))%totalNslip,2,phase_plasticityInstance(p)) /= plasticState(p)%sizeState) & ! check if last index is equal to size of state - call IO_error(0_pInt, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') - - - endif myPhase2 - - enddo initializeInstances - - - do p=1_pInt, size(config_phase) - if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle - associate(prm => param(phase_plasticityInstance(p)), & - dot => dotState(phase_plasticityInstance(p)), & - stt => state(phase_plasticityInstance(p)), & - del => deltaState(phase_plasticityInstance(p)), & - res => results(phase_plasticityInstance(p)), & - dst => microstructure(phase_plasticityInstance(p)), & - config => config_phase(p)) - NofMyPhase=count(material_phase==p) - - + ! ToDo: Not really sure if this large number of mostly overlapping pointers is useful stt%rho => plasticState(p)%state (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) dot%rho => plasticState(p)%dotState (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) del%rho => plasticState(p)%deltaState (0_pInt*prm%totalNslip+1_pInt:10_pInt*prm%totalNslip,:) @@ -787,7 +704,71 @@ allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPn if (NofMyPhase > 0_pInt) call stateInit(p,NofMyPhase) plasticState(p)%state0 = plasticState(p)%state - enddo + + enddo + +! BEGIN DEPRECATED---------------------------------------------------------------------------------- + allocate(iRhoU(maxval(totalNslip),4,maxNinstances), source=0_pInt) + allocate(iRhoB(maxval(totalNslip),4,maxNinstances), source=0_pInt) + allocate(iRhoD(maxval(totalNslip),2,maxNinstances), source=0_pInt) + allocate(iV(maxval(totalNslip),4,maxNinstances), source=0_pInt) + allocate(iD(maxval(totalNslip),2,maxNinstances), source=0_pInt) + allocate(iRhoF(maxval(totalNslip),maxNinstances), source=0_pInt) +! END DEPRECATED------------------------------------------------------------------------------------ + +allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & + source=0.0_pReal) + + initializeInstances: do p = 1_pInt, size(phase_plasticity) + NofMyPhase=count(material_phase==p) + myPhase2: if (phase_plasticity(p) == PLASTICITY_NONLOCAL_ID) then + + !*** determine indices to state array + + l = 0_pInt + do t = 1_pInt,4_pInt + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip + l = l + 1_pInt + iRhoU(s,t,phase_plasticityInstance(p)) = l + enddo + enddo + do t = 1_pInt,4_pInt + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip + l = l + 1_pInt + iRhoB(s,t,phase_plasticityInstance(p)) = l + enddo + enddo + do c = 1_pInt,2_pInt + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip + l = l + 1_pInt + iRhoD(s,c,phase_plasticityInstance(p)) = l + enddo + enddo + l = l + param(phase_plasticityInstance(p))%totalNslip + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip + l = l + 1_pInt + iRhoF(s,phase_plasticityInstance(p)) = l + enddo + do t = 1_pInt,4_pInt + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip + l = l + 1_pInt + iV(s,t,phase_plasticityInstance(p)) = l + enddo + enddo + do c = 1_pInt,2_pInt + do s = 1_pInt,param(phase_plasticityInstance(p))%totalNslip + l = l + 1_pInt + iD(s,c,phase_plasticityInstance(p)) = l + enddo + enddo + if (iD(param(phase_plasticityInstance(p))%totalNslip,2,phase_plasticityInstance(p)) /= plasticState(p)%sizeState) & ! check if last index is equal to size of state + call IO_error(0_pInt, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') + + + endif myPhase2 + + enddo initializeInstances + contains From 43376c39d8cc705c313f863945bd4ef8349f531c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Feb 2019 11:25:39 +0100 Subject: [PATCH 279/309] addGrainID parses in quaternion --- python/damask/orientation.py | 1 + 1 file changed, 1 insertion(+) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 03c69291f..3ab7cd044 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -944,6 +944,7 @@ class Symmetry: def inFZ(self,R): """Check whether given Rodrigues vector falls into fundamental zone of own symmetry.""" + if isinstance(R, Quaternion): R = R.asRodrigues() # translate accidentally passed quaternion # fundamental zone in Rodrigues space is point symmetric around origin if R.shape[0]==4: # transition old (length not stored separately) to new From af4ea76006177a23f1d58dc68b5ccabc4ce8a87a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Feb 2019 15:21:48 +0100 Subject: [PATCH 280/309] using central allocation facilities --- src/source_thermal_externalheat.f90 | 39 ++++------------------------- 1 file changed, 5 insertions(+), 34 deletions(-) diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index eac1232f3..724d36f17 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -57,11 +57,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_thermal_externalheat_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use debug, only: & debug_level,& debug_constitutive,& @@ -77,9 +72,9 @@ subroutine source_thermal_externalheat_init(fileUnit) IO_intValue, & IO_warning, & IO_error, & - IO_timeStamp, & IO_EOF use material, only: & + material_allocateSourceState, & phase_source, & phase_Nsources, & phase_Noutput, & @@ -91,8 +86,6 @@ subroutine source_thermal_externalheat_init(fileUnit) config_phase, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - numerics_integrator implicit none integer(pInt), intent(in) :: fileUnit @@ -107,8 +100,7 @@ subroutine source_thermal_externalheat_init(fileUnit) real(pReal), allocatable, dimension(:,:) :: temp_time, temp_rate write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" + maxNinstance = int(count(phase_source == SOURCE_thermal_externalheat_ID),pInt) if (maxNinstance == 0_pInt) return @@ -196,35 +188,14 @@ subroutine source_thermal_externalheat_init(fileUnit) source_thermal_externalheat_rate(instance,1:source_thermal_externalheat_nIntervals(instance)+1_pInt) = & temp_rate(instance,1:source_thermal_externalheat_nIntervals(instance)+1_pInt) - sizeDotState = 1_pInt - sizeDeltaState = 0_pInt - sizeState = 1_pInt - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState - sourceState(phase)%p(sourceOffset)%sizePostResults = source_thermal_externalheat_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.00001_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) - + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) + endif enddo initializeInstances end subroutine source_thermal_externalheat_init + !-------------------------------------------------------------------------------------------------- !> @brief rate of change of state !> @details state only contains current time to linearly interpolate given heat powers From e7268ce109da3bb5e149d05681b68291927fb899 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Feb 2019 15:37:42 +0100 Subject: [PATCH 281/309] simpler structure: - do not read file - use function for allocation - do not constantly convert (3,3) <-> (6) --- src/constitutive.f90 | 12 +-- src/source_thermal_dissipation.f90 | 133 ++++++----------------------- src/thermal_adiabatic.f90 | 16 ++-- src/thermal_conduction.f90 | 16 +--- 4 files changed, 35 insertions(+), 142 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 2fba40328..48d4a3f8f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -38,11 +38,6 @@ contains !> @brief allocates arrays pointing to array of the various constitutive modules !-------------------------------------------------------------------------------------------------- subroutine constitutive_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use prec, only: & pReal use debug, only: & @@ -55,8 +50,7 @@ subroutine constitutive_init() IO_open_file, & IO_checkAndRewind, & IO_open_jobFile_stat, & - IO_write_jobFile, & - IO_timeStamp + IO_write_jobFile use config, only: & config_phase use config, only: & @@ -158,7 +152,7 @@ subroutine constitutive_init() !-------------------------------------------------------------------------------------------------- ! parse source mechanisms from config file call IO_checkAndRewind(FILEUNIT) - if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init(FILEUNIT) + if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init(FILEUNIT) if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init @@ -176,8 +170,6 @@ subroutine constitutive_init() call config_deallocate('material.config/phase') write(6,'(/,a)') ' <<<+- constitutive init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" mainProcess: if (worldrank == 0) then !-------------------------------------------------------------------------------------------------- diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 290ad7efe..ef0843239 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -47,30 +47,13 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_thermal_dissipation_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif +subroutine source_thermal_dissipation_init use debug, only: & debug_level,& debug_constitutive,& debug_levelBasic - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF use material, only: & + material_allocateSourceState, & phase_source, & phase_Nsources, & phase_Noutput, & @@ -82,23 +65,13 @@ subroutine source_thermal_dissipation_init(fileUnit) config_phase, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - numerics_integrator implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Ninstance,phase,instance,source,sourceOffset - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState + integer(pInt) :: Ninstance,instance,source,sourceOffset integer(pInt) :: NofMyPhase,p - character(len=65536) :: & - tag = '', & - line = '' write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_dissipation_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" + Ninstance = int(count(phase_source == SOURCE_thermal_dissipation_ID),pInt) if (Ninstance == 0_pInt) return @@ -107,11 +80,11 @@ subroutine source_thermal_dissipation_init(fileUnit) allocate(source_thermal_dissipation_offset(material_Nphase), source=0_pInt) allocate(source_thermal_dissipation_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - source_thermal_dissipation_instance(phase) = count(phase_source(:,1:phase) == SOURCE_thermal_dissipation_ID) - do source = 1, phase_Nsources(phase) - if (phase_source(source,phase) == SOURCE_thermal_dissipation_ID) & - source_thermal_dissipation_offset(phase) = source + do p = 1, material_Nphase + source_thermal_dissipation_instance(p) = count(phase_source(:,1:p) == SOURCE_thermal_dissipation_ID) + do source = 1, phase_Nsources(p) + if (phase_source(source,p) == SOURCE_thermal_dissipation_ID) & + source_thermal_dissipation_offset(p) = source enddo enddo @@ -124,88 +97,31 @@ subroutine source_thermal_dissipation_init(fileUnit) allocate(source_thermal_dissipation_coldworkCoeff(Ninstance), source=0.0_pReal) do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_thermal_dissipation_ID)) cycle + if (all(phase_source(:,p) /= SOURCE_THERMAL_DISSIPATION_ID)) cycle + instance = source_thermal_dissipation_instance(p) + source_thermal_dissipation_coldworkCoeff(instance) = config_phase(p)%getFloat('dissipation_coldworkcoeff') + NofMyPhase=count(material_phase==p) + sourceOffset = source_thermal_dissipation_offset(p) + + call material_allocateSourceState(p,sourceOffset,NofMyPhase,0_pInt,0_pInt,0_pInt) + enddo - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_thermal_dissipation_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = source_thermal_dissipation_instance(phase) ! which instance of my source is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('dissipation_coldworkcoeff') - source_thermal_dissipation_coldworkCoeff(instance) = IO_floatValue(line,chunkPos,2_pInt) - - end select - endif; endif - enddo parsingFile - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_thermal_dissipation_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_thermal_dissipation_instance(phase) - sourceOffset = source_thermal_dissipation_offset(phase) - - sizeDotState = 0_pInt - sizeDeltaState = 0_pInt - sizeState = 0_pInt - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState - sourceState(phase)%p(sourceOffset)%sizePostResults = source_thermal_dissipation_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) - - endif - - enddo initializeInstances + end subroutine source_thermal_dissipation_init + !-------------------------------------------------------------------------------------------------- !> @brief returns local vacancy generation rate !-------------------------------------------------------------------------------------------------- -subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDOT_dT, Tstar_v, Lp, phase, constituent) +subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDOT_dT, Tstar, Lp, phase) use math, only: & math_Mandel6to33 implicit none integer(pInt), intent(in) :: & - phase, & - constituent - real(pReal), intent(in), dimension(6) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel) + phase + real(pReal), intent(in), dimension(3,3) :: & + Tstar !< 2nd Piola Kirchhoff stress tensor (Mandel) real(pReal), intent(in), dimension(3,3) :: & Lp real(pReal), intent(out) :: & @@ -216,8 +132,7 @@ subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDOT_dT, Tstar instance = source_thermal_dissipation_instance(phase) - TDot = source_thermal_dissipation_coldworkCoeff(instance)* & - sum(abs(math_Mandel6to33(Tstar_v)*Lp)) + TDot = source_thermal_dissipation_coldworkCoeff(instance)*sum(abs(Tstar*Lp)) dTDOT_dT = 0.0_pReal end subroutine source_thermal_dissipation_getRateAndItsTangent diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 937c20275..947e28777 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -43,14 +43,8 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use IO, only: & - IO_error, & - IO_timeStamp + IO_error use material, only: & thermal_type, & thermal_typeInstance, & @@ -76,8 +70,6 @@ subroutine thermal_adiabatic_init character(len=65536), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_ADIABATIC_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" maxNinstance = int(count(thermal_type == THERMAL_adiabatic_ID),pInt) if (maxNinstance == 0_pInt) return @@ -174,6 +166,8 @@ end function thermal_adiabatic_updateState !> @brief returns heat generation rate !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) + use math, only: & + math_6toSym33 use material, only: & homogenization_Ngrains, & mappingHomogenization, & @@ -222,9 +216,9 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) select case(phase_source(source,phase)) case (SOURCE_thermal_dissipation_ID) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - crystallite_Tstar_v(1:6,grain,ip,el), & + math_6toSym33(crystallite_Tstar_v(1:6,grain,ip,el)), & crystallite_Lp(1:3,1:3,grain,ip,el), & - phase, constituent) + phase) case (SOURCE_thermal_externalheat_ID) call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index ab1b030c8..3d5ca892e 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -44,14 +44,8 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine thermal_conduction_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif use IO, only: & - IO_error, & - IO_timeStamp + IO_error use material, only: & thermal_type, & thermal_typeInstance, & @@ -77,8 +71,6 @@ subroutine thermal_conduction_init character(len=65536), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_CONDUCTION_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" maxNinstance = int(count(thermal_type == THERMAL_conduction_ID),pInt) if (maxNinstance == 0_pInt) return @@ -130,7 +122,7 @@ end subroutine thermal_conduction_init !-------------------------------------------------------------------------------------------------- subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) use math, only: & - math_Mandel6to33 + math_6toSym33 use material, only: & homogenization_Ngrains, & mappingHomogenization, & @@ -181,9 +173,9 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) select case(phase_source(source,phase)) case (SOURCE_thermal_dissipation_ID) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - crystallite_Tstar_v(1:6,grain,ip,el), & + math_6toSym33(crystallite_Tstar_v(1:6,grain,ip,el)), & crystallite_Lp(1:3,1:3,grain,ip,el), & - phase, constituent) + phase) case (SOURCE_thermal_externalheat_ID) call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & From 194824fd0fa25a581586428c9630797c36429c85 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Feb 2019 20:37:41 +0100 Subject: [PATCH 282/309] WIP: cleaned no file reading getting rid of a number of obsolete dependencies --- src/constitutive.f90 | 2 +- src/crystallite.f90 | 2 +- src/kinematics_thermal_expansion.f90 | 229 ++++++++++++----------- src/material.f90 | 8 +- src/numerics.f90 | 10 +- src/source_thermal_dissipation.f90 | 1 + src/source_thermal_externalheat.f90 | 270 ++++++++++----------------- src/thermal_adiabatic.f90 | 2 - src/thermal_conduction.f90 | 2 - 9 files changed, 225 insertions(+), 301 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 48d4a3f8f..a340d0adf 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -153,7 +153,7 @@ subroutine constitutive_init() ! parse source mechanisms from config file call IO_checkAndRewind(FILEUNIT) if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init - if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init(FILEUNIT) + if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init diff --git a/src/crystallite.f90 b/src/crystallite.f90 index c272abd07..ec9c782ea 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -248,7 +248,7 @@ subroutine crystallite_init allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), & size(config_crystallite)), source=0_pInt) - select case(numerics_integrator(1)) + select case(numerics_integrator) case(1_pInt) integrateState => integrateStateFPI case(2_pInt) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index a44bc6902..56caa6e4b 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -4,21 +4,24 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module kinematics_thermal_expansion - use prec, only: & - pReal, & - pInt + use prec, only: & + pReal, & + pInt - implicit none - private + implicit none + private - !type, private :: tParameters - ! real(pReal), allocatable, dimension(:) :: & - !end type tParameters + type, private :: tParameters + real(pReal), allocatable, dimension(:,:,:) :: & + expansion + end type tParameters - public :: & - kinematics_thermal_expansion_init, & - kinematics_thermal_expansion_initialStrain, & - kinematics_thermal_expansion_LiAndItsTangent + type(tParameters), dimension(:), allocatable :: param + + public :: & + kinematics_thermal_expansion_init, & + kinematics_thermal_expansion_initialStrain, & + kinematics_thermal_expansion_LiAndItsTangent contains @@ -28,120 +31,128 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine kinematics_thermal_expansion_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use IO, only: & - IO_timeStamp - use material, only: & - phase_kinematics, & - KINEMATICS_thermal_expansion_label, & - KINEMATICS_thermal_expansion_ID - use config, only: & - config_phase - - implicit none - integer(pInt) :: & - Ninstance, & - p + use debug, only: & + debug_level,& + debug_constitutive,& + debug_levelBasic + use material, only: & + phase_kinematics, & + KINEMATICS_thermal_expansion_label, & + KINEMATICS_thermal_expansion_ID + use config, only: & + config_phase - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - Ninstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt) - if (Ninstance == 0_pInt) return + implicit none + integer(pInt) :: & + Ninstance, & + p, i + real(pReal), dimension(:), allocatable :: & + temp + + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - - do p = 1_pInt, size(phase_kinematics) - if (all(phase_kinematics(:,p) /= KINEMATICS_thermal_expansion_ID)) cycle - enddo + Ninstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt) + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + + allocate(param(Ninstance)) + + do p = 1_pInt, size(phase_kinematics) + if (all(phase_kinematics(:,p) /= KINEMATICS_thermal_expansion_ID)) cycle + + ! ToDo: Here we need to decide how to extend the concept of instances to + ! kinetics and sources. I would suggest that the same mechanism exists at maximum once per phase + + ! read up to three parameters (constant, linear, quadratic with T) + temp = config_phase(p)%getFloats('thermal_expansion11') + !lattice_thermalExpansion33(1,1,1:size(temp),p) = temp + temp = config_phase(p)%getFloats('thermal_expansion22', & + defaultVal=[(0.0_pReal, i=1,size(temp))],requiredSize=size(temp)) + !lattice_thermalExpansion33(2,2,1:size(temp),p) = temp + temp = config_phase(p)%getFloats('thermal_expansion33', & + defaultVal=[(0.0_pReal, i=1,size(temp))],requiredSize=size(temp)) + enddo end subroutine kinematics_thermal_expansion_init + !-------------------------------------------------------------------------------------------------- !> @brief report initial thermal strain based on current temperature deviation from reference !-------------------------------------------------------------------------------------------------- pure function kinematics_thermal_expansion_initialStrain(homog,phase,offset) - use material, only: & - temperature - use lattice, only: & - lattice_thermalExpansion33, & - lattice_referenceTemperature + use material, only: & + temperature + use lattice, only: & + lattice_thermalExpansion33, & + lattice_referenceTemperature + + implicit none + integer(pInt), intent(in) :: & + phase, & + homog, offset + real(pReal), dimension(3,3) :: & + kinematics_thermal_expansion_initialStrain !< initial thermal strain (should be small strain, though) - implicit none - integer(pInt), intent(in) :: & - phase, & - homog, offset - real(pReal), dimension(3,3) :: & - kinematics_thermal_expansion_initialStrain !< initial thermal strain (should be small strain, though) - - - kinematics_thermal_expansion_initialStrain = & - (temperature(homog)%p(offset) - lattice_referenceTemperature(phase))**1 / 1. * & - lattice_thermalExpansion33(1:3,1:3,1,phase) + & ! constant coefficient - (temperature(homog)%p(offset) - lattice_referenceTemperature(phase))**2 / 2. * & - lattice_thermalExpansion33(1:3,1:3,2,phase) + & ! linear coefficient - (temperature(homog)%p(offset) - lattice_referenceTemperature(phase))**3 / 3. * & - lattice_thermalExpansion33(1:3,1:3,3,phase) ! quadratic coefficient + + kinematics_thermal_expansion_initialStrain = & + (temperature(homog)%p(offset) - lattice_referenceTemperature(phase))**1 / 1. * & + lattice_thermalExpansion33(1:3,1:3,1,phase) + & ! constant coefficient + (temperature(homog)%p(offset) - lattice_referenceTemperature(phase))**2 / 2. * & + lattice_thermalExpansion33(1:3,1:3,2,phase) + & ! linear coefficient + (temperature(homog)%p(offset) - lattice_referenceTemperature(phase))**3 / 3. * & + lattice_thermalExpansion33(1:3,1:3,3,phase) ! quadratic coefficient end function kinematics_thermal_expansion_initialStrain + !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el) - use material, only: & - material_phase, & - material_homog, & - temperature, & - temperatureRate, & - thermalMapping - use lattice, only: & - lattice_thermalExpansion33, & - lattice_referenceTemperature - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(out), dimension(3,3) :: & - Li !< thermal velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) - integer(pInt) :: & - phase, & - homog, offset - real(pReal) :: & - T, TRef, TDot - - phase = material_phase(ipc,ip,el) - homog = material_homog(ip,el) - offset = thermalMapping(homog)%p(ip,el) - T = temperature(homog)%p(offset) - TDot = temperatureRate(homog)%p(offset) - TRef = lattice_referenceTemperature(phase) - - Li = TDot * ( & - lattice_thermalExpansion33(1:3,1:3,1,phase)*(T - TRef)**0 & ! constant coefficient - + lattice_thermalExpansion33(1:3,1:3,2,phase)*(T - TRef)**1 & ! linear coefficient - + lattice_thermalExpansion33(1:3,1:3,3,phase)*(T - TRef)**2 & ! quadratic coefficient - ) / & - (1.0_pReal & - + lattice_thermalExpansion33(1:3,1:3,1,phase)*(T - TRef)**1 / 1. & - + lattice_thermalExpansion33(1:3,1:3,2,phase)*(T - TRef)**2 / 2. & - + lattice_thermalExpansion33(1:3,1:3,3,phase)*(T - TRef)**3 / 3. & - ) - dLi_dTstar = 0.0_pReal + use material, only: & + material_phase, & + material_homog, & + temperature, & + temperatureRate, & + thermalMapping + use lattice, only: & + lattice_thermalExpansion33, & + lattice_referenceTemperature + + implicit none + integer(pInt), intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(out), dimension(3,3) :: & + Li !< thermal velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) + integer(pInt) :: & + phase, & + homog, offset + real(pReal) :: & + T, TRef, TDot + + phase = material_phase(ipc,ip,el) + homog = material_homog(ip,el) + offset = thermalMapping(homog)%p(ip,el) + T = temperature(homog)%p(offset) + TDot = temperatureRate(homog)%p(offset) + TRef = lattice_referenceTemperature(phase) + + Li = TDot * ( & + lattice_thermalExpansion33(1:3,1:3,1,phase)*(T - TRef)**0 & ! constant coefficient + + lattice_thermalExpansion33(1:3,1:3,2,phase)*(T - TRef)**1 & ! linear coefficient + + lattice_thermalExpansion33(1:3,1:3,3,phase)*(T - TRef)**2 & ! quadratic coefficient + ) / & + (1.0_pReal & + + lattice_thermalExpansion33(1:3,1:3,1,phase)*(T - TRef)**1 / 1. & + + lattice_thermalExpansion33(1:3,1:3,2,phase)*(T - TRef)**2 / 2. & + + lattice_thermalExpansion33(1:3,1:3,3,phase)*(T - TRef)**3 / 3. & + ) + dLi_dTstar = 0.0_pReal end subroutine kinematics_thermal_expansion_LiAndItsTangent diff --git a/src/material.f90 b/src/material.f90 index 8a8f36a55..291b73910 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -921,7 +921,7 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,& sizeState,sizeDotState,sizeDeltaState,& Nslip,Ntwin,Ntrans) use numerics, only: & - numerics_integrator2 => numerics_integrator ! compatibility hack + numerics_integrator implicit none integer(pInt), intent(in) :: & @@ -933,8 +933,6 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,& Nslip, & Ntwin, & Ntrans - integer(pInt) :: numerics_integrator ! compatibility hack - numerics_integrator = numerics_integrator2(1) ! compatibility hack plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState @@ -971,7 +969,7 @@ end subroutine material_allocatePlasticState subroutine material_allocateSourceState(phase,of,NofMyPhase,& sizeState,sizeDotState,sizeDeltaState) use numerics, only: & - numerics_integrator2 => numerics_integrator ! compatibility hack + numerics_integrator implicit none integer(pInt), intent(in) :: & @@ -979,8 +977,6 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,& of, & NofMyPhase, & sizeState, sizeDotState,sizeDeltaState - integer(pInt) :: numerics_integrator ! compatibility hack - numerics_integrator = numerics_integrator2(1) ! compatibility hack sourceState(phase)%p(of)%sizeState = sizeState sourceState(phase)%p(of)%sizeDotState = sizeDotState diff --git a/src/numerics.f90 b/src/numerics.f90 index 1678d0c48..9727a04a7 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -23,12 +23,10 @@ module numerics pert_method = 1_pInt, & !< method used in perturbation technique for tangent randomSeed = 0_pInt, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed worldrank = 0_pInt, & !< MPI worldrank (/=0 for MPI simulations only) - worldsize = 0_pInt !< MPI worldsize (/=0 for MPI simulations only) + worldsize = 0_pInt, & !< MPI worldsize (/=0 for MPI simulations only) + numerics_integrator = 1_pInt !< method used for state integration Default 1: fix-point iteration integer(4), protected, public :: & DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive - !< ToDo: numerics_integrator is an array for historical reasons, only element 1 is used! - integer(pInt), dimension(2), protected, public :: & - numerics_integrator = 1_pInt !< method used for state integration (central & perturbed state), Default 1: fix-point iteration for both states real(pReal), protected, public :: & relevantStrain = 1.0e-7_pReal, & !< strain increment considered significant (used by crystallite to determine whether strain inc is considered significant) defgradTolerance = 1.0e-7_pReal, & !< deviation of deformation gradient that is still allowed (used by CPFEM to determine outdated ffn1) @@ -466,7 +464,7 @@ subroutine numerics_init write(6,'(a24,1x,es8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState write(6,'(a24,1x,es8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress write(6,'(a24,1x,es8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress - write(6,'(a24,2(1x,i8))') ' integrator: ',numerics_integrator + write(6,'(a24,1x,i8)') ' integrator: ',numerics_integrator write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength @@ -589,7 +587,7 @@ subroutine numerics_init if (rTol_crystalliteState <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteState') if (rTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='rTol_crystalliteStress') if (aTol_crystalliteStress <= 0.0_pReal) call IO_error(301_pInt,ext_msg='aTol_crystalliteStress') - if (any(numerics_integrator <= 0_pInt) .or. any(numerics_integrator >= 6_pInt)) & + if (numerics_integrator <= 0_pInt .or. numerics_integrator >= 6_pInt) & call IO_error(301_pInt,ext_msg='integrator') if (numerics_unitlength <= 0.0_pReal) call IO_error(301_pInt,ext_msg='unitlength') if (absTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absTol_RGC') diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index ef0843239..026a71726 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -1,4 +1,5 @@ !-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @brief material subroutine for thermal source due to plastic dissipation !> @details to be done diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 724d36f17..2bf4cac9c 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -1,53 +1,44 @@ !-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Michigan State University !> @brief material subroutine for variable heat source -!> @details to be done !-------------------------------------------------------------------------------------------------- module source_thermal_externalheat - use prec, only: & - pReal, & - pInt + use prec, only: & + pReal, & + pInt - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - source_thermal_externalheat_sizePostResults, & !< cumulative size of post results - source_thermal_externalheat_offset, & !< which source is my current thermal dissipation mechanism? - source_thermal_externalheat_instance !< instance of thermal dissipation source mechanism + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + source_thermal_externalheat_offset, & !< which source is my current thermal dissipation mechanism? + source_thermal_externalheat_instance !< instance of thermal dissipation source mechanism - integer(pInt), dimension(:,:), allocatable, target, public :: & - source_thermal_externalheat_sizePostResult !< size of each post result output + integer(pInt), dimension(:,:), allocatable, target, public :: & + source_thermal_externalheat_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & - source_thermal_externalheat_output !< name of each post result output + character(len=64), dimension(:,:), allocatable, target, public :: & + source_thermal_externalheat_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & - source_thermal_externalheat_Noutput !< number of outputs per instance of this source + integer(pInt), dimension(:), allocatable, target, public :: & + source_thermal_externalheat_Noutput !< number of outputs per instance of this source - integer(pInt), dimension(:), allocatable, private :: & - source_thermal_externalheat_nIntervals + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal), dimension(:), allocatable :: & + time, & + heat_rate + integer(pInt) :: & + nIntervals + end type tParameters - real(pReal), dimension(:,:), allocatable, private :: & - source_thermal_externalheat_time, & - source_thermal_externalheat_rate + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) - type, private :: tParameters !< container type for internal constitutive parameters - real(pReal), dimension(:), allocatable :: & - time, & - rate - integer(pInt) :: & - nInterval - end type tParameters - - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) - - - public :: & - source_thermal_externalheat_init, & - source_thermal_externalheat_dotState, & - source_thermal_externalheat_getRateAndItsTangent + public :: & + source_thermal_externalheat_init, & + source_thermal_externalheat_dotState, & + source_thermal_externalheat_getRateAndItsTangent contains @@ -56,143 +47,74 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine source_thermal_externalheat_init(fileUnit) - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_EOF - use material, only: & - material_allocateSourceState, & - phase_source, & - phase_Nsources, & - phase_Noutput, & - SOURCE_thermal_externalheat_label, & - SOURCE_thermal_externalheat_ID, & - material_phase, & - sourceState - use config, only: & - config_phase, & - material_Nphase, & - MATERIAL_partPhase - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase,interval,p - character(len=65536) :: & - tag = '', & - line = '' - real(pReal), allocatable, dimension(:,:) :: temp_time, temp_rate - - write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>' - +subroutine source_thermal_externalheat_init + use debug, only: & + debug_level,& + debug_constitutive,& + debug_levelBasic + use material, only: & + material_allocateSourceState, & + material_phase, & + phase_source, & + phase_Nsources, & + phase_Noutput, & + SOURCE_thermal_externalheat_label, & + SOURCE_thermal_externalheat_ID + use config, only: & + config_phase, & + material_Nphase, & + MATERIAL_partPhase - maxNinstance = int(count(phase_source == SOURCE_thermal_externalheat_ID),pInt) - if (maxNinstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + implicit none - allocate(source_thermal_externalheat_offset(material_Nphase), source=0_pInt) - allocate(source_thermal_externalheat_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - source_thermal_externalheat_instance(phase) = count(phase_source(:,1:phase) == SOURCE_thermal_externalheat_ID) - do source = 1, phase_Nsources(phase) - if (phase_source(source,phase) == SOURCE_thermal_externalheat_ID) & - source_thermal_externalheat_offset(phase) = source - enddo - enddo - - allocate(source_thermal_externalheat_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_thermal_externalheat_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_thermal_externalheat_output (maxval(phase_Noutput),maxNinstance)) - source_thermal_externalheat_output = '' - allocate(source_thermal_externalheat_Noutput(maxNinstance), source=0_pInt) - - allocate(source_thermal_externalheat_nIntervals(maxNinstance), source=0_pInt) - allocate(temp_time(maxNinstance,1000), source=0.0_pReal) - allocate(temp_rate(maxNinstance,1000), source=0.0_pReal) - - do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_thermal_externalheat_ID)) cycle - enddo - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo + real(pReal), allocatable, dimension(:) :: tempVar + integer(pInt) :: maxNinstance,instance,source,sourceOffset + integer(pInt) :: NofMyPhase,p - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_thermal_externalheat_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = source_thermal_externalheat_instance(phase) ! which instance of my source is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('externalheat_time','externalheat_rate') - if (chunkPos(1) <= 2_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//SOURCE_thermal_externalheat_label//')') - if ( source_thermal_externalheat_nIntervals(instance) > 0_pInt & - .and. source_thermal_externalheat_nIntervals(instance) /= chunkPos(1) - 2_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//SOURCE_thermal_externalheat_label//')') - - source_thermal_externalheat_nIntervals(instance) = chunkPos(1) - 2_pInt - do interval = 1, source_thermal_externalheat_nIntervals(instance) + 1_pInt - select case(tag) - case ('externalheat_time') - temp_time(instance, interval) = IO_floatValue(line,chunkPos,1_pInt + interval) - case ('externalheat_rate') - temp_rate(instance, interval) = IO_floatValue(line,chunkPos,1_pInt + interval) - end select - enddo - end select - endif; endif - enddo parsingFile + write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>' - allocate(source_thermal_externalheat_time(maxNinstance,maxval(source_thermal_externalheat_nIntervals)+1_pInt), source=0.0_pReal) - allocate(source_thermal_externalheat_rate(maxNinstance,maxval(source_thermal_externalheat_nIntervals)+1_pInt), source=0.0_pReal) - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_thermal_externalheat_ID)) then - NofMyPhase = count(material_phase==phase) - instance = source_thermal_externalheat_instance(phase) - sourceOffset = source_thermal_externalheat_offset(phase) - source_thermal_externalheat_time(instance,1:source_thermal_externalheat_nIntervals(instance)+1_pInt) = & - temp_time(instance,1:source_thermal_externalheat_nIntervals(instance)+1_pInt) - source_thermal_externalheat_rate(instance,1:source_thermal_externalheat_nIntervals(instance)+1_pInt) = & - temp_rate(instance,1:source_thermal_externalheat_nIntervals(instance)+1_pInt) - - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) + + maxNinstance = int(count(phase_source == SOURCE_thermal_externalheat_ID),pInt) + if (maxNinstance == 0_pInt) return + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(source_thermal_externalheat_offset(material_Nphase), source=0_pInt) + allocate(source_thermal_externalheat_instance(material_Nphase), source=0_pInt) + + do p = 1, material_Nphase + source_thermal_externalheat_instance(p) = count(phase_source(:,1:p) == SOURCE_thermal_externalheat_ID) + do source = 1, phase_Nsources(p) + if (phase_source(source,p) == SOURCE_thermal_externalheat_ID) & + source_thermal_externalheat_offset(p) = source + enddo + enddo - endif + allocate(source_thermal_externalheat_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(source_thermal_externalheat_output (maxval(phase_Noutput),maxNinstance)) + source_thermal_externalheat_output = '' + allocate(source_thermal_externalheat_Noutput(maxNinstance), source=0_pInt) - enddo initializeInstances + allocate(param(maxNinstance)) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_thermal_externalheat_ID)) cycle + instance = source_thermal_externalheat_instance(p) + sourceOffset = source_thermal_externalheat_offset(p) + NofMyPhase=count(material_phase==p) + + tempVar = config_phase(p)%getFloats('externalheat_time') + param(instance)%nIntervals = size(tempVar) - 1_pInt + + param(instance)%time= tempVar + + tempVar = config_phase(p)%getFloats('externalheat_rate',requiredSize = size(tempVar)) + param(instance)%heat_rate = tempVar + + call material_allocateSourceState(p,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt) + + enddo + end subroutine source_thermal_externalheat_init @@ -245,16 +167,16 @@ subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phas instance = source_thermal_externalheat_instance(phase) sourceOffset = source_thermal_externalheat_offset(phase) - do interval = 1, source_thermal_externalheat_nIntervals(instance) ! scan through all rate segments + do interval = 1, param(instance)%nIntervals ! scan through all rate segments frac_time = (sourceState(phase)%p(sourceOffset)%state(1,constituent) - & - source_thermal_externalheat_time(instance,interval)) / & - (source_thermal_externalheat_time(instance,interval+1) - & - source_thermal_externalheat_time(instance,interval)) ! fractional time within segment + param(instance)%time(interval)) / & + (param(instance)%time(interval+1) - & + param(instance)%time(interval)) ! fractional time within segment if ( (frac_time < 0.0_pReal .and. interval == 1) & - .or. (frac_time >= 1.0_pReal .and. interval == source_thermal_externalheat_nIntervals(instance)) & + .or. (frac_time >= 1.0_pReal .and. interval == param(instance)%nIntervals) & .or. (frac_time >= 0.0_pReal .and. frac_time < 1.0_pReal) ) & - TDot = source_thermal_externalheat_rate(instance,interval ) * (1.0_pReal - frac_time) + & - source_thermal_externalheat_rate(instance,interval+1) * frac_time ! interpolate heat rate between segment boundaries... + TDot = param(instance)%heat_rate(interval ) * (1.0_pReal - frac_time) + & + param(instance)%heat_rate(interval+1) * frac_time ! interpolate heat rate between segment boundaries... ! ...or extrapolate if outside of bounds enddo dTDot_dT = 0.0 diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 947e28777..c3290bdfe 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -43,8 +43,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_init - use IO, only: & - IO_error use material, only: & thermal_type, & thermal_typeInstance, & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 3d5ca892e..88da0529b 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -44,8 +44,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine thermal_conduction_init - use IO, only: & - IO_error use material, only: & thermal_type, & thermal_typeInstance, & From ad0ed4fdec46f7d96767269ee65a6210f8083fbd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Feb 2019 21:06:37 +0100 Subject: [PATCH 283/309] bugfix: wrong state was allocated --- src/material.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/material.f90 b/src/material.f90 index 291b73910..49ee38ee3 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -999,7 +999,7 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,& if (numerics_integrator == 5_pInt) & allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) end subroutine material_allocateSourceState From b1bb68d52301e4942b857ed1f89b7057000bc3f3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Feb 2019 21:07:00 +0100 Subject: [PATCH 284/309] cleaning --- src/source_thermal_dissipation.f90 | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 026a71726..db37c8286 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -12,7 +12,6 @@ module source_thermal_dissipation implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & - source_thermal_dissipation_sizePostResults, & !< cumulative size of post results source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism? source_thermal_dissipation_instance !< instance of thermal dissipation source mechanism @@ -21,9 +20,6 @@ module source_thermal_dissipation character(len=64), dimension(:,:), allocatable, target, public :: & source_thermal_dissipation_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - source_thermal_dissipation_Noutput !< number of outputs per instance of this source real(pReal), dimension(:), allocatable, private :: & source_thermal_dissipation_coldworkCoeff @@ -89,11 +85,9 @@ subroutine source_thermal_dissipation_init enddo enddo - allocate(source_thermal_dissipation_sizePostResults(Ninstance), source=0_pInt) allocate(source_thermal_dissipation_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) allocate(source_thermal_dissipation_output (maxval(phase_Noutput),Ninstance)) source_thermal_dissipation_output = '' - allocate(source_thermal_dissipation_Noutput(Ninstance), source=0_pInt) allocate(source_thermal_dissipation_coldworkCoeff(Ninstance), source=0.0_pReal) @@ -115,14 +109,12 @@ end subroutine source_thermal_dissipation_init !> @brief returns local vacancy generation rate !-------------------------------------------------------------------------------------------------- subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDOT_dT, Tstar, Lp, phase) - use math, only: & - math_Mandel6to33 implicit none integer(pInt), intent(in) :: & phase real(pReal), intent(in), dimension(3,3) :: & - Tstar !< 2nd Piola Kirchhoff stress tensor (Mandel) + Tstar real(pReal), intent(in), dimension(3,3) :: & Lp real(pReal), intent(out) :: & From 7903e2b65f60ad187bb58bce55ec49ad564d0185 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 23 Feb 2019 11:31:53 +0100 Subject: [PATCH 285/309] dependencies got mixed up --- PRIVATE | 2 +- src/CMakeLists.txt | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/PRIVATE b/PRIVATE index e86418193..dc9722c3c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit e86418193f202364e068de2dffee36f99c846856 +Subproject commit dc9722c3c9787bbb0f63308a7015b6709e6d4f94 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c50688f1e..cdd9b1d02 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -59,7 +59,7 @@ add_dependencies(FEsolving DEBUG) list(APPEND OBJECTFILES $) add_library(MATH OBJECT "math.f90") -add_dependencies(MATH DEBUG) +add_dependencies(MATH NUMERICS) list(APPEND OBJECTFILES $) add_library(QUATERNIONS OBJECT "quaternions.f90") @@ -93,7 +93,7 @@ elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") endif() add_library(MATERIAL OBJECT "material.f90") -add_dependencies(MATERIAL MESH DAMASK_CONFIG) +add_dependencies(MATERIAL MESH DAMASK_CONFIG ROTATIONS) list(APPEND OBJECTFILES $) add_library(LATTICE OBJECT "lattice.f90") From e4bb61c9d96b233383638763d1a112d87dcd484e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 23 Feb 2019 11:37:09 +0100 Subject: [PATCH 286/309] transition to new orientation class/DREAM.3D --- PRIVATE | 2 +- processing/misc/OIMgrainFile_toTable.py | 48 ---------- processing/pre/3DRVEfrom2Dang.py | 119 ------------------------ 3 files changed, 1 insertion(+), 168 deletions(-) delete mode 100755 processing/misc/OIMgrainFile_toTable.py delete mode 100755 processing/pre/3DRVEfrom2Dang.py diff --git a/PRIVATE b/PRIVATE index dc9722c3c..35bed9722 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit dc9722c3c9787bbb0f63308a7015b6709e6d4f94 +Subproject commit 35bed9722ddecc342719bafac32590e9ab94d053 diff --git a/processing/misc/OIMgrainFile_toTable.py b/processing/misc/OIMgrainFile_toTable.py deleted file mode 100755 index 063adb0db..000000000 --- a/processing/misc/OIMgrainFile_toTable.py +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os,sys -from optparse import OptionParser -import damask - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName,damask.version]) - -#-------------------------------------------------------------------------------------------------- -# MAIN -#-------------------------------------------------------------------------------------------------- - -parser = OptionParser(option_class=damask.extendableOption, usage='%prog [file[s]]', description = """ -Adds header to OIM grain file type 1 to make it accesible as ASCII table - -""", version = scriptID) - - -(options, filenames) = parser.parse_args() - -# --- loop over input files ------------------------------------------------------------------------- - -if filenames == []: filenames = [None] - -for name in filenames: - try: - table = damask.ASCIItable(name = name, - buffered = False, - labeled = False) - except: continue - damask.util.report(scriptName,name) - table.head_read() - data = [] - while table.data_read(): - data.append(table.data[0:9]) - - table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) - table.labels_append(['1_euler','2_euler','3_euler','1_pos','2_pos','IQ','CI','Fit','GrainID']) - table.head_write() - for i in data: - table.data = i - table.data_write() - -# --- output finalization -------------------------------------------------------------------------- - - table.close() # close ASCII table diff --git a/processing/pre/3DRVEfrom2Dang.py b/processing/pre/3DRVEfrom2Dang.py deleted file mode 100755 index 58607c4be..000000000 --- a/processing/pre/3DRVEfrom2Dang.py +++ /dev/null @@ -1,119 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os,sys,math -from optparse import OptionParser -import damask -import pipes - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName,damask.version]) - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- - -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', - description ='generate 3D RVE from .ang files of EBSD slices .', - version = scriptID) - -parser.add_option('--offset', - dest='offset', - type='float', - help='offset of EBSD slices [%default]', - metavar='float') -parser.add_option('--outname', - dest='outName', - type='string', - help='output file name [%default]', metavar='string') -parser.add_option('--vtr', - action="store_true", - dest='vtr') -parser.add_option('--geom', - action="store_true", - dest='geom') -parser.set_defaults(offset = 1.0, - outName = 'RVE3D') - -(options,filenames) = parser.parse_args() - -numFiles = len(filenames) -formatwidth = 1+int(math.log10(numFiles)) - -# copy original files to tmp files to not alter originals -for i in range(numFiles): - sliceID = 'slice' + str(i).zfill(formatwidth) + '.tmp' - strCommand = 'cp ' + pipes.quote(filenames[i]) + ' ' + sliceID - os.system(strCommand) - -# modify tmp files -print('Add z-coordinates') -for i in range(numFiles): - sliceID = 'slice' + str(i).zfill(formatwidth) + '.tmp' - strCommand = 'OIMgrainFile_toTable ' + sliceID - os.system(strCommand) - strCommand = 'addCalculation --label 3Dpos --formula "np.array(#pos#.tolist()+[' + str(i*options.offset) + '])" ' + sliceID - os.system(strCommand) - -# join temp files into one - -print('\n Colocate files') -fileOut = open(options.outName + '.ang','w') - -# take header information from 1st file -sliceID = 'slice' + str(0).zfill(formatwidth) + '.tmp' -fileRead = open(sliceID) -data = fileRead.readlines() -fileRead.close() -headerLines = int(data[0].split()[0]) -fileOut.write(str(headerLines+1) + '\t header\n') -for line in data[1:headerLines]: - fileOut.write(line) -fileOut.write(scriptID + '\t' + ' '.join(sys.argv[1:]) + '\n') -for line in data[headerLines:]: - fileOut.write(line) - -# append other files content without header -for i in range(numFiles-1): - sliceID = 'slice' + str(i+1).zfill(formatwidth) + '.tmp' - fileRead = open(sliceID) - data = fileRead.readlines() - fileRead.close() - headerLines = int(data[0].split()[0]) - for line in data[headerLines+1:]: - fileOut.write(line) -fileOut.close() - -# tidy up and add phase column -print('\n Remove temp data and add phase info') -strCommand = 'filterTable --black pos ' + options.outName + '.ang' -os.system(strCommand) -strCommand = 'reLabel --label 3Dpos --substitute pos ' + options.outName + '.ang' -os.system(strCommand) -strCommand = 'addCalculation -l phase -f 1 ' + options.outName + '.ang' -os.system(strCommand) - - -# create geom file when asked for -if options.geom: - print('\n Build geometry file') - strCommand = 'geom_fromTable --phase phase --eulers euler --coordinates pos ' + pipes.quote(options.outName) + '.ang' - os.system(strCommand) - -# create paraview file when asked for - -if options.vtr: - print('\n Build Paraview file') - strCommand = 'addIPFcolor --eulers euler --pole 0.0 0.0 1.0 ' + options.outName + '.ang' - os.system(strCommand) - strCommand = 'vtk_rectilinearGrid ' + pipes.quote(options.outName) + '.ang' - os.system(strCommand) - os.rename(pipes.quote(options.outName) + '_pos(cell)'+'.vtr', pipes.quote(options.outName) + '.vtr') - strCommand = 'vtk_addRectilinearGridData --vtk '+ pipes.quote(options.outName) + '.vtr --color IPF_001_cubic '\ - + pipes.quote(options.outName) + '.ang' - os.system(strCommand) - -# delete tmp files -for i in range(numFiles): - sliceID = 'slice' + str(i).zfill(formatwidth) + '.tmp' - os.remove(sliceID) \ No newline at end of file From affe65eb55204d37aa2c1b27c264651b5a481315 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 23 Feb 2019 16:50:21 +0100 Subject: [PATCH 287/309] does not exist anymore --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 9b992136c..368888436 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -508,7 +508,7 @@ Processing: stage: createDocumentation script: - cd $DAMASKROOT/processing/pre - - rm 3DRVEfrom2Dang.py abq_addUserOutput.py marc_addUserOutput.py + - rm abq_addUserOutput.py marc_addUserOutput.py - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py - cd $DAMASKROOT/processing/post - rm marc_to_vtk.py vtk2ang.py From b3455c825e8fe98bac8b842611dc70548e4b886b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 23 Feb 2019 21:47:16 +0100 Subject: [PATCH 288/309] transition to new orientation class forward-backward conversion quite stable --- PRIVATE | 2 +- processing/post/addOrientations.py | 6 +- processing/post/rotateData.py | 2 +- processing/pre/geom_addPrimitive.py | 2 +- python/damask/orientation.py | 365 ++++------------------------ 5 files changed, 57 insertions(+), 320 deletions(-) diff --git a/PRIVATE b/PRIVATE index 35bed9722..f0090997d 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 35bed9722ddecc342719bafac32590e9ab94d053 +Subproject commit f0090997df817f0a0b5a480a60e81929875b1010 diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index cc10dfb84..dfaa54196 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -109,8 +109,8 @@ if np.sum(input) != 1: parser.error('needs exactly one input format.') crystalrotation = np.array(options.crystalrotation[1:4] + (options.crystalrotation[0],)) # Compatibility hack labrotation = np.array(options.labrotation[1:4] + (options.labrotation[0],)) # Compatibility hack -r = damask.Rotation.fromAngleAxis(crystalrotation,options.degrees) # crystal frame rotation -R = damask.Rotation.fromAngleAxis(labrotation,options.degrees) # lab frame rotation +r = damask.Rotation.fromAxisAngle(crystalrotation,options.degrees) # crystal frame rotation +R = damask.Rotation.fromAxisAngle(labrotation,options.degrees) # lab frame rotation # --- loop over input files ------------------------------------------------------------------------ @@ -183,7 +183,7 @@ for name in filenames: elif output == 'rodrigues': table.data_append(o.asRodrigues()) elif output == 'eulers': table.data_append(o.asEulers(degrees=options.degrees)) elif output == 'matrix': table.data_append(o.asMatrix()) - elif output == 'angleaxis': table.data_append(o.asAngleAxis(degrees=options.degrees)) + elif output == 'angleaxis': table.data_append(o.asAxisAngle(degrees=options.degrees)) outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 1438acb15..65f5aaaa2 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -41,7 +41,7 @@ if options.data is None: parser.error('no data column specified.') rotation = np.array(options.rotation[1:4]+(options.rotation[0],)) # Compatibility hack -r = damask.Rotation.fromAngleAxis(rotation,options.degrees,normalise=True) +r = damask.Rotation.fromAxisAngle(rotation,options.degrees,normalise=True) # --- loop over input files ------------------------------------------------------------------------- diff --git a/processing/pre/geom_addPrimitive.py b/processing/pre/geom_addPrimitive.py index 88df1e62d..0b3356083 100755 --- a/processing/pre/geom_addPrimitive.py +++ b/processing/pre/geom_addPrimitive.py @@ -64,7 +64,7 @@ if options.dimension is None: parser.error('no dimension specified.') if options.angleaxis is not None: ax = np.array(options.angleaxis[1:4] + (options.angleaxis[0],)) # Compatibility hack - rotation = damask.Rotation.fromAngleAxis(ax,options.degrees,normalise=True) + rotation = damask.Rotation.fromAxisAngle(ax,options.degrees,normalise=True) elif options.quaternion is not None: rotation = damask.Rotation.fromQuaternion(options.quaternion) else: diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 3ab7cd044..ffe6dd419 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -261,32 +261,34 @@ class Rotation: # convert to different orientation representations (numpy arrays) def asQuaternion(self): + """Unit quaternion: (q, [p_1, p_2, p_3])""" return self.quaternion.asArray() def asEulers(self, degrees = False): - + """Bunge-Euler angles: (φ_1, ϕ, φ_2)""" eu = qu2eu(self.quaternion.asArray()) if degrees: eu = np.degrees(eu) - return eu - def asAngleAxis(self, + def asAxisAngle(self, degrees = False): - + """Axis-angle pair: ([n_1, n_2, n_3], ω)""" ax = qu2ax(self.quaternion.asArray()) if degrees: ax[3] = np.degrees(ax[3]) - return ax def asMatrix(self): + """Rotation matrix""" return qu2om(self.quaternion.asArray()) def asRodrigues(self): + """Rodrigues-Frank vector: ([n_1, n_2, n_3], tan(ω/2))""" return qu2ro(self.quaternion.asArray()) def asHomochoric(self): - return qu2ho(self.quaternion.asArray()) + """Homochoric vector: (h_1, h_2, h_3)""" + return qu2ho(self.quaternion.asArray()) def asCubochoric(self): return qu2cu(self.quaternion.asArray()) @@ -322,7 +324,7 @@ class Rotation: return cls(eu2qu(eu)) @classmethod - def fromAngleAxis(cls, + def fromAxisAngle(cls, angleAxis, degrees = False, normalise = False, @@ -372,6 +374,27 @@ class Rotation: raise ValueError('Rodriques rotation angle not positive.\n'.format(ro[3])) return cls(ro2qu(ro)) + + @classmethod + def fromHomochoric(cls, + homochoric, + P = -1): + + ho = homochoric if isinstance(homochoric, np.ndarray) else np.array(homochoric) + if P > 0: ho *= -1 # convert from P=1 to P=-1 + + return cls(ho2qu(ho)) + + @classmethod + def fromCubochoric(cls, + cubochoric, + P = -1): + + cu = cubochoric if isinstance(cubochoric, np.ndarray) else np.array(cubochoric) + ho = cu2ho(cu) + if P > 0: ho *= -1 # convert from P=1 to P=-1 + + return cls(ho2qu(ho)) def __mul__(self, other): @@ -672,28 +695,6 @@ class Quaternion: def asRodrigues(self): return np.inf*np.ones(3) if np.isclose(self.q,0.0) else self.p/self.q - def asEulers(self, - degrees = False): - """Orientation as Bunge-Euler angles.""" - # Rowenhorst_etal2015 MSMSE: value of P is selected as -1 - P = -1.0 - q03 = self.q**2 + self.p[2]**2 - q12 = self.p[0]**2 + self.p[1]**2 - chi = np.sqrt(q03*q12) - - if np.isclose(chi,0.0) and np.isclose(q12,0.0): - eulers = np.array([math.atan2(-2*P*self.q*self.p[2],self.q**2-self.p[2]**2),0,0]) - elif np.isclose(chi,0.0) and np.isclose(q03,0.0): - eulers = np.array([math.atan2( 2 *self.p[0]*self.p[1],self.p[0]**2-self.p[1]**2),np.pi,0]) - else: - eulers = np.array([math.atan2((self.p[0]*self.p[2]-P*self.q*self.p[1])/chi,(-P*self.q*self.p[0]-self.p[1]*self.p[2])/chi), - math.atan2(2*chi,q03-q12), - math.atan2((P*self.q*self.p[1]+self.p[0]*self.p[2])/chi,( self.p[1]*self.p[2]-P*self.q*self.p[0])/chi), - ]) - - eulers %= 2.0*math.pi # enforce positive angles - return np.degrees(eulers) if degrees else eulers - # # Static constructors @classmethod @@ -1506,18 +1507,8 @@ class Orientation: 'Symmetry: {}'.format(self.symmetry), 'Quaternion: {}'.format(self.quaternion), 'Matrix:\n{}'.format( '\n'.join(['\t'.join(list(map(str,self.asMatrix()[i,:]))) for i in range(3)]) ), - 'Bunge Eulers / deg: {}'.format('\t'.join(list(map(str,self.asEulers(degrees=True)))) ), ]) - def asQuaternion(self): - return self.quaternion.asList() - - def asEulers(self, - degrees = False, - ): - return self.quaternion.asEulers(degrees) - eulers = property(asEulers) - def asRodrigues(self): return self.quaternion.asRodrigues() rodrigues = property(asRodrigues) @@ -1526,7 +1517,6 @@ class Orientation: degrees = False, flat = False): return self.quaternion.asAngleAxis(degrees,flat) - angleAxis = property(asAngleAxis) def asMatrix(self): return self.quaternion.asMatrix() @@ -1643,251 +1633,6 @@ class Orientation: symmetry = reference.symmetry.lattice) - def related(self, - relationModel, - direction, - targetSymmetry = 'cubic'): - """ - Orientation relationship - - positive number: fcc --> bcc - negative number: bcc --> fcc - """ - if relationModel not in ['KS','GT','GTdash','NW','Pitsch','Bain']: return None - if int(direction) == 0: return None - - variant = int(abs(direction))-1 - (me,other) = (0,1) if direction > 0 else (1,0) - - planes = {'KS': \ - np.array([[[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, -1],[ 0, 1, 1]], - [[ 1, 1, -1],[ 0, 1, 1]], - [[ 1, 1, -1],[ 0, 1, 1]], - [[ 1, 1, -1],[ 0, 1, 1]], - [[ 1, 1, -1],[ 0, 1, 1]], - [[ 1, 1, -1],[ 0, 1, 1]]]), - 'GT': \ - np.array([[[ 1, 1, 1],[ 1, 0, 1]], - [[ 1, 1, 1],[ 1, 1, 0]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ -1, -1, 1],[ -1, 0, 1]], - [[ -1, -1, 1],[ -1, -1, 0]], - [[ -1, -1, 1],[ 0, -1, 1]], - [[ -1, 1, 1],[ -1, 0, 1]], - [[ -1, 1, 1],[ -1, 1, 0]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 1, 0, 1]], - [[ 1, -1, 1],[ 1, -1, 0]], - [[ 1, -1, 1],[ 0, -1, 1]], - [[ 1, 1, 1],[ 1, 1, 0]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 1, 0, 1]], - [[ -1, -1, 1],[ -1, -1, 0]], - [[ -1, -1, 1],[ 0, -1, 1]], - [[ -1, -1, 1],[ -1, 0, 1]], - [[ -1, 1, 1],[ -1, 1, 0]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ -1, 0, 1]], - [[ 1, -1, 1],[ 1, -1, 0]], - [[ 1, -1, 1],[ 0, -1, 1]], - [[ 1, -1, 1],[ 1, 0, 1]]]), - 'GTdash': \ - np.array([[[ 7, 17, 17],[ 12, 5, 17]], - [[ 17, 7, 17],[ 17, 12, 5]], - [[ 17, 17, 7],[ 5, 17, 12]], - [[ -7,-17, 17],[-12, -5, 17]], - [[-17, -7, 17],[-17,-12, 5]], - [[-17,-17, 7],[ -5,-17, 12]], - [[ 7,-17,-17],[ 12, -5,-17]], - [[ 17, -7,-17],[ 17,-12, -5]], - [[ 17,-17, -7],[ 5,-17,-12]], - [[ -7, 17,-17],[-12, 5,-17]], - [[-17, 7,-17],[-17, 12, -5]], - [[-17, 17, -7],[ -5, 17,-12]], - [[ 7, 17, 17],[ 12, 17, 5]], - [[ 17, 7, 17],[ 5, 12, 17]], - [[ 17, 17, 7],[ 17, 5, 12]], - [[ -7,-17, 17],[-12,-17, 5]], - [[-17, -7, 17],[ -5,-12, 17]], - [[-17,-17, 7],[-17, -5, 12]], - [[ 7,-17,-17],[ 12,-17, -5]], - [[ 17, -7,-17],[ 5, -12,-17]], - [[ 17,-17, 7],[ 17, -5,-12]], - [[ -7, 17,-17],[-12, 17, -5]], - [[-17, 7,-17],[ -5, 12,-17]], - [[-17, 17, -7],[-17, 5,-12]]]), - 'NW': \ - np.array([[[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ -1, -1, 1],[ 0, 1, 1]], - [[ -1, -1, 1],[ 0, 1, 1]], - [[ -1, -1, 1],[ 0, 1, 1]]]), - 'Pitsch': \ - np.array([[[ 0, 1, 0],[ -1, 0, 1]], - [[ 0, 0, 1],[ 1, -1, 0]], - [[ 1, 0, 0],[ 0, 1, -1]], - [[ 1, 0, 0],[ 0, -1, -1]], - [[ 0, 1, 0],[ -1, 0, -1]], - [[ 0, 0, 1],[ -1, -1, 0]], - [[ 0, 1, 0],[ -1, 0, -1]], - [[ 0, 0, 1],[ -1, -1, 0]], - [[ 1, 0, 0],[ 0, -1, -1]], - [[ 1, 0, 0],[ 0, -1, 1]], - [[ 0, 1, 0],[ 1, 0, -1]], - [[ 0, 0, 1],[ -1, 1, 0]]]), - 'Bain': \ - np.array([[[ 1, 0, 0],[ 1, 0, 0]], - [[ 0, 1, 0],[ 0, 1, 0]], - [[ 0, 0, 1],[ 0, 0, 1]]]), - } - - normals = {'KS': \ - np.array([[[ -1, 0, 1],[ -1, -1, 1]], - [[ -1, 0, 1],[ -1, 1, -1]], - [[ 0, 1, -1],[ -1, -1, 1]], - [[ 0, 1, -1],[ -1, 1, -1]], - [[ 1, -1, 0],[ -1, -1, 1]], - [[ 1, -1, 0],[ -1, 1, -1]], - [[ 1, 0, -1],[ -1, -1, 1]], - [[ 1, 0, -1],[ -1, 1, -1]], - [[ -1, -1, 0],[ -1, -1, 1]], - [[ -1, -1, 0],[ -1, 1, -1]], - [[ 0, 1, 1],[ -1, -1, 1]], - [[ 0, 1, 1],[ -1, 1, -1]], - [[ 0, -1, 1],[ -1, -1, 1]], - [[ 0, -1, 1],[ -1, 1, -1]], - [[ -1, 0, -1],[ -1, -1, 1]], - [[ -1, 0, -1],[ -1, 1, -1]], - [[ 1, 1, 0],[ -1, -1, 1]], - [[ 1, 1, 0],[ -1, 1, -1]], - [[ -1, 1, 0],[ -1, -1, 1]], - [[ -1, 1, 0],[ -1, 1, -1]], - [[ 0, -1, -1],[ -1, -1, 1]], - [[ 0, -1, -1],[ -1, 1, -1]], - [[ 1, 0, 1],[ -1, -1, 1]], - [[ 1, 0, 1],[ -1, 1, -1]]]), - 'GT': \ - np.array([[[ -5,-12, 17],[-17, -7, 17]], - [[ 17, -5,-12],[ 17,-17, -7]], - [[-12, 17, -5],[ -7, 17,-17]], - [[ 5, 12, 17],[ 17, 7, 17]], - [[-17, 5,-12],[-17, 17, -7]], - [[ 12,-17, -5],[ 7,-17,-17]], - [[ -5, 12,-17],[-17, 7,-17]], - [[ 17, 5, 12],[ 17, 17, 7]], - [[-12,-17, 5],[ -7,-17, 17]], - [[ 5,-12,-17],[ 17, -7,-17]], - [[-17, -5, 12],[-17,-17, 7]], - [[ 12, 17, 5],[ 7, 17, 17]], - [[ -5, 17,-12],[-17, 17, -7]], - [[-12, -5, 17],[ -7,-17, 17]], - [[ 17,-12, -5],[ 17, -7,-17]], - [[ 5,-17,-12],[ 17,-17, -7]], - [[ 12, 5, 17],[ 7, 17, 17]], - [[-17, 12, -5],[-17, 7,-17]], - [[ -5,-17, 12],[-17,-17, 7]], - [[-12, 5,-17],[ -7, 17,-17]], - [[ 17, 12, 5],[ 17, 7, 17]], - [[ 5, 17, 12],[ 17, 17, 7]], - [[ 12, -5,-17],[ 7,-17,-17]], - [[-17,-12, 5],[-17, 7, 17]]]), - 'GTdash': \ - np.array([[[ 0, 1, -1],[ 1, 1, -1]], - [[ -1, 0, 1],[ -1, 1, 1]], - [[ 1, -1, 0],[ 1, -1, 1]], - [[ 0, -1, -1],[ -1, -1, -1]], - [[ 1, 0, 1],[ 1, -1, 1]], - [[ 1, -1, 0],[ 1, -1, -1]], - [[ 0, 1, -1],[ -1, 1, -1]], - [[ 1, 0, 1],[ 1, 1, 1]], - [[ -1, -1, 0],[ -1, -1, 1]], - [[ 0, -1, -1],[ 1, -1, -1]], - [[ -1, 0, 1],[ -1, -1, 1]], - [[ -1, -1, 0],[ -1, -1, -1]], - [[ 0, -1, 1],[ 1, -1, 1]], - [[ 1, 0, -1],[ 1, 1, -1]], - [[ -1, 1, 0],[ -1, 1, 1]], - [[ 0, 1, 1],[ -1, 1, 1]], - [[ -1, 0, -1],[ -1, -1, -1]], - [[ -1, 1, 0],[ -1, 1, -1]], - [[ 0, -1, 1],[ -1, -1, 1]], - [[ -1, 0, -1],[ -1, 1, -1]], - [[ 1, 1, 0],[ 1, 1, 1]], - [[ 0, 1, 1],[ 1, 1, 1]], - [[ 1, 0, -1],[ 1, -1, -1]], - [[ 1, 1, 0],[ 1, 1, -1]]]), - 'NW': \ - np.array([[[ 2, -1, -1],[ 0, -1, 1]], - [[ -1, 2, -1],[ 0, -1, 1]], - [[ -1, -1, 2],[ 0, -1, 1]], - [[ -2, -1, -1],[ 0, -1, 1]], - [[ 1, 2, -1],[ 0, -1, 1]], - [[ 1, -1, 2],[ 0, -1, 1]], - [[ 2, 1, -1],[ 0, -1, 1]], - [[ -1, -2, -1],[ 0, -1, 1]], - [[ -1, 1, 2],[ 0, -1, 1]], - [[ -1, 2, 1],[ 0, -1, 1]], - [[ -1, 2, 1],[ 0, -1, 1]], - [[ -1, -1, -2],[ 0, -1, 1]]]), - 'Pitsch': \ - np.array([[[ 1, 0, 1],[ 1, -1, 1]], - [[ 1, 1, 0],[ 1, 1, -1]], - [[ 0, 1, 1],[ -1, 1, 1]], - [[ 0, 1, -1],[ -1, 1, -1]], - [[ -1, 0, 1],[ -1, -1, 1]], - [[ 1, -1, 0],[ 1, -1, -1]], - [[ 1, 0, -1],[ 1, -1, -1]], - [[ -1, 1, 0],[ -1, 1, -1]], - [[ 0, -1, 1],[ -1, -1, 1]], - [[ 0, 1, 1],[ -1, 1, 1]], - [[ 1, 0, 1],[ 1, -1, 1]], - [[ 1, 1, 0],[ 1, 1, -1]]]), - 'Bain': \ - np.array([[[ 0, 1, 0],[ 0, 1, 1]], - [[ 0, 0, 1],[ 1, 0, 1]], - [[ 1, 0, 0],[ 1, 1, 0]]]), - } - myPlane = [float(i) for i in planes[relationModel][variant,me]] # map(float, planes[...]) does not work in python 3 - myPlane /= np.linalg.norm(myPlane) - myNormal = [float(i) for i in normals[relationModel][variant,me]] # map(float, planes[...]) does not work in python 3 - myNormal /= np.linalg.norm(myNormal) - myMatrix = np.array([myNormal,np.cross(myPlane,myNormal),myPlane]).T - - otherPlane = [float(i) for i in planes[relationModel][variant,other]] # map(float, planes[...]) does not work in python 3 - otherPlane /= np.linalg.norm(otherPlane) - otherNormal = [float(i) for i in normals[relationModel][variant,other]] # map(float, planes[...]) does not work in python 3 - otherNormal /= np.linalg.norm(otherNormal) - otherMatrix = np.array([otherNormal,np.cross(otherPlane,otherNormal),otherPlane]).T - - rot=np.dot(otherMatrix,myMatrix.T) - - return Orientation(matrix=np.dot(rot,self.asMatrix()),symmetry=targetSymmetry) - #################################################################################################### # Code below available according to the followin conditions on https://github.com/MarDiehl/3Drotations #################################################################################################### @@ -1920,10 +1665,10 @@ class Orientation: #################################################################################################### def isone(a): - return np.isclose(a,1.0,atol=1.0e-15,rtol=0.0) + return np.isclose(a,1.0,atol=1.0e-7,rtol=0.0) def iszero(a): - return np.isclose(a,0.0,atol=1.0e-300,rtol=0.0) + return np.isclose(a,0.0,atol=1.0e-12,rtol=0.0) def eu2om(eu): @@ -2063,8 +1808,7 @@ def ho2ax(ho): for i in range(2,16): hm *= hmag_squared s += tfit[i] * hm - ax = np.append(ho/np.sqrt(hmag_squared),2.0*np.arccos(s)) # ToDo: Check sanity check in reference implementation - + ax = np.append(ho/np.sqrt(hmag_squared),2.0*np.arccos(np.clip(s,-1.0,1.0))) return ax @@ -2155,32 +1899,16 @@ def qu2om(qu): return om if P > 0.0 else om.T -def om2qu(om): - """Orientation matrix to quaternion""" - s = [+om[0,0] +om[1,1] +om[2,2] +1.0, - +om[0,0] -om[1,1] -om[2,2] +1.0, - -om[0,0] +om[1,1] -om[2,2] +1.0, - -om[0,0] -om[1,1] +om[2,2] +1.0] - s = np.maximum(np.zeros(4),s) - qu = np.sqrt(s)*0.5*np.array([1.0,P,P,P]) - # verify the signs (q0 always positive) - #ToDo: Here I donot understand the original shortcut from paper to implementation - - qu /= np.linalg.norm(qu) - if any(isone(abs(qu))): qu[np.where(np.logical_not(isone(qu)))] = 0.0 - if om[2,1] < om[1,2]: qu[1] *= -1.0 - if om[0,2] < om[2,0]: qu[2] *= -1.0 - if om[1,0] < om[0,1]: qu[3] *= -1.0 - if any(om2ax(om)[0:3]*qu[1:4] < 0.0): print('sign problem',om2ax(om),qu) # something is wrong here - return qu - - def qu2ax(qu): - """Quaternion to axis angle""" - omega = 2.0 * np.arccos(qu[0]) - if iszero(omega): # return axis as [001] if the angle is zero + """ + Quaternion to axis angle + + Modified version of the original formulation, should be numerically more stable + """ + if isone(abs(qu[0])): # set axis to [001] if the angle is 0/360 ax = [ 0.0, 0.0, 1.0, 0.0 ] elif not iszero(qu[0]): + omega = 2.0 * np.arccos(qu[0]) s = np.sign(qu[0])/np.sqrt(qu[1]**2+qu[2]**2+qu[3]**2) ax = [ qu[1]*s, qu[2]*s, qu[3]*s, omega ] else: @@ -2196,14 +1924,14 @@ def qu2ro(qu): else: s = np.linalg.norm([qu[1],qu[2],qu[3]]) ro = [0.0,0.0,P,0.0] if iszero(s) else \ - [ qu[1]/s, qu[2]/s, qu[3]/s, np.tan(np.arccos(qu[0]))] + [ qu[1]/s, qu[2]/s, qu[3]/s, np.tan(np.arccos(np.clip(qu[0],-1.0,1.0)))] # avoid numerical difficulties return np.array(ro) def qu2ho(qu): """Quaternion to homochoric""" - omega = 2.0 * np.arccos(qu[0]) + omega = 2.0 * np.arccos(np.clip(qu[0],-1.0,1.0)) # avoid numerical difficulties if iszero(omega): ho = np.array([ 0.0, 0.0, 0.0 ]) @@ -2288,7 +2016,16 @@ def eu2cu(eu): def om2cu(om): """Orientation matrix to cubochoric""" return ho2cu(om2ho(om)) + +def om2qu(om): + """ + Orientation matrix to quaternion + + The original formulation (direct conversion) had numerical issues + """ + return ax2qu(om2ax(om)) + def ax2cu(ax): """Axis angle to cubochoric""" From fff377de7f2b5fb012e67514e4c0d90b2e8f6543 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 23 Feb 2019 22:06:31 +0100 Subject: [PATCH 289/309] initial simplification. Should be able to generate from table containing either or and --- processing/pre/geom_fromTable.py | 141 +++---------------------------- 1 file changed, 14 insertions(+), 127 deletions(-) diff --git a/processing/pre/geom_fromTable.py b/processing/pre/geom_fromTable.py index e1157d325..f06f0e3d0 100755 --- a/processing/pre/geom_fromTable.py +++ b/processing/pre/geom_fromTable.py @@ -32,34 +32,6 @@ parser.add_option('--microstructure', dest = 'microstructure', type = 'string', metavar = 'string', help = 'microstructure label') -parser.add_option('-t', '--tolerance', - dest = 'tolerance', - type = 'float', metavar = 'float', - help = 'angular tolerance for orientation squashing [%default]') -parser.add_option('-e', '--eulers', - dest = 'eulers', - type = 'string', metavar = 'string', - help = 'Euler angles label') -parser.add_option('-d', '--degrees', - dest = 'degrees', - action = 'store_true', - help = 'all angles are in degrees') -parser.add_option('-m', '--matrix', - dest = 'matrix', - type = 'string', metavar = 'string', - help = 'orientation matrix label') -parser.add_option('-a', - dest='a', - type = 'string', metavar = 'string', - help = 'crystal frame a vector label') -parser.add_option('-b', - dest='b', - type = 'string', metavar = 'string', - help = 'crystal frame b vector label') -parser.add_option('-c', - dest = 'c', - type = 'string', metavar='string', - help = 'crystal frame c vector label') parser.add_option('-q', '--quaternion', dest = 'quaternion', type = 'string', metavar='string', @@ -68,10 +40,7 @@ parser.add_option('--axes', dest = 'axes', type = 'string', nargs = 3, metavar = ' '.join(['string']*3), help = 'orientation coordinate frame in terms of position coordinate frame [same]') -parser.add_option('-s', '--symmetry', - dest = 'symmetry', - action = 'extend', metavar = '', - help = 'crystal symmetry of each phase %default {{{}}} '.format(', '.join(damask.Symmetry.lattices[1:]))) + parser.add_option('--homogenization', dest = 'homogenization', type = 'int', metavar = 'int', @@ -80,9 +49,7 @@ parser.add_option('--crystallite', dest = 'crystallite', type = 'int', metavar = 'int', help = 'crystallite index to be used [%default]') -parser.add_option('--verbose', - dest = 'verbose', action = 'store_true', - help = 'output extra info') + parser.set_defaults(symmetry = [damask.Symmetry.lattices[-1]], tolerance = 0.0, @@ -95,12 +62,7 @@ parser.set_defaults(symmetry = [damask.Symmetry.lattices[-1]], (options,filenames) = parser.parse_args() -input = [options.eulers is not None, - options.a is not None and \ - options.b is not None and \ - options.c is not None, - options.matrix is not None, - options.quaternion is not None, +input = [ options.quaternion is not None, options.microstructure is not None, ] @@ -109,14 +71,9 @@ if np.sum(input) != 1: if options.axes is not None and not set(options.axes).issubset(set(['x','+x','-x','y','+y','-y','z','+z','-z'])): parser.error('invalid axes {} {} {}.'.format(*options.axes)) -(label,dim,inputtype) = [(options.eulers,3,'eulers'), - ([options.a,options.b,options.c],[3,3,3],'frame'), - (options.matrix,9,'matrix'), - (options.quaternion,4,'quaternion'), +(label,dim,inputtype) = [(options.quaternion,4,'quaternion'), (options.microstructure,1,'microstructure'), ][np.where(input)[0][0]] # select input label that was requested -toRadians = math.pi/180.0 if options.degrees else 1.0 # rescale all angles to radians -threshold = np.cos(options.tolerance/2.*toRadians) # cosine of (half of) tolerance angle # --- loop over input files ------------------------------------------------------------------------- @@ -157,10 +114,8 @@ for name in filenames: if coordDim == 2: table.data = np.insert(table.data,2,np.zeros(len(table.data)),axis=1) # add zero z coordinate for two-dimensional input - if options.verbose: damask.util.croak('extending to 3D...') if options.phase is None: table.data = np.column_stack((table.data,np.ones(len(table.data)))) # add single phase if no phase column given - if options.verbose: damask.util.croak('adding dummy phase info...') # --------------- figure out size and grid --------------------------------------------------------- @@ -196,17 +151,10 @@ for name in filenames: grain = table.data[:,colOri] nGrains = len(np.unique(grain)) - else: - - if options.verbose: bg = damask.util.backgroundMessage(); bg.start() # start background messaging + elif inputtype == 'quaternion': colPhase = -1 # column of phase data comes last - if options.verbose: bg.set_message('sorting positions...') index = np.lexsort((table.data[:,0],table.data[:,1],table.data[:,2])) # index of position when sorting x fast, z slow - if options.verbose: bg.set_message('building KD tree...') - KDTree = scipy.spatial.KDTree((table.data[index,:3]-mincorner) / delta) # build KDTree with dX = dY = dZ = 1 and origin 0,0,0 - - statistics = {'global': 0, 'local': 0} grain = -np.ones(N,dtype = 'int32') # initialize empty microstructure orientations = [] # orientations multiplicity = [] # orientation multiplicity (number of group members) @@ -215,87 +163,26 @@ for name in filenames: existingGrains = np.arange(nGrains) myPos = 0 # position (in list) of current grid point - tick = time.clock() - if options.verbose: bg.set_message('assigning grain IDs...') for z in range(grid[2]): for y in range(grid[1]): for x in range(grid[0]): - if (myPos+1)%(N/500.) < 1: - time_delta = (time.clock()-tick) * (N - myPos) / myPos - if options.verbose: bg.set_message('(%02i:%02i:%02i) processing point %i of %i (grain count %i)...' - %(time_delta//3600,time_delta%3600//60,time_delta%60,myPos,N,nGrains)) + myData = table.data[index[myPos]] # read data for current grid point myPhase = int(myData[colPhase]) - mySym = options.symmetry[min(myPhase,len(options.symmetry))-1] # take last specified option for all with higher index - - if inputtype == 'eulers': - o = damask.Orientation(Eulers = myData[colOri:colOri+3]*toRadians, - symmetry = mySym) - elif inputtype == 'matrix': - o = damask.Orientation(matrix = myData[colOri:colOri+9].reshape(3,3), - symmetry = mySym) - elif inputtype == 'frame': - o = damask.Orientation(matrix = np.hstack((myData[colOri[0]:colOri[0]+3], - myData[colOri[1]:colOri[1]+3], - myData[colOri[2]:colOri[2]+3], - )).reshape(3,3), - symmetry = mySym) - elif inputtype == 'quaternion': - o = damask.Orientation(quaternion = myData[colOri:colOri+4], - symmetry = mySym) + + o = damask.Rotation(myData[colOri:colOri+4]) - cos_disorientations = -np.ones(1,dtype=float) # largest possible disorientation - closest_grain = -1 # invalid neighbor - - if options.tolerance > 0.0: # only try to compress orientations if asked to - neighbors = np.array(KDTree.query_ball_point([x,y,z], 3)) # point indices within radius -# filter neighbors: skip myself, anyone further ahead (cannot yet have a grain ID), and other phases - neighbors = neighbors[(neighbors < myPos) & \ - (table.data[index[neighbors],colPhase] == myPhase)] - grains = np.unique(grain[neighbors]) # unique grain IDs among valid neighbors - - if len(grains) > 0: # check immediate neighborhood first - cos_disorientations = np.array([o.disorientation(orientations[grainID], - SST = False)[0].quaternion.q \ - for grainID in grains]) # store disorientation per grainID - closest_grain = np.argmax(cos_disorientations) # grain among grains with closest orientation to myself - match = 'local' - - if cos_disorientations[closest_grain] < threshold: # orientation not close enough? - grains = existingGrains[np.atleast_1d( (np.array(phases) == myPhase ) & \ - (np.in1d(existingGrains,grains,invert=True)))] # other already identified grains (of my phase) - - if len(grains) > 0: - cos_disorientations = np.array([o.disorientation(orientations[grainID], - SST = False)[0].quaternion.q \ - for grainID in grains]) # store disorientation per grainID - closest_grain = np.argmax(cos_disorientations) # grain among grains with closest orientation to myself - match = 'global' - - if cos_disorientations[closest_grain] >= threshold: # orientation now close enough? - grainID = grains[closest_grain] - grain[myPos] = grainID # assign myself to that grain ... - orientations[grainID] = damask.Orientation.average([orientations[grainID],o], - [multiplicity[grainID],1]) # update average orientation of best matching grain - multiplicity[grainID] += 1 - statistics[match] += 1 - else: - grain[myPos] = nGrains # assign new grain to me ... - nGrains += 1 # ... and update counter - orientations.append(o) # store new orientation for future comparison - multiplicity.append(1) # having single occurrence so far - phases.append(myPhase) # store phase info for future reporting - existingGrains = np.arange(nGrains) # update list of existing grains + grain[myPos] = nGrains # assign new grain to me ... + nGrains += 1 # ... and update counter + orientations.append(o) # store new orientation for future comparison + multiplicity.append(1) # having single occurrence so far + phases.append(myPhase) # store phase info for future reporting + existingGrains = np.arange(nGrains) # update list of existing grains myPos += 1 - if options.verbose: - bg.stop() - bg.join() - damask.util.croak("{} seconds total.\n{} local and {} global matches.".\ - format(time.clock()-tick,statistics['local'],statistics['global'])) grain += 1 # offset from starting index 0 to 1 From a8e8b75cc07d2af85fb86f2dbfc4ae1827ad2d49 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 23 Feb 2019 22:13:24 +0100 Subject: [PATCH 290/309] use new rotation class --- processing/pre/geom_rotate.py | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/processing/pre/geom_rotate.py b/processing/pre/geom_rotate.py index eb70f7137..4da59cddf 100755 --- a/processing/pre/geom_rotate.py +++ b/processing/pre/geom_rotate.py @@ -52,13 +52,14 @@ parser.set_defaults(degrees = False, if sum(x is not None for x in [options.rotation,options.eulers,options.matrix,options.quaternion]) != 1: parser.error('not exactly one rotation specified...') -eulers = np.array(damask.orientation.Orientation( - quaternion = np.array(options.quaternion) if options.quaternion else None, - angleAxis = np.array(options.rotation) if options.rotation else None, - matrix = np.array(options.matrix) if options.matrix else None, - Eulers = np.array(options.eulers) if options.eulers else None, - degrees = options.degrees, - ).asEulers(degrees=True)) +if options.quaternion is not None: + eulers = damask.Rotation.fromQuaternion(np.array(options.quaternion)).asEulers(degrees=True) +if options.rotation is not None: + eulers = damask.Rotation.fromAxisAngle(np.array(options.rotation,degrees=True)).asEulers(degrees=True) +if options.matrix is not None: + eulers = damask.Rotation.fromMatrix(np.array(options.Matrix)).asEulers(degrees=True) +if options.eulers is not None: + eulers = damask.Rotation.fromEulers(np.array(options.eulers),degrees=True).asEulers(degrees=True) # --- loop over input files ------------------------------------------------------------------------- From 9fa2553af4cbb90f10450004be83314bed0f8a07 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 23 Feb 2019 22:14:55 +0100 Subject: [PATCH 291/309] task for DREAM.3D if needed pointwise takeover should not be a problem anymore as reading in takes no time (at least in comparison to addGrainID) --- processing/post/addGrainID.py | 176 ---------------------------------- 1 file changed, 176 deletions(-) delete mode 100755 processing/post/addGrainID.py diff --git a/processing/post/addGrainID.py b/processing/post/addGrainID.py deleted file mode 100755 index 6493736d8..000000000 --- a/processing/post/addGrainID.py +++ /dev/null @@ -1,176 +0,0 @@ -#!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- - -import os,sys,copy -import numpy as np -import damask -from optparse import OptionParser -from scipy import spatial - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName,damask.version]) - - -parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ -Add grain index based on similiarity of crystal lattice orientation. - -""", version = scriptID) - -parser.add_option('-r', - '--radius', - dest = 'radius', - type = 'float', metavar = 'float', - help = 'search radius') -parser.add_option('-d', - '--disorientation', - dest = 'disorientation', - type = 'float', metavar = 'float', - help = 'disorientation threshold in degrees [%default]') -parser.add_option('-s', - '--symmetry', - dest = 'symmetry', type = 'choice', choices = damask.Symmetry.lattices[1:], - metavar = 'string', - help = 'crystal symmetry [%default] {{{}}} '.format(', '.join(damask.Symmetry.lattices[1:]))) -parser.add_option('-o', - '--orientation', - dest = 'quaternion', - metavar = 'string', - help = 'label of crystal orientation given as unit quaternion [%default]') -parser.add_option('-p', - '--pos', '--position', - dest = 'pos', - metavar = 'string', - help = 'label of coordinates [%default]') -parser.add_option('--quiet', - dest='verbose', - action = 'store_false', - help = 'hide status bar (useful when piping to file)') - -parser.set_defaults(disorientation = 5, - verbose = True, - quaternion = 'orientation', - symmetry = damask.Symmetry.lattices[-1], - pos = 'pos', - ) - -(options, filenames) = parser.parse_args() - -if options.radius is None: - parser.error('no radius specified.') - -cos_disorientation = np.cos(np.radians(options.disorientation/2.)) # cos of half the disorientation angle - -# --- loop over input files ------------------------------------------------------------------------- - -if filenames == []: filenames = [None] - -for name in filenames: - try: table = damask.ASCIItable(name = name, - buffered = False) - except: continue - damask.util.report(scriptName,name) - -# ------------------------------------------ read header ------------------------------------------- - - table.head_read() - -# ------------------------------------------ sanity checks ----------------------------------------- - - errors = [] - remarks = [] - - if not 3 >= table.label_dimension(options.pos) >= 1: - errors.append('coordinates "{}" need to have one, two, or three dimensions.'.format(options.pos)) - if not np.all(table.label_dimension(options.quaternion) == 4): - errors.append('input "{}" does not have dimension 4.'.format(options.quaternion)) - else: column = table.label_index(options.quaternion) - - if remarks != []: damask.util.croak(remarks) - if errors != []: - damask.util.croak(errors) - table.close(dismiss = True) - continue - -# ------------------------------------------ assemble header --------------------------------------- - - table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) - table.labels_append('grainID_{}@{:g}'.format(options.quaternion,options.disorientation)) # report orientation source and disorientation - table.head_write() - -# ------------------------------------------ build KD tree ----------------------------------------- - - table.data_readArray(options.pos) # read position vectors - grainID = -np.ones(len(table.data),dtype=int) - Npoints = table.data.shape[0] - kdtree = spatial.KDTree(copy.deepcopy(table.data)) - -# ------------------------------------------ assign grain IDs -------------------------------------- - - orientations = [] # quaternions found for grain - memberCounts = [] # number of voxels in grain - p = 0 # point counter - g = 0 # grain counter - matchedID = -1 - lastDistance = np.dot(kdtree.data[-1]-kdtree.data[0],kdtree.data[-1]-kdtree.data[0]) # (arbitrarily) use diagonal of cloud - - table.data_rewind() - while table.data_read(): # read next data line of ASCII table - - if options.verbose and Npoints > 100 and p%(Npoints//100) == 0: # report in 1% steps if possible and avoid modulo by zero - damask.util.progressBar(iteration=p,total=Npoints) - - o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))), - symmetry = options.symmetry).reduced() - - matched = False - alreadyChecked = {} - candidates = [] - bestDisorientation = damask.Quaternion([0,0,0,1]) # initialize to 180 deg rotation as worst case - - for i in kdtree.query_ball_point(kdtree.data[p],options.radius): # check all neighboring points - gID = grainID[i] - if gID != -1 and gID not in alreadyChecked: # indexed point belonging to a grain not yet tested? - alreadyChecked[gID] = True # remember not to check again - disorientation = o.disorientation(orientations[gID],SST = False)[0] # compare against other orientation - if disorientation.quaternion.q > cos_disorientation: # within threshold ... - candidates.append(gID) # remember as potential candidate - if disorientation.quaternion.q >= bestDisorientation.q: # ... and better than current best? - matched = True - matchedID = gID # remember that grain - bestDisorientation = disorientation.quaternion - - if matched: # did match existing grain - memberCounts[matchedID] += 1 - if len(candidates) > 1: # ambiguity in grain identification? - largestGrain = sorted(candidates,key=lambda x:memberCounts[x])[-1] # find largest among potential candidate grains - matchedID = largestGrain - for c in [c for c in candidates if c != largestGrain]: # loop over smaller candidates - memberCounts[largestGrain] += memberCounts[c] # reassign member count of smaller to largest - memberCounts[c] = 0 - grainID = np.where(np.in1d(grainID,candidates), largestGrain, grainID) # relabel grid points of smaller candidates as largest one - - else: # no match -> new grain found - orientations += [o] # initialize with current orientation - memberCounts += [1] # start new membership counter - matchedID = g - g += 1 # increment grain counter - - grainID[p] = matchedID # remember grain index assigned to point - p += 1 # increment point - - grainIDs = np.where(np.array(memberCounts) > 0)[0] # identify "live" grain identifiers - packingMap = dict(zip(list(grainIDs),range(len(grainIDs)))) # map to condense into consecutive IDs - - table.data_rewind() - - outputAlive = True - p = 0 - damask.util.progressBar(iteration=1,total=1) - while outputAlive and table.data_read(): # read next data line of ASCII table - table.data_append(1+packingMap[grainID[p]]) # add (condensed) grain ID - outputAlive = table.data_write() # output processed line - p += 1 - -# ------------------------------------------ output finalization ----------------------------------- - - table.close() # close ASCII tables From 9dc8dff4b10b302eaf5090ee903ae80108fb1c06 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 23 Feb 2019 22:33:21 +0100 Subject: [PATCH 292/309] cleaning and adding compatibility layer --- processing/pre/geom_fromTable.py | 4 ++-- python/damask/orientation.py | 20 ++++++++++---------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/processing/pre/geom_fromTable.py b/processing/pre/geom_fromTable.py index f06f0e3d0..c0c4cf4d1 100755 --- a/processing/pre/geom_fromTable.py +++ b/processing/pre/geom_fromTable.py @@ -1,8 +1,8 @@ #!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- -import os,sys,math,time -import scipy.spatial, numpy as np +import os,sys,math +import numpy as np from optparse import OptionParser import damask diff --git a/python/damask/orientation.py b/python/damask/orientation.py index ffe6dd419..558e5f15d 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -973,7 +973,7 @@ class Symmetry: return True - def inDisorientationSST(self,R): + def inDisorientationSST(self,rodrigues): """ Check whether given Rodrigues vector (of misorientation) falls into standard stereographic triangle of own symmetry. @@ -981,7 +981,13 @@ class Symmetry: Representation of Orientation and Disorientation Data for Cubic, Hexagonal, Tetragonal and Orthorhombic Crystals Acta Cryst. (1991). A47, 780-789 """ - if isinstance(R, Quaternion): R = R.asRodrigues() # translate accidentially passed quaternion + if isinstance(rodrigues, Quaternion): + R = rodrigues.asRodrigues() # translate accidentially passed quaternion + else: + R = rodrigues + + if R.shape[0]==4: # transition old (length not stored separately) to new + R = (R[0:3]*R[3]) epsilon = 0.0 if self.lattice == 'cubic': @@ -1428,7 +1434,8 @@ class Orientation2: theQ = sB.rotation*mis*sA.rotation.inversed() for k in range(2): theQ.inversed() - breaker = self.lattice.symmetry.inFZ(theQ.asRodriques()) #and (not SST or other.symmetry.inDisorientationSST(theQ)) + breaker = self.lattice.symmetry.inFZ(theQ.asRodrigues()) \ + and (not SST or other.lattice.symmetry.inDisorientationSST(theQ.asRodrigues())) if breaker: break if breaker: break if breaker: break @@ -1466,8 +1473,6 @@ class Orientation: def __init__(self, quaternion = Quaternion.fromIdentity(), Rodrigues = None, - angleAxis = None, - matrix = None, Eulers = None, random = False, # integer to have a fixed seed or True for real random symmetry = None, @@ -1480,10 +1485,6 @@ class Orientation: self.quaternion = Quaternion.fromRandom(randomSeed=random) elif isinstance(Eulers, np.ndarray) and Eulers.shape == (3,): # based on given Euler angles self.quaternion = Quaternion.fromEulers(Eulers,degrees=degrees) - elif isinstance(matrix, np.ndarray) : # based on given rotation matrix - self.quaternion = Quaternion.fromMatrix(matrix) - elif isinstance(angleAxis, np.ndarray) and angleAxis.shape == (4,): # based on given angle and rotation axis - self.quaternion = Quaternion.fromAngleAxis(angleAxis[0],angleAxis[1:4],degrees=degrees) elif isinstance(Rodrigues, np.ndarray) and Rodrigues.shape == (3,): # based on given Rodrigues vector self.quaternion = Quaternion.fromRodrigues(Rodrigues) elif isinstance(quaternion, Quaternion): # based on given quaternion @@ -1524,7 +1525,6 @@ class Orientation: def inFZ(self): return self.symmetry.inFZ(self.quaternion.asRodrigues()) - infz = property(inFZ) def equivalentQuaternions(self, who = []): From d3ac3cc0f50624522e61d800cd438b75dee2def7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Feb 2019 08:08:14 +0100 Subject: [PATCH 293/309] using new Orientation class --- .gitlab-ci.yml | 4 +- PRIVATE | 2 +- processing/post/addIPFcolor.py | 8 +- processing/post/addPole.py | 4 +- processing/post/rotateData.py | 2 +- processing/pre/geom_fromTable.py | 3 - python/damask/__init__.py | 2 +- python/damask/orientation.py | 946 ++++++++----------------------- 8 files changed, 244 insertions(+), 727 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 368888436..de2fa3906 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -207,7 +207,9 @@ Post_ParaviewRelated: Post_OrientationConversion: stage: postprocessing - script: OrientationConversion/test.py + script: + - OrientationConversion/test.py + - OrientationConversion/test2.py except: - master - release diff --git a/PRIVATE b/PRIVATE index f0090997d..8deb37dd4 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit f0090997df817f0a0b5a480a60e81929875b1010 +Subproject commit 8deb37dd4526fb5e1425fe1d2360508d01b6ac3e diff --git a/processing/post/addIPFcolor.py b/processing/post/addIPFcolor.py index 9c191b3ad..c5e4d8704 100755 --- a/processing/post/addIPFcolor.py +++ b/processing/post/addIPFcolor.py @@ -41,6 +41,10 @@ parser.set_defaults(pole = (0.0,0.0,1.0), (options, filenames) = parser.parse_args() +# damask.Orientation requires Bravais lattice, but we are only interested in symmetry +symmetry2lattice={'cubic':'bcc','hexagonal':'hex','tetragonal':'bct'} +lattice = symmetry2lattice[options.symmetry] + pole = np.array(options.pole) pole /= np.linalg.norm(pole) @@ -78,8 +82,8 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))), - symmetry = options.symmetry).reduced() + o = damask.Orientation(np.array(list(map(float,table.data[column:column+4]))), + lattice = lattice).reduced() table.data_append(o.IPFcolor(pole)) outputAlive = table.data_write() # output processed line diff --git a/processing/post/addPole.py b/processing/post/addPole.py index 628d64d5e..5116589b4 100755 --- a/processing/post/addPole.py +++ b/processing/post/addPole.py @@ -75,9 +75,9 @@ for name in filenames: # ------------------------------------------ process data ------------------------------------------ outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4])))) + o = damask.Rotation(np.array(list(map(float,table.data[column:column+4])))) - rotatedPole = o.quaternion*pole # rotate pole according to crystal orientation + rotatedPole = o*pole # rotate pole according to crystal orientation (x,y) = rotatedPole[0:2]/(1.+abs(pole[2])) # stereographic projection table.data_append([np.sqrt(x*x+y*y),np.arctan2(y,x)] if options.polar else [x,y]) # cartesian coordinates diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 65f5aaaa2..ae42cb54a 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -31,7 +31,7 @@ parser.add_option('--degrees', action = 'store_true', help = 'angles are given in degrees') -parser.set_defaults(rotation = (0.,1.,0.,0.), # no rotation about 1,0,0 +parser.set_defaults(rotation = (0.,1.,1.,1.), # no rotation about 1,1,1 degrees = False, ) diff --git a/processing/pre/geom_fromTable.py b/processing/pre/geom_fromTable.py index c0c4cf4d1..ad598d5b1 100755 --- a/processing/pre/geom_fromTable.py +++ b/processing/pre/geom_fromTable.py @@ -52,11 +52,8 @@ parser.add_option('--crystallite', parser.set_defaults(symmetry = [damask.Symmetry.lattices[-1]], - tolerance = 0.0, - degrees = False, homogenization = 1, crystallite = 1, - verbose = False, pos = 'pos', ) diff --git a/python/damask/__init__.py b/python/damask/__init__.py index a9209a1c6..d7ed4a9f9 100644 --- a/python/damask/__init__.py +++ b/python/damask/__init__.py @@ -13,7 +13,7 @@ from .asciitable import ASCIItable # noqa from .config import Material # noqa from .colormaps import Colormap, Color # noqa -from .orientation import Quaternion, Symmetry, Rotation, Orientation # noqa +from .orientation import Symmetry, Lattice, Rotation, Orientation # noqa #from .block import Block # only one class from .result import Result # noqa diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 558e5f15d..2f9731966 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -1,13 +1,13 @@ # -*- coding: UTF-8 no BOM -*- -import math,os +import math import numpy as np from . import Lambert P = -1 #################################################################################################### -class Quaternion2: +class Quaternion: u""" Quaternion with basic operations @@ -50,7 +50,7 @@ class Quaternion2: def __add__(self, other): """Addition""" - if isinstance(other, Quaternion2): + if isinstance(other, Quaternion): return self.__class__(q=self.q + other.q, p=self.p + other.p) else: @@ -58,7 +58,7 @@ class Quaternion2: def __iadd__(self, other): """In-place addition""" - if isinstance(other, Quaternion2): + if isinstance(other, Quaternion): self.q += other.q self.p += other.p return self @@ -72,7 +72,7 @@ class Quaternion2: def __sub__(self, other): """Subtraction""" - if isinstance(other, Quaternion2): + if isinstance(other, Quaternion): return self.__class__(q=self.q - other.q, p=self.p - other.p) else: @@ -80,7 +80,7 @@ class Quaternion2: def __isub__(self, other): """In-place subtraction""" - if isinstance(other, Quaternion2): + if isinstance(other, Quaternion): self.q -= other.q self.p -= other.p return self @@ -96,7 +96,7 @@ class Quaternion2: def __mul__(self, other): """Multiplication with quaternion or scalar""" - if isinstance(other, Quaternion2): + if isinstance(other, Quaternion): return self.__class__(q=self.q*other.q - np.dot(self.p,other.p), p=self.q*other.p + other.q*self.p + P * np.cross(self.p,other.p)) elif isinstance(other, (int, float)): @@ -107,7 +107,7 @@ class Quaternion2: def __imul__(self, other): """In-place multiplication with quaternion or scalar""" - if isinstance(other, Quaternion2): + if isinstance(other, Quaternion): self.q = self.q*other.q - np.dot(self.p,other.p) self.p = self.q*other.p + other.q*self.p + P * np.cross(self.p,other.p) return self @@ -120,7 +120,7 @@ class Quaternion2: def __truediv__(self, other): """Divsion with quaternion or scalar""" - if isinstance(other, Quaternion2): + if isinstance(other, Quaternion): s = other.conjugate()/abs(other)**2. return self.__class__(q=self.q * s, p=self.p * s) @@ -133,7 +133,7 @@ class Quaternion2: def __itruediv__(self, other): """In-place divsion with quaternion or scalar""" - if isinstance(other, Quaternion2): + if isinstance(other, Quaternion): s = other.conjugate()/abs(other)**2. self *= s return self @@ -215,7 +215,8 @@ class Rotation: u""" Orientation stored as unit quaternion. - All methods and naming conventions based on Rowenhorst_etal2015 + Following: D Rowenhorst et al. Consistent representations of and conversions between 3D rotations + 10.1088/0965-0393/23/8/083501 Convention 1: coordinate frames are right-handed Convention 2: a rotation angle ω is taken to be positive for a counterclockwise rotation when viewing from the end point of the rotation axis towards the origin @@ -242,10 +243,10 @@ class Rotation: If a quaternion is given, it needs to comply with the convection. Use .fromQuaternion to check the input. """ - if isinstance(quaternion,Quaternion2): + if isinstance(quaternion,Quaternion): self.quaternion = quaternion.copy() else: - self.quaternion = Quaternion2(q=quaternion[0],p=quaternion[1:4]) + self.quaternion = Quaternion(q=quaternion[0],p=quaternion[1:4]) self.quaternion.homomorph() # ToDo: Needed? def __repr__(self): @@ -453,374 +454,7 @@ class Rotation: def misorientation(self,other): """Misorientation""" return self.__class__(other.quaternion*self.quaternion.conjugated()) - - -# ****************************************************************************************** -class Quaternion: - u""" - Orientation represented as unit quaternion. - - All methods and naming conventions based on Rowenhorst_etal2015 - Convention 1: coordinate frames are right-handed - Convention 2: a rotation angle ω is taken to be positive for a counterclockwise rotation - when viewing from the end point of the rotation axis towards the origin - Convention 3: rotations will be interpreted in the passive sense - Convention 4: Euler angle triplets are implemented using the Bunge convention, - with the angular ranges as [0, 2π],[0, π],[0, 2π] - Convention 5: the rotation angle ω is limited to the interval [0, π] - Convention 6: P = -1 (as default) - - w is the real part, (x, y, z) are the imaginary parts. - - Vector "a" (defined in coordinate system "A") is passively rotated - resulting in new coordinates "b" when expressed in system "B". - b = Q * a - b = np.dot(Q.asMatrix(),a) - """ - - def __init__(self, - quat = None, - q = 1.0, - p = np.zeros(3,dtype=float)): - """Initializes to identity unless specified""" - self.q = quat[0] if quat is not None else q - self.p = np.array(quat[1:4]) if quat is not None else p - self.homomorph() - - def __iter__(self): - """Components""" - return iter(self.asList()) - - def __copy__(self): - """Copy""" - return self.__class__(q=self.q,p=self.p.copy()) - - copy = __copy__ - - def __repr__(self): - """Readable string""" - return 'Quaternion(real={q:+.6f}, imag=<{p[0]:+.6f}, {p[1]:+.6f}, {p[2]:+.6f}>)'.format(q=self.q,p=self.p) - - def __pow__(self, exponent): - """Power""" - omega = math.acos(self.q) - return self.__class__(q= math.cos(exponent*omega), - p=self.p * math.sin(exponent*omega)/math.sin(omega)) - - def __ipow__(self, exponent): - """In-place power""" - omega = math.acos(self.q) - self.q = math.cos(exponent*omega) - self.p *= math.sin(exponent*omega)/math.sin(omega) - return self - - def __mul__(self, other): - """Multiplication""" - # Rowenhorst_etal2015 MSMSE: value of P is selected as -1 - P = -1.0 - try: # quaternion - return self.__class__(q=self.q*other.q - np.dot(self.p,other.p), - p=self.q*other.p + other.q*self.p + P * np.cross(self.p,other.p)) - except: pass - try: # vector (perform passive rotation) - ( x, y, z) = self.p - (Vx,Vy,Vz) = other[0:3] - A = self.q*self.q - np.dot(self.p,self.p) - B = 2.0 * (x*Vx + y*Vy + z*Vz) - C = 2.0 * P*self.q - - return np.array([ - A*Vx + B*x + C*(y*Vz - z*Vy), - A*Vy + B*y + C*(z*Vx - x*Vz), - A*Vz + B*z + C*(x*Vy - y*Vx), - ]) - except: pass - try: # scalar - return self.__class__(q=self.q*other, - p=self.p*other) - except: - return self.copy() - - def __imul__(self, other): - """In-place multiplication""" - # Rowenhorst_etal2015 MSMSE: value of P is selected as -1 - P = -1.0 - try: # Quaternion - self.q = self.q*other.q - np.dot(self.p,other.p) - self.p = self.q*other.p + other.q*self.p + P * np.cross(self.p,other.p) - except: pass - return self - - def __div__(self, other): - """Division""" - if isinstance(other, (int,float)): - return self.__class__(q=self.q / other, - p=self.p / other) - else: - return NotImplemented - - def __idiv__(self, other): - """In-place division""" - if isinstance(other, (int,float)): - self.q /= other - self.p /= other - return self - - def __add__(self, other): - """Addition""" - if isinstance(other, Quaternion): - return self.__class__(q=self.q + other.q, - p=self.p + other.p) - else: - return NotImplemented - - def __iadd__(self, other): - """In-place addition""" - if isinstance(other, Quaternion): - self.q += other.q - self.p += other.p - return self - - def __sub__(self, other): - """Subtraction""" - if isinstance(other, Quaternion): - return self.__class__(q=self.q - other.q, - p=self.p - other.p) - else: - return NotImplemented - - def __isub__(self, other): - """In-place subtraction""" - if isinstance(other, Quaternion): - self.q -= other.q - self.p -= other.p - return self - - def __neg__(self): - """Additive inverse""" - self.q = -self.q - self.p = -self.p - return self - - def __abs__(self): - """Norm""" - return math.sqrt(self.q ** 2 + np.dot(self.p,self.p)) - - magnitude = __abs__ - - def __eq__(self,other): - """Equal (sufficiently close) to each other""" - return np.isclose(( self-other).magnitude(),0.0) \ - or np.isclose((-self-other).magnitude(),0.0) - - def __ne__(self,other): - """Not equal (sufficiently close) to each other""" - return not self.__eq__(other) - - def __cmp__(self,other): - """Linear ordering""" - return (1 if np.linalg.norm(self.asRodrigues()) > np.linalg.norm(other.asRodrigues()) else 0) \ - - (1 if np.linalg.norm(self.asRodrigues()) < np.linalg.norm(other.asRodrigues()) else 0) - - def magnitude_squared(self): - return self.q ** 2 + np.dot(self.p,self.p) - - def normalize(self): - d = self.magnitude() - if d > 0.0: - self.q /= d - self.p /= d - return self - - def conjugate(self): - self.p = -self.p - return self - - def homomorph(self): - if self.q < 0.0: - self.q = -self.q - self.p = -self.p - return self - - def normalized(self): - return self.copy().normalize() - - def conjugated(self): - return self.copy().conjugate() - - def homomorphed(self): - return self.copy().homomorph() - - def asList(self): - return [self.q]+list(self.p) - - def asM(self): # to find Averaging Quaternions (see F. Landis Markley et al.) - return np.outer(self.asList(),self.asList()) - def asMatrix(self): - # Rowenhorst_etal2015 MSMSE: value of P is selected as -1 - P = -1.0 - qbarhalf = 0.5*(self.q**2 - np.dot(self.p,self.p)) - return 2.0*np.array( - [[ qbarhalf + self.p[0]**2 , - self.p[0]*self.p[1] -P* self.q*self.p[2], - self.p[0]*self.p[2] +P* self.q*self.p[1] ], - [ self.p[0]*self.p[1] +P* self.q*self.p[2], - qbarhalf + self.p[1]**2 , - self.p[1]*self.p[2] -P* self.q*self.p[0] ], - [ self.p[0]*self.p[2] -P* self.q*self.p[1], - self.p[1]*self.p[2] +P* self.q*self.p[0], - qbarhalf + self.p[2]**2 ], - ]) - - def asAngleAxis(self, - degrees = False, - flat = False): - - angle = 2.0*math.acos(self.q) - - if np.isclose(angle,0.0): - angle = 0.0 - axis = np.array([0.0,0.0,1.0]) - elif np.isclose(self.q,0.0): - angle = math.pi - axis = self.p - else: - axis = np.sign(self.q)*self.p/np.linalg.norm(self.p) - - angle = np.degrees(angle) if degrees else angle - - return np.hstack((angle,axis)) if flat else (angle,axis) - - def asRodrigues(self): - return np.inf*np.ones(3) if np.isclose(self.q,0.0) else self.p/self.q - - -# # Static constructors - @classmethod - def fromIdentity(cls): - return cls() - - - @classmethod - def fromRandom(cls,randomSeed = None): - import binascii - if randomSeed is None: - randomSeed = int(binascii.hexlify(os.urandom(4)),16) - np.random.seed(randomSeed) - r = np.random.random(3) - A = math.sqrt(max(0.0,r[2])) - B = math.sqrt(max(0.0,1.0-r[2])) - w = math.cos(2.0*math.pi*r[0])*A - x = math.sin(2.0*math.pi*r[1])*B - y = math.cos(2.0*math.pi*r[1])*B - z = math.sin(2.0*math.pi*r[0])*A - return cls(quat=[w,x,y,z]) - - - @classmethod - def fromRodrigues(cls, rodrigues): - if not isinstance(rodrigues, np.ndarray): rodrigues = np.array(rodrigues) - norm = np.linalg.norm(rodrigues) - halfangle = math.atan(norm) - s = math.sin(halfangle) - c = math.cos(halfangle) - return cls(q=c,p=s*rodrigues/norm) - - - @classmethod - def fromAngleAxis(cls, - angle, - axis, - degrees = False): - if not isinstance(axis, np.ndarray): axis = np.array(axis,dtype=float) - axis = axis.astype(float)/np.linalg.norm(axis) - angle = np.radians(angle) if degrees else angle - s = math.sin(0.5 * angle) - c = math.cos(0.5 * angle) - return cls(q=c,p=axis*s) - - - @classmethod - def fromEulers(cls, - eulers, - degrees = False): - if not isinstance(eulers, np.ndarray): eulers = np.array(eulers,dtype=float) - eulers = np.radians(eulers) if degrees else eulers - - sigma = 0.5*(eulers[0]+eulers[2]) - delta = 0.5*(eulers[0]-eulers[2]) - c = np.cos(0.5*eulers[1]) - s = np.sin(0.5*eulers[1]) - - # Rowenhorst_etal2015 MSMSE: value of P is selected as -1 - P = -1.0 - w = c * np.cos(sigma) - x = -P * s * np.cos(delta) - y = -P * s * np.sin(delta) - z = -P * c * np.sin(sigma) - return cls(quat=[w,x,y,z]) - - -# Modified Method to calculate Quaternion from Orientation Matrix, -# Source: http://www.euclideanspace.com/maths/geometry/rotations/conversions/matrixToQuaternion/ - - @classmethod - def fromMatrix(cls, m): - if m.shape != (3,3) and np.prod(m.shape) == 9: - m = m.reshape(3,3) - - # Rowenhorst_etal2015 MSMSE: value of P is selected as -1 - P = -1.0 - w = 0.5*math.sqrt(max(0.0,1.0+m[0,0]+m[1,1]+m[2,2])) - x = P*0.5*math.sqrt(max(0.0,1.0+m[0,0]-m[1,1]-m[2,2])) - y = P*0.5*math.sqrt(max(0.0,1.0-m[0,0]+m[1,1]-m[2,2])) - z = P*0.5*math.sqrt(max(0.0,1.0-m[0,0]-m[1,1]+m[2,2])) - - x *= -1 if m[2,1] < m[1,2] else 1 - y *= -1 if m[0,2] < m[2,0] else 1 - z *= -1 if m[1,0] < m[0,1] else 1 - - return cls(quat=np.array([w,x,y,z])/math.sqrt(w**2 + x**2 + y**2 + z**2)) - - - @classmethod - def new_interpolate(cls, q1, q2, t): - """ - Interpolation - - See http://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/20070017872_2007014421.pdf - for (another?) way to interpolate quaternions. - """ - assert isinstance(q1, Quaternion) and isinstance(q2, Quaternion) - Q = cls() - - costheta = q1.q*q2.q + np.dot(q1.p,q2.p) - if costheta < 0.: - costheta = -costheta - q1 = q1.conjugated() - elif costheta > 1.: - costheta = 1. - - theta = math.acos(costheta) - if abs(theta) < 0.01: - Q.q = q2.q - Q.p = q2.p - return Q - - sintheta = math.sqrt(1.0 - costheta * costheta) - if abs(sintheta) < 0.01: - Q.q = (q1.q + q2.q) * 0.5 - Q.p = (q1.p + q2.p) * 0.5 - return Q - - ratio1 = math.sin((1.0 - t) * theta) / sintheta - ratio2 = math.sin( t * theta) / sintheta - - Q.q = q1.q * ratio1 + q2.q * ratio2 - Q.p = q1.p * ratio1 + q2.p * ratio2 - return Q - # ****************************************************************************************** class Symmetry: @@ -932,26 +566,16 @@ class Symmetry: [ 1.0,0.0,0.0,0.0 ], ] - return list(map(Quaternion, - np.array(symQuats)[np.atleast_1d(np.array(who)) if who != [] else range(len(symQuats))])) + return np.array(symQuats) - - def equivalentQuaternions(self, - quaternion, - who = []): - """List of symmetrically equivalent quaternions based on own symmetry.""" - return [q*quaternion for q in self.symmetryQuats(who)] - def inFZ(self,R): - """Check whether given Rodrigues vector falls into fundamental zone of own symmetry.""" - if isinstance(R, Quaternion): R = R.asRodrigues() # translate accidentally passed quaternion -# fundamental zone in Rodrigues space is point symmetric around origin - - if R.shape[0]==4: # transition old (length not stored separately) to new - Rabs = abs(R[0:3]*R[3]) - else: - Rabs = abs(R) + """ + Check whether given Rodrigues vector falls into fundamental zone of own symmetry. + + Fundamental zone in Rodrigues space is point symmetric around origin. + """ + Rabs = abs(R[0:3]*R[3]) if self.lattice == 'cubic': return math.sqrt(2.0)-1.0 >= Rabs[0] \ @@ -1184,181 +808,181 @@ class Lattice: # from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 GT = {'mapping':{'fcc':0,'bcc':1}, 'planes': np.array([ - [[ 1, 1, 1],[ 1, 0, 1]], - [[ 1, 1, 1],[ 1, 1, 0]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ -1, -1, 1],[ -1, 0, 1]], - [[ -1, -1, 1],[ -1, -1, 0]], - [[ -1, -1, 1],[ 0, -1, 1]], - [[ -1, 1, 1],[ -1, 0, 1]], - [[ -1, 1, 1],[ -1, 1, 0]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 1, 0, 1]], - [[ 1, -1, 1],[ 1, -1, 0]], - [[ 1, -1, 1],[ 0, -1, 1]], - [[ 1, 1, 1],[ 1, 1, 0]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 1, 0, 1]], - [[ -1, -1, 1],[ -1, -1, 0]], - [[ -1, -1, 1],[ 0, -1, 1]], - [[ -1, -1, 1],[ -1, 0, 1]], - [[ -1, 1, 1],[ -1, 1, 0]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ -1, 0, 1]], - [[ 1, -1, 1],[ 1, -1, 0]], - [[ 1, -1, 1],[ 0, -1, 1]], - [[ 1, -1, 1],[ 1, 0, 1]]],dtype='float'), + [[ 1, 1, 1],[ 1, 0, 1]], + [[ 1, 1, 1],[ 1, 1, 0]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ -1, -1, 1],[ -1, 0, 1]], + [[ -1, -1, 1],[ -1, -1, 0]], + [[ -1, -1, 1],[ 0, -1, 1]], + [[ -1, 1, 1],[ -1, 0, 1]], + [[ -1, 1, 1],[ -1, 1, 0]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 1, 0, 1]], + [[ 1, -1, 1],[ 1, -1, 0]], + [[ 1, -1, 1],[ 0, -1, 1]], + [[ 1, 1, 1],[ 1, 1, 0]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 1, 0, 1]], + [[ -1, -1, 1],[ -1, -1, 0]], + [[ -1, -1, 1],[ 0, -1, 1]], + [[ -1, -1, 1],[ -1, 0, 1]], + [[ -1, 1, 1],[ -1, 1, 0]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ -1, 0, 1]], + [[ 1, -1, 1],[ 1, -1, 0]], + [[ 1, -1, 1],[ 0, -1, 1]], + [[ 1, -1, 1],[ 1, 0, 1]]],dtype='float'), 'directions': np.array([ - [[ -5,-12, 17],[-17, -7, 17]], - [[ 17, -5,-12],[ 17,-17, -7]], - [[-12, 17, -5],[ -7, 17,-17]], - [[ 5, 12, 17],[ 17, 7, 17]], - [[-17, 5,-12],[-17, 17, -7]], - [[ 12,-17, -5],[ 7,-17,-17]], - [[ -5, 12,-17],[-17, 7,-17]], - [[ 17, 5, 12],[ 17, 17, 7]], - [[-12,-17, 5],[ -7,-17, 17]], - [[ 5,-12,-17],[ 17, -7,-17]], - [[-17, -5, 12],[-17,-17, 7]], - [[ 12, 17, 5],[ 7, 17, 17]], - [[ -5, 17,-12],[-17, 17, -7]], - [[-12, -5, 17],[ -7,-17, 17]], - [[ 17,-12, -5],[ 17, -7,-17]], - [[ 5,-17,-12],[ 17,-17, -7]], - [[ 12, 5, 17],[ 7, 17, 17]], - [[-17, 12, -5],[-17, 7,-17]], - [[ -5,-17, 12],[-17,-17, 7]], - [[-12, 5,-17],[ -7, 17,-17]], - [[ 17, 12, 5],[ 17, 7, 17]], - [[ 5, 17, 12],[ 17, 17, 7]], - [[ 12, -5,-17],[ 7,-17,-17]], - [[-17,-12, 5],[-17, 7, 17]]],dtype='float')} + [[ -5,-12, 17],[-17, -7, 17]], + [[ 17, -5,-12],[ 17,-17, -7]], + [[-12, 17, -5],[ -7, 17,-17]], + [[ 5, 12, 17],[ 17, 7, 17]], + [[-17, 5,-12],[-17, 17, -7]], + [[ 12,-17, -5],[ 7,-17,-17]], + [[ -5, 12,-17],[-17, 7,-17]], + [[ 17, 5, 12],[ 17, 17, 7]], + [[-12,-17, 5],[ -7,-17, 17]], + [[ 5,-12,-17],[ 17, -7,-17]], + [[-17, -5, 12],[-17,-17, 7]], + [[ 12, 17, 5],[ 7, 17, 17]], + [[ -5, 17,-12],[-17, 17, -7]], + [[-12, -5, 17],[ -7,-17, 17]], + [[ 17,-12, -5],[ 17, -7,-17]], + [[ 5,-17,-12],[ 17,-17, -7]], + [[ 12, 5, 17],[ 7, 17, 17]], + [[-17, 12, -5],[-17, 7,-17]], + [[ -5,-17, 12],[-17,-17, 7]], + [[-12, 5,-17],[ -7, 17,-17]], + [[ 17, 12, 5],[ 17, 7, 17]], + [[ 5, 17, 12],[ 17, 17, 7]], + [[ 12, -5,-17],[ 7,-17,-17]], + [[-17,-12, 5],[-17, 7, 17]]],dtype='float')} # Greninger--Troiano' orientation relationship for fcc <-> bcc transformation # from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 GTdash = {'mapping':{'fcc':0,'bcc':1}, 'planes': np.array([ - [[ 7, 17, 17],[ 12, 5, 17]], - [[ 17, 7, 17],[ 17, 12, 5]], - [[ 17, 17, 7],[ 5, 17, 12]], - [[ -7,-17, 17],[-12, -5, 17]], - [[-17, -7, 17],[-17,-12, 5]], - [[-17,-17, 7],[ -5,-17, 12]], - [[ 7,-17,-17],[ 12, -5,-17]], - [[ 17, -7,-17],[ 17,-12, -5]], - [[ 17,-17, -7],[ 5,-17,-12]], - [[ -7, 17,-17],[-12, 5,-17]], - [[-17, 7,-17],[-17, 12, -5]], - [[-17, 17, -7],[ -5, 17,-12]], - [[ 7, 17, 17],[ 12, 17, 5]], - [[ 17, 7, 17],[ 5, 12, 17]], - [[ 17, 17, 7],[ 17, 5, 12]], - [[ -7,-17, 17],[-12,-17, 5]], - [[-17, -7, 17],[ -5,-12, 17]], - [[-17,-17, 7],[-17, -5, 12]], - [[ 7,-17,-17],[ 12,-17, -5]], - [[ 17, -7,-17],[ 5, -12,-17]], - [[ 17,-17, 7],[ 17, -5,-12]], - [[ -7, 17,-17],[-12, 17, -5]], - [[-17, 7,-17],[ -5, 12,-17]], - [[-17, 17, -7],[-17, 5,-12]]],dtype='float'), + [[ 7, 17, 17],[ 12, 5, 17]], + [[ 17, 7, 17],[ 17, 12, 5]], + [[ 17, 17, 7],[ 5, 17, 12]], + [[ -7,-17, 17],[-12, -5, 17]], + [[-17, -7, 17],[-17,-12, 5]], + [[-17,-17, 7],[ -5,-17, 12]], + [[ 7,-17,-17],[ 12, -5,-17]], + [[ 17, -7,-17],[ 17,-12, -5]], + [[ 17,-17, -7],[ 5,-17,-12]], + [[ -7, 17,-17],[-12, 5,-17]], + [[-17, 7,-17],[-17, 12, -5]], + [[-17, 17, -7],[ -5, 17,-12]], + [[ 7, 17, 17],[ 12, 17, 5]], + [[ 17, 7, 17],[ 5, 12, 17]], + [[ 17, 17, 7],[ 17, 5, 12]], + [[ -7,-17, 17],[-12,-17, 5]], + [[-17, -7, 17],[ -5,-12, 17]], + [[-17,-17, 7],[-17, -5, 12]], + [[ 7,-17,-17],[ 12,-17, -5]], + [[ 17, -7,-17],[ 5, -12,-17]], + [[ 17,-17, 7],[ 17, -5,-12]], + [[ -7, 17,-17],[-12, 17, -5]], + [[-17, 7,-17],[ -5, 12,-17]], + [[-17, 17, -7],[-17, 5,-12]]],dtype='float'), 'directions': np.array([ - [[ 0, 1, -1],[ 1, 1, -1]], - [[ -1, 0, 1],[ -1, 1, 1]], - [[ 1, -1, 0],[ 1, -1, 1]], - [[ 0, -1, -1],[ -1, -1, -1]], - [[ 1, 0, 1],[ 1, -1, 1]], - [[ 1, -1, 0],[ 1, -1, -1]], - [[ 0, 1, -1],[ -1, 1, -1]], - [[ 1, 0, 1],[ 1, 1, 1]], - [[ -1, -1, 0],[ -1, -1, 1]], - [[ 0, -1, -1],[ 1, -1, -1]], - [[ -1, 0, 1],[ -1, -1, 1]], - [[ -1, -1, 0],[ -1, -1, -1]], - [[ 0, -1, 1],[ 1, -1, 1]], - [[ 1, 0, -1],[ 1, 1, -1]], - [[ -1, 1, 0],[ -1, 1, 1]], - [[ 0, 1, 1],[ -1, 1, 1]], - [[ -1, 0, -1],[ -1, -1, -1]], - [[ -1, 1, 0],[ -1, 1, -1]], - [[ 0, -1, 1],[ -1, -1, 1]], - [[ -1, 0, -1],[ -1, 1, -1]], - [[ 1, 1, 0],[ 1, 1, 1]], - [[ 0, 1, 1],[ 1, 1, 1]], - [[ 1, 0, -1],[ 1, -1, -1]], - [[ 1, 1, 0],[ 1, 1, -1]]],dtype='float')} + [[ 0, 1, -1],[ 1, 1, -1]], + [[ -1, 0, 1],[ -1, 1, 1]], + [[ 1, -1, 0],[ 1, -1, 1]], + [[ 0, -1, -1],[ -1, -1, -1]], + [[ 1, 0, 1],[ 1, -1, 1]], + [[ 1, -1, 0],[ 1, -1, -1]], + [[ 0, 1, -1],[ -1, 1, -1]], + [[ 1, 0, 1],[ 1, 1, 1]], + [[ -1, -1, 0],[ -1, -1, 1]], + [[ 0, -1, -1],[ 1, -1, -1]], + [[ -1, 0, 1],[ -1, -1, 1]], + [[ -1, -1, 0],[ -1, -1, -1]], + [[ 0, -1, 1],[ 1, -1, 1]], + [[ 1, 0, -1],[ 1, 1, -1]], + [[ -1, 1, 0],[ -1, 1, 1]], + [[ 0, 1, 1],[ -1, 1, 1]], + [[ -1, 0, -1],[ -1, -1, -1]], + [[ -1, 1, 0],[ -1, 1, -1]], + [[ 0, -1, 1],[ -1, -1, 1]], + [[ -1, 0, -1],[ -1, 1, -1]], + [[ 1, 1, 0],[ 1, 1, 1]], + [[ 0, 1, 1],[ 1, 1, 1]], + [[ 1, 0, -1],[ 1, -1, -1]], + [[ 1, 1, 0],[ 1, 1, -1]]],dtype='float')} # Nishiyama--Wassermann orientation relationship for fcc <-> bcc transformation # from H. Kitahara et al./Materials Characterization 54 (2005) 378-386 NW = {'mapping':{'fcc':0,'bcc':1}, 'planes': np.array([ - [[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ 1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ -1, 1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ 1, -1, 1],[ 0, 1, 1]], - [[ -1, -1, 1],[ 0, 1, 1]], - [[ -1, -1, 1],[ 0, 1, 1]], - [[ -1, -1, 1],[ 0, 1, 1]]],dtype='float'), + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ 1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ -1, 1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ 1, -1, 1],[ 0, 1, 1]], + [[ -1, -1, 1],[ 0, 1, 1]], + [[ -1, -1, 1],[ 0, 1, 1]], + [[ -1, -1, 1],[ 0, 1, 1]]],dtype='float'), 'directions': np.array([ - [[ 2, -1, -1],[ 0, -1, 1]], - [[ -1, 2, -1],[ 0, -1, 1]], - [[ -1, -1, 2],[ 0, -1, 1]], - [[ -2, -1, -1],[ 0, -1, 1]], - [[ 1, 2, -1],[ 0, -1, 1]], - [[ 1, -1, 2],[ 0, -1, 1]], - [[ 2, 1, -1],[ 0, -1, 1]], - [[ -1, -2, -1],[ 0, -1, 1]], - [[ -1, 1, 2],[ 0, -1, 1]], - [[ -1, 2, 1],[ 0, -1, 1]], - [[ -1, 2, 1],[ 0, -1, 1]], - [[ -1, -1, -2],[ 0, -1, 1]]],dtype='float')} + [[ 2, -1, -1],[ 0, -1, 1]], + [[ -1, 2, -1],[ 0, -1, 1]], + [[ -1, -1, 2],[ 0, -1, 1]], + [[ -2, -1, -1],[ 0, -1, 1]], + [[ 1, 2, -1],[ 0, -1, 1]], + [[ 1, -1, 2],[ 0, -1, 1]], + [[ 2, 1, -1],[ 0, -1, 1]], + [[ -1, -2, -1],[ 0, -1, 1]], + [[ -1, 1, 2],[ 0, -1, 1]], + [[ -1, 2, 1],[ 0, -1, 1]], + [[ -1, 2, 1],[ 0, -1, 1]], + [[ -1, -1, -2],[ 0, -1, 1]]],dtype='float')} # Pitsch orientation relationship for fcc <-> bcc transformation # from Y. He et al./Acta Materialia 53 (2005) 1179-1190 Pitsch = {'mapping':{'fcc':0,'bcc':1}, 'planes': np.array([ - [[ 0, 1, 0],[ -1, 0, 1]], - [[ 0, 0, 1],[ 1, -1, 0]], - [[ 1, 0, 0],[ 0, 1, -1]], - [[ 1, 0, 0],[ 0, -1, -1]], - [[ 0, 1, 0],[ -1, 0, -1]], - [[ 0, 0, 1],[ -1, -1, 0]], - [[ 0, 1, 0],[ -1, 0, -1]], - [[ 0, 0, 1],[ -1, -1, 0]], - [[ 1, 0, 0],[ 0, -1, -1]], - [[ 1, 0, 0],[ 0, -1, 1]], - [[ 0, 1, 0],[ 1, 0, -1]], - [[ 0, 0, 1],[ -1, 1, 0]]],dtype='float'), + [[ 0, 1, 0],[ -1, 0, 1]], + [[ 0, 0, 1],[ 1, -1, 0]], + [[ 1, 0, 0],[ 0, 1, -1]], + [[ 1, 0, 0],[ 0, -1, -1]], + [[ 0, 1, 0],[ -1, 0, -1]], + [[ 0, 0, 1],[ -1, -1, 0]], + [[ 0, 1, 0],[ -1, 0, -1]], + [[ 0, 0, 1],[ -1, -1, 0]], + [[ 1, 0, 0],[ 0, -1, -1]], + [[ 1, 0, 0],[ 0, -1, 1]], + [[ 0, 1, 0],[ 1, 0, -1]], + [[ 0, 0, 1],[ -1, 1, 0]]],dtype='float'), 'directions': np.array([ - [[ 1, 0, 1],[ 1, -1, 1]], - [[ 1, 1, 0],[ 1, 1, -1]], - [[ 0, 1, 1],[ -1, 1, 1]], - [[ 0, 1, -1],[ -1, 1, -1]], - [[ -1, 0, 1],[ -1, -1, 1]], - [[ 1, -1, 0],[ 1, -1, -1]], - [[ 1, 0, -1],[ 1, -1, -1]], - [[ -1, 1, 0],[ -1, 1, -1]], - [[ 0, -1, 1],[ -1, -1, 1]], - [[ 0, 1, 1],[ -1, 1, 1]], - [[ 1, 0, 1],[ 1, -1, 1]], - [[ 1, 1, 0],[ 1, 1, -1]]],dtype='float')} + [[ 1, 0, 1],[ 1, -1, 1]], + [[ 1, 1, 0],[ 1, 1, -1]], + [[ 0, 1, 1],[ -1, 1, 1]], + [[ 0, 1, -1],[ -1, 1, -1]], + [[ -1, 0, 1],[ -1, -1, 1]], + [[ 1, -1, 0],[ 1, -1, -1]], + [[ 1, 0, -1],[ 1, -1, -1]], + [[ -1, 1, 0],[ -1, 1, -1]], + [[ 0, -1, 1],[ -1, -1, 1]], + [[ 0, 1, 1],[ -1, 1, 1]], + [[ 1, 0, 1],[ 1, -1, 1]], + [[ 1, 1, 0],[ 1, 1, -1]]],dtype='float')} # Bain orientation relationship for fcc <-> bcc transformation # from Y. He et al./Journal of Applied Crystallography (2006). 39, 72-81 Bain = {'mapping':{'fcc':0,'bcc':1}, 'planes': np.array([ - [[ 1, 0, 0],[ 1, 0, 0]], - [[ 0, 1, 0],[ 0, 1, 0]], - [[ 0, 0, 1],[ 0, 0, 1]]],dtype='float'), + [[ 1, 0, 0],[ 1, 0, 0]], + [[ 0, 1, 0],[ 0, 1, 0]], + [[ 0, 0, 1],[ 0, 0, 1]]],dtype='float'), 'directions': np.array([ - [[ 0, 1, 0],[ 0, 1, 1]], - [[ 0, 0, 1],[ 1, 0, 1]], - [[ 1, 0, 0],[ 1, 1, 0]]],dtype='float')} + [[ 0, 1, 0],[ 0, 1, 1]], + [[ 0, 0, 1],[ 1, 0, 1]], + [[ 1, 0, 0],[ 1, 1, 0]]],dtype='float')} def relationOperations(self,model): @@ -1367,27 +991,30 @@ class Lattice: relationship = models[model] - r = {'lattice':Lattice((set(relationship['mapping'])-{self.lattice}).pop()), + r = {'lattice':Lattice((set(relationship['mapping'])-{self.lattice}).pop()), # target lattice 'rotations':[] } myPlane_id = relationship['mapping'][self.lattice] otherPlane_id = (myPlane_id+1)%2 myDir_id = myPlane_id +2 otherDir_id = otherPlane_id +2 + for miller in np.hstack((relationship['planes'],relationship['directions'])): - myPlane = miller[myPlane_id]/ np.linalg.norm(miller[myPlane_id]) - myDir = miller[myDir_id]/ np.linalg.norm(miller[myDir_id]) - otherPlane = miller[otherPlane_id]/ np.linalg.norm(miller[otherPlane_id]) - otherDir = miller[otherDir_id]/ np.linalg.norm(miller[otherDir_id]) - - myMatrix = np.array([myDir,np.cross(myPlane,myDir),myPlane]).T - otherMatrix = np.array([otherDir,np.cross(otherPlane,otherDir),otherPlane]).T + myPlane = miller[myPlane_id]/ np.linalg.norm(miller[myPlane_id]) + myDir = miller[myDir_id]/ np.linalg.norm(miller[myDir_id]) + myMatrix = np.array([myDir,np.cross(myPlane,myDir),myPlane]).T + + otherPlane = miller[otherPlane_id]/ np.linalg.norm(miller[otherPlane_id]) + otherDir = miller[otherDir_id]/ np.linalg.norm(miller[otherDir_id]) + otherMatrix = np.array([otherDir,np.cross(otherPlane,otherDir),otherPlane]).T + r['rotations'].append(Rotation.fromMatrix(np.dot(otherMatrix,myMatrix.T))) + return r -class Orientation2: +class Orientation: """ Crystallographic orientation @@ -1426,32 +1053,28 @@ class Orientation2: # raise NotImplementedError('disorientation between different symmetry classes not supported yet.') mis = other.rotation*self.rotation.inversed() - mySymEqs = self.equivalentOrientations() if SST else self.equivalentOrientations()[:1] # take all or only first sym operation + mySymEqs = self.equivalentOrientations() if SST else self.equivalentOrientations()[:1] # take all or only first sym operation otherSymEqs = other.equivalentOrientations() for i,sA in enumerate(mySymEqs): for j,sB in enumerate(otherSymEqs): - theQ = sB.rotation*mis*sA.rotation.inversed() + r = sB.rotation*mis*sA.rotation.inversed() for k in range(2): - theQ.inversed() - breaker = self.lattice.symmetry.inFZ(theQ.asRodrigues()) \ - and (not SST or other.lattice.symmetry.inDisorientationSST(theQ.asRodrigues())) + r.inversed() + breaker = self.lattice.symmetry.inFZ(r.asRodrigues()) \ + and (not SST or other.lattice.symmetry.inDisorientationSST(r.asRodrigues())) if breaker: break if breaker: break if breaker: break -# disorientation, own sym, other sym, self-->other: True, self<--other: False - return theQ + return r def inFZ(self): return self.lattice.symmetry.inFZ(self.rotation.asRodrigues()) def equivalentOrientations(self): """List of orientations which are symmetrically equivalent""" - q = self.lattice.symmetry.symmetryQuats() - q2 = [Quaternion2(q=a.asList()[0],p=a.asList()[1:4]) for a in q] # convert Quaternion to Quaternion2 - x = [self.__class__(q3*self.rotation.quaternion,self.lattice) for q3 in q2] - return x + return [self.__class__(q*self.rotation.quaternion,self.lattice) for q in self.lattice.symmetry.symmetryQuats()] def relatedOrientations(self,model): """List of orientations related by the given orientation relationship""" @@ -1464,177 +1087,69 @@ class Orientation2: if self.lattice.symmetry.inFZ(me.rotation.asRodrigues()): break return self.__class__(me.rotation,self.lattice) - -# ****************************************************************************************** -class Orientation: - - __slots__ = ['quaternion','symmetry'] - - def __init__(self, - quaternion = Quaternion.fromIdentity(), - Rodrigues = None, - Eulers = None, - random = False, # integer to have a fixed seed or True for real random - symmetry = None, - degrees = False, - ): - if random: # produce random orientation - if isinstance(random, bool ): - self.quaternion = Quaternion.fromRandom() - else: - self.quaternion = Quaternion.fromRandom(randomSeed=random) - elif isinstance(Eulers, np.ndarray) and Eulers.shape == (3,): # based on given Euler angles - self.quaternion = Quaternion.fromEulers(Eulers,degrees=degrees) - elif isinstance(Rodrigues, np.ndarray) and Rodrigues.shape == (3,): # based on given Rodrigues vector - self.quaternion = Quaternion.fromRodrigues(Rodrigues) - elif isinstance(quaternion, Quaternion): # based on given quaternion - self.quaternion = quaternion.homomorphed() - elif (isinstance(quaternion, np.ndarray) and quaternion.shape == (4,)) or \ - (isinstance(quaternion, list) and len(quaternion) == 4 ): # based on given quaternion-like array - self.quaternion = Quaternion(quat=quaternion).homomorphed() - - self.symmetry = Symmetry(symmetry) - - def __copy__(self): - """Copy""" - return self.__class__(quaternion=self.quaternion,symmetry=self.symmetry.lattice) - - copy = __copy__ - - - def __repr__(self): - """Value as all implemented representations""" - return '\n'.join([ - 'Symmetry: {}'.format(self.symmetry), - 'Quaternion: {}'.format(self.quaternion), - 'Matrix:\n{}'.format( '\n'.join(['\t'.join(list(map(str,self.asMatrix()[i,:]))) for i in range(3)]) ), - ]) - - def asRodrigues(self): - return self.quaternion.asRodrigues() - rodrigues = property(asRodrigues) - - def asAngleAxis(self, - degrees = False, - flat = False): - return self.quaternion.asAngleAxis(degrees,flat) - - def asMatrix(self): - return self.quaternion.asMatrix() - matrix = property(asMatrix) - - def inFZ(self): - return self.symmetry.inFZ(self.quaternion.asRodrigues()) - - def equivalentQuaternions(self, - who = []): - return self.symmetry.equivalentQuaternions(self.quaternion,who) - - def equivalentOrientations(self, - who = []): - return [Orientation(quaternion = q, symmetry = self.symmetry.lattice) for q in self.equivalentQuaternions(who)] - - def reduced(self): - """Transform orientation to fall into fundamental zone according to symmetry""" - for me in self.symmetry.equivalentQuaternions(self.quaternion): - if self.symmetry.inFZ(me.asRodrigues()): break - - return Orientation(quaternion=me,symmetry=self.symmetry.lattice) - - - def disorientation(self, - other, - SST = True): - """ - Disorientation between myself and given other orientation. - - Rotation axis falls into SST if SST == True. - (Currently requires same symmetry for both orientations. - Look into A. Heinz and P. Neumann 1991 for cases with differing sym.) - """ - if self.symmetry != other.symmetry: - raise NotImplementedError('disorientation between different symmetry classes not supported yet.') - - misQ = other.quaternion*self.quaternion.conjugated() - mySymQs = self.symmetry.symmetryQuats() if SST else self.symmetry.symmetryQuats()[:1] # take all or only first sym operation - otherSymQs = other.symmetry.symmetryQuats() - for i,sA in enumerate(mySymQs): - for j,sB in enumerate(otherSymQs): - theQ = sB*misQ*sA.conjugated() - for k in range(2): - theQ.conjugate() - breaker = self.symmetry.inFZ(theQ) \ - and (not SST or other.symmetry.inDisorientationSST(theQ)) - if breaker: break - if breaker: break - if breaker: break - -# disorientation, own sym, other sym, self-->other: True, self<--other: False - return (Orientation(quaternion = theQ,symmetry = self.symmetry.lattice), - i,j, k == 1) - - def inversePole(self, axis, proper = False, SST = True): """Axis rotated according to orientation (using crystal symmetry to ensure location falls into SST)""" if SST: # pole requested to be within SST - for i,q in enumerate(self.symmetry.equivalentQuaternions(self.quaternion)): # test all symmetric equivalent quaternions - pole = q*axis # align crystal direction to axis - if self.symmetry.inSST(pole,proper): break # found SST version + for i,o in enumerate(self.equivalentOrientations()): # test all symmetric equivalent quaternions + pole = o.rotation*axis # align crystal direction to axis + if self.lattice.symmetry.inSST(pole,proper): break # found SST version else: - pole = self.quaternion*axis # align crystal direction to axis + pole = self.rotation*axis # align crystal direction to axis return (pole,i if SST else 0) - + + def IPFcolor(self,axis): """TSL color of inverse pole figure for given axis""" color = np.zeros(3,'d') - for q in self.symmetry.equivalentQuaternions(self.quaternion): - pole = q*axis # align crystal direction to axis - inSST,color = self.symmetry.inSST(pole,color=True) + for o in self.equivalentOrientations(): + pole = o.rotation*axis # align crystal direction to axis + inSST,color = self.lattice.symmetry.inSST(pole,color=True) if inSST: break - return color + return color - @classmethod - def average(cls, - orientations, - multiplicity = []): - """ - Average orientation - ref: F. Landis Markley, Yang Cheng, John Lucas Crassidis, and Yaakov Oshman. - Averaging Quaternions, - Journal of Guidance, Control, and Dynamics, Vol. 30, No. 4 (2007), pp. 1193-1197. - doi: 10.2514/1.28949 - usage: - a = Orientation(Eulers=np.radians([10, 10, 0]), symmetry='hexagonal') - b = Orientation(Eulers=np.radians([20, 0, 0]), symmetry='hexagonal') - avg = Orientation.average([a,b]) - """ - if not all(isinstance(item, Orientation) for item in orientations): - raise TypeError("Only instances of Orientation can be averaged.") + # @classmethod + # def average(cls, + # orientations, + # multiplicity = []): + # """ + # Average orientation - N = len(orientations) - if multiplicity == [] or not multiplicity: - multiplicity = np.ones(N,dtype='i') + # ref: F. Landis Markley, Yang Cheng, John Lucas Crassidis, and Yaakov Oshman. + # Averaging Quaternions, + # Journal of Guidance, Control, and Dynamics, Vol. 30, No. 4 (2007), pp. 1193-1197. + # doi: 10.2514/1.28949 + # usage: + # a = Orientation(Eulers=np.radians([10, 10, 0]), symmetry='hexagonal') + # b = Orientation(Eulers=np.radians([20, 0, 0]), symmetry='hexagonal') + # avg = Orientation.average([a,b]) + # """ + # if not all(isinstance(item, Orientation) for item in orientations): + # raise TypeError("Only instances of Orientation can be averaged.") - reference = orientations[0] # take first as reference - for i,(o,n) in enumerate(zip(orientations,multiplicity)): - closest = o.equivalentOrientations(reference.disorientation(o,SST = False)[2])[0] # select sym orientation with lowest misorientation - M = closest.quaternion.asM() * n if i == 0 else M + closest.quaternion.asM() * n # noqa add (multiples) of this orientation to average noqa - eig, vec = np.linalg.eig(M/N) + # N = len(orientations) + # if multiplicity == [] or not multiplicity: + # multiplicity = np.ones(N,dtype='i') - return Orientation(quaternion = Quaternion(quat = np.real(vec.T[eig.argmax()])), - symmetry = reference.symmetry.lattice) + # reference = orientations[0] # take first as reference + # for i,(o,n) in enumerate(zip(orientations,multiplicity)): + # closest = o.equivalentOrientations(reference.disorientation(o,SST = False)[2])[0] # select sym orientation with lowest misorientation + # M = closest.quaternion.asM() * n if i == 0 else M + closest.quaternion.asM() * n # noqa add (multiples) of this orientation to average noqa + # eig, vec = np.linalg.eig(M/N) + + # return Orientation(quaternion = Quaternion(quat = np.real(vec.T[eig.argmax()])), + # symmetry = reference.symmetry.lattice) #################################################################################################### -# Code below available according to the followin conditions on https://github.com/MarDiehl/3Drotations +# Code below available according to the following conditions on https://github.com/MarDiehl/3Drotations #################################################################################################### # Copyright (c) 2017-2019, Martin Diehl/Max-Planck-Institut für Eisenforschung GmbH # Copyright (c) 2013-2014, Marc De Graef/Carnegie Mellon University @@ -1725,7 +1240,7 @@ def eu2qu(eu): -P*sPhi*np.cos(ee[0]-ee[2]), -P*sPhi*np.sin(ee[0]-ee[2]), -P*cPhi*np.sin(ee[0]+ee[2]) ]) - #if qu[0] < 0.0: qu.homomorph() !ToDo: Check with original + #if qu[0] < 0.0: qu.homomorph() !ToDo: Check with original return qu @@ -1769,7 +1284,6 @@ def qu2eu(qu): eu = np.array([np.arctan2(-P*2.0*qu[0]*qu[3],qu[0]**2-qu[3]**2), 0.0, 0.0]) if iszero(q12) else \ np.array([np.arctan2(2.0*qu[1]*qu[2],qu[1]**2-qu[2]**2), np.pi, 0.0]) else: - #chiInv = 1.0/chi ToDo: needed for what? eu = np.array([np.arctan2((-P*qu[0]*qu[2]+qu[1]*qu[3])*chi, (-P*qu[0]*qu[1]-qu[2]*qu[3])*chi ), np.arctan2( 2.0*chi, q03-q12 ), np.arctan2(( P*qu[0]*qu[2]+qu[1]*qu[3])*chi, (-P*qu[0]*qu[1]+qu[2]*qu[3])*chi )]) From 73f6cb70205e272c73224ba32bf7353c2fffef35 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Feb 2019 09:12:21 +0100 Subject: [PATCH 294/309] fixed datatype --- python/damask/orientation.py | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index 2f9731966..e11613020 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -499,7 +499,7 @@ class Symmetry: otherOrder = Symmetry.lattices.index(other.lattice) return (myOrder > otherOrder) - (myOrder < otherOrder) - def symmetryQuats(self,who = []): + def symmetryOperations(self): """List of symmetry operations as quaternions.""" if self.lattice == 'cubic': symQuats = [ @@ -566,7 +566,7 @@ class Symmetry: [ 1.0,0.0,0.0,0.0 ], ] - return np.array(symQuats) + return [Rotation(q) for q in symQuats] def inFZ(self,R): @@ -1074,7 +1074,8 @@ class Orientation: def equivalentOrientations(self): """List of orientations which are symmetrically equivalent""" - return [self.__class__(q*self.rotation.quaternion,self.lattice) for q in self.lattice.symmetry.symmetryQuats()] + return [self.__class__(q*self.rotation,self.lattice) \ + for q in self.lattice.symmetry.symmetryOperations()] def relatedOrientations(self,model): """List of orientations related by the given orientation relationship""" From 7115382729e0ed0dcb5ec90a5c3083b7ae687474 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Feb 2019 10:08:09 +0100 Subject: [PATCH 295/309] not used anymore --- src/crystallite.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index d93950b99..e325ce443 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -91,7 +91,6 @@ module crystallite volume_ID, & orientation_ID, & grainrotation_ID, & - eulerangles_ID, & defgrad_ID, & fe_ID, & fp_ID, & From 903edcd4298b80a02355fdbb647c07d8c79c6b1d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Feb 2019 10:31:08 +0100 Subject: [PATCH 296/309] do not patronize the user, rather give hints --- processing/pre/seeds_fromRandom.py | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/processing/pre/seeds_fromRandom.py b/processing/pre/seeds_fromRandom.py index b17335e03..84c140933 100755 --- a/processing/pre/seeds_fromRandom.py +++ b/processing/pre/seeds_fromRandom.py @@ -90,11 +90,7 @@ group.add_option( '-s', '--selective', action = 'store_true', dest = 'selective', - help = 'selective picking of seed points from random seed points [%default]') -group.add_option( '--force', - action = 'store_true', - dest = 'force', - help = 'try selective picking despite large seed point number [%default]') + help = 'selective picking of seed points from random seed points') group.add_option( '--distance', dest = 'distance', type = 'float', metavar = 'float', @@ -115,7 +111,6 @@ parser.set_defaults(randomSeed = None, sigma = 0.05, microstructure = 1, selective = False, - force = False, distance = 0.2, numCandidates = 10, format = None, @@ -148,10 +143,11 @@ for name in filenames: errors = [] if gridSize == 0: errors.append('zero grid dimension for {}.'.format(', '.join([['a','b','c'][x] for x in np.where(options.grid == 0)[0]]))) - if options.N > gridSize/10.: errors.append('seed count exceeds 0.1 of grid points.') + if options.N > gridSize/10.: + remarks.append('seed count exceeds 0.1 of grid points.') if options.selective and 4./3.*math.pi*(options.distance/2.)**3*options.N > 0.5: - (remarks if options.force else errors).append('maximum recommended seed point count for given distance is {}.{}'. - format(int(3./8./math.pi/(options.distance/2.)**3),'..'*options.force)) + remarks.append('maximum recommended seed point count for given distance is {}.{}'. + format(int(3./8./math.pi/(options.distance/2.)**3))) if remarks != []: damask.util.croak(remarks) if errors != []: From 56781dfa5bf27926e9a61405e979b561437a1dca Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Feb 2019 10:32:28 +0100 Subject: [PATCH 297/309] fiber was never used here and will be remove anyway more user friendly formatting --- python/damask/config/material.py | 23 ++++------------------- 1 file changed, 4 insertions(+), 19 deletions(-) diff --git a/python/damask/config/material.py b/python/damask/config/material.py index 02658019d..408338313 100644 --- a/python/damask/config/material.py +++ b/python/damask/config/material.py @@ -77,18 +77,6 @@ class Texture(Section): ) ) - if multiKey == 'fiber': - self.add_multiKey(multiKey,'alpha1 %g\talpha2 %g\tbeta1 %g\tbeta2 %g\tscatter %g\tfraction %g'%( - properties['eulers'][0], - properties['eulers'][1], - properties['eulers'][2], - properties['eulers'][3], - scatter, - fraction, - ) - ) - - class Material(): """Reads, manipulates and writes material.config files""" @@ -97,10 +85,10 @@ class Material(): """Generates ordered list of parts""" self.parts = [ 'homogenization', - 'microstructure', 'crystallite', 'phase', 'texture', + 'microstructure', ] self.data = {\ 'homogenization': {'__order__': []}, @@ -117,15 +105,12 @@ class Material(): for part in self.parts: if self.verbose: print('processing <{}>'.format(part)) me += ['', - '#-----------------------------#', + '#'*100, '<{}>'.format(part), - '#-----------------------------#', + '#'*100, ] for section in self.data[part]['__order__']: - me += ['', - '[{}] {}'.format(section,'#'*max(0,27-len(section))), - '', - ] + me += ['[{}] {}'.format(section,'#'+'-'*max(0,96-len(section)))] for key in self.data[part][section]['__order__']: if key.startswith('(') and key.endswith(')'): # multiple (key) me += ['{}\t{}'.format(key,' '.join(values)) for values in self.data[part][section][key]] From 95be7ef938edd6e8e122aefa1a74e28f6746df31 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Feb 2019 10:33:30 +0100 Subject: [PATCH 298/309] directly convert to geom file + material config --- processing/misc/DREAM3D_toTable.py | 84 ------------------------------ 1 file changed, 84 deletions(-) delete mode 100755 processing/misc/DREAM3D_toTable.py diff --git a/processing/misc/DREAM3D_toTable.py b/processing/misc/DREAM3D_toTable.py deleted file mode 100755 index c09a77717..000000000 --- a/processing/misc/DREAM3D_toTable.py +++ /dev/null @@ -1,84 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os,h5py -import numpy as np -from optparse import OptionParser -import damask - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName,damask.version]) - - -#-------------------------------------------------------------------------------------------------- -# MAIN -#-------------------------------------------------------------------------------------------------- - -parser = OptionParser(option_class=damask.extendableOption, usage='%prog [dream3dfile[s]]', description = """ -Convert DREAM3D file to ASCIItable. Works for 3D datasets, but, hey, its not called DREAM2D ;) - -""", version = scriptID) - -parser.add_option('-d','--data', - dest = 'data', - action = 'extend', metavar = '', - help = 'data to extract from DREAM3D file') -parser.add_option('-c','--container', - dest = 'container', metavar = 'string', - help = 'root container(group) in which data is stored [%default]') - -parser.set_defaults(container="ImageDataContainer", - ) - -(options, filenames) = parser.parse_args() - -if options.data is None: - parser.error('No data selected') - -rootDir ='DataContainers/'+options.container - -# --- loop over input files ------------------------------------------------------------------------- - -if filenames == []: parser.error('no input file specified.') - -for name in filenames: - try: - table = damask.ASCIItable(outname = os.path.splitext(name)[0]+'.txt', - buffered = False - ) - except: continue - damask.util.report(scriptName,name) - - inFile = h5py.File(name, 'r') - try: - grid = inFile[rootDir+'/_SIMPL_GEOMETRY/DIMENSIONS'][...] - except: - damask.util.croak('Group {} not found'.format(options.container)) - table.close(dismiss = True) - continue - -# --- read comments -------------------------------------------------------------------------------- - - coords = (np.mgrid[0:grid[2], 0:grid[1], 0: grid[0]]).reshape(3, -1).T - table.data = (np.fliplr(coords)*inFile[rootDir+'/_SIMPL_GEOMETRY/SPACING'][...] \ - + inFile[rootDir+'/_SIMPL_GEOMETRY/ORIGIN'][...] \ - + inFile[rootDir+'/_SIMPL_GEOMETRY/SPACING'][...]*0.5) - labels = ['1_pos','2_pos','3_pos'] - for data in options.data: - try: - l = np.prod(inFile[rootDir+'/CellData/'+data].shape[3:]) - labels+=['{}_{}'.format(i+1,data.replace(' ','')) for i in range(l)] if l >1 else [data.replace(' ','')] - except KeyError: - damask.util.croak('Data {} not found'.format(data)) - pass - table.data = np.hstack((table.data, - inFile[rootDir+'/CellData/'+data][...].reshape(grid.prod(),l))) - -# ------------------------------------------ assemble header --------------------------------------- - table.labels_clear() - table.labels_append(labels,reset = True) - table.head_write() - -# ------------------------------------------ finalize output --------------------------------------- - table.data_writeArray() - table.close() From 0d7fd587e36f9aeae3b220d631b1d31143dadcc0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Feb 2019 12:57:57 +0100 Subject: [PATCH 299/309] direct translation from DREAM.3D to DAMASK geom needs test --- processing/pre/geom_fromDREAM3D.py | 189 +++++++++++++++++++++++++++++ processing/pre/geom_fromTable.py | 7 +- 2 files changed, 192 insertions(+), 4 deletions(-) create mode 100755 processing/pre/geom_fromDREAM3D.py diff --git a/processing/pre/geom_fromDREAM3D.py b/processing/pre/geom_fromDREAM3D.py new file mode 100755 index 000000000..6c2830372 --- /dev/null +++ b/processing/pre/geom_fromDREAM3D.py @@ -0,0 +1,189 @@ +#!/usr/bin/env python3 +# -*- coding: UTF-8 no BOM -*- + +import os,sys,h5py +import numpy as np +from optparse import OptionParser +import damask + +scriptName = os.path.splitext(os.path.basename(__file__))[0] +scriptID = ' '.join([scriptName,damask.version]) + + +#-------------------------------------------------------------------------------------------------- +# MAIN +#-------------------------------------------------------------------------------------------------- + +parser = OptionParser(option_class=damask.extendableOption, usage='%prog [dream3dfile[s]]', description = """ +Convert DREAM3D file to geometry file. This can be done from cell data (direct pointwise takeover) or +from grain data (individual grains are segmented). Requires orientation data as quaternion. + +""", version = scriptID) + +parser.add_option('-b','--basegroup', + dest = 'basegroup', metavar = 'string', + help = 'name of the group in "DataContainers" that contains all the data') +parser.add_option('-p','--pointwise', + dest = 'pointwise', metavar = 'string', + help = 'name of the group in "DataContainers/" that contains pointwise data [%default]') +parser.add_option('-a','--average', + dest = 'average', metavar = 'string', + help = 'name of the group in "DataContainers" that contains grain average data. '\ + + 'Leave empty for pointwise data') +parser.add_option('--phase', + dest = 'phase', + type = 'string', metavar = 'string', + help = 'name of the dataset containing pointwise/average phase IDs [%default]') +parser.add_option('--microstructure', + dest = 'microstructure', + type = 'string', metavar = 'string', + help = 'name of the dataset connecting pointwise and average data [%default]') +parser.add_option('-q', '--quaternion', + dest = 'quaternion', + type = 'string', metavar='string', + help = 'name of the dataset containing pointwise/average orientation as quaternion [%default]') + +parser.set_defaults(pointwise = 'CellData', + quaternion = 'Quats', + phase = 'Phases', + microstructure = 'FeatureIds', + crystallite = 1, + ) + +(options, filenames) = parser.parse_args() + +if options.basegroup is None: + parser.error('No base group selected') + +rootDir ='DataContainers' + +# --- loop over input files ------------------------------------------------------------------------- + +if filenames == []: parser.error('no input file specified.') + +for name in filenames: + try: + table = damask.ASCIItable(outname = os.path.splitext(name)[0]+'.geom', + buffered = False, labeled=False, + ) + except: continue + damask.util.report(scriptName,name) + + errors = [] + + info = {} + ori = [] + inFile = h5py.File(name, 'r') + group_geom = os.path.join(rootDir,options.basegroup,'_SIMPL_GEOMETRY') + try: + info['size'] = inFile[os.path.join(group_geom,'DIMENSIONS')][...] \ + * inFile[os.path.join(group_geom,'SPACING')][...] + info['grid'] = inFile[os.path.join(group_geom,'DIMENSIONS')][...] + info['origin'] = inFile[os.path.join(group_geom,'ORIGIN')][...] + except: + errors.append('Geometry data ({}) not found'.format(group_geom)) + + + group_pointwise = os.path.join(rootDir,options.basegroup,options.pointwise) + if options.average is None: + label = 'point' + N_microstructure = np.product(info['grid']) + + dataset = os.path.join(group_pointwise,options.quaternion) + try: + quats = np.reshape(inFile[dataset][...],(N_microstructure,3)) + except: + errors.append('Pointwise orientation data ({}) not found'.format(dataset)) + + texture = [damask.Rotation.fromQuaternion(q,P=+1) for q in quats] + + dataset = os.path.join(group_pointwise,options.phase) + try: + phase = np.reshape(inFile[dataset][...],(N_microstructure)) + except: + errors.append('Pointwise phase data ({}) not found'.format(dataset)) + + + else: + label = 'grain' + + dataset = os.path.join(group_pointwise,options.microstructure) + try: + microstructure = np.reshape(inFile[dataset][...],(np.product(info['grid']))) + N_microstructure = np.max(microstructure) + except: + errors.append('Link between pointwise and grain average data ({}) not found'.format(dataset)) + + group_average = os.path.join(rootDir,options.basegroup,options.average) + + dataset = os.path.join(group_average,options.quaternion) + try: + texture = [damask.Rotation.fromQuaternion(q,P=+1) for q in inFile[dataset][...][1:]] # skip first entry (unindexed) + except: + errors.append('Average orientation data ({}) not found'.format(dataset)) + + dataset = os.path.join(group_average,options.phase) + try: + phase = [i[0] for i in inFile[dataset][...]][1:] # skip first entry (unindexed) + except: + errors.append('Average phase data ({}) not found'.format(dataset)) + + if errors != []: + damask.util.croak(errors) + table.close(dismiss = True) + continue + + + mat = damask.Material() + mat.verbose = False + + # dummy + h = damask.config.material.Homogenization() + mat.add_section('Homogenization','none',h) + info['homogenization'] = 1 + + # placeholder (same for all microstructures at the moment) + c = damask.config.material.Crystallite() + mat.add_section('Crystallite','tbd',c) + + # placeholders + for i in range(np.max(phase)): + p = damask.config.material.Phase() + mat.add_section('phase','phase{}-tbd'.format(i+1),p) + + # + for i,o in enumerate(texture): + t = damask.config.material.Texture() + t.add_component('gauss',{'eulers':o.asEulers(degrees=True)}) + mat.add_section(part='texture', section='{}{}'.format(label,i+1),initialData=t) + + # + for i in range(N_microstructure): + m = damask.config.material.Microstructure() + mat.add_section('microstructure','{}{}'.format(label,i+1),m) + mat.add_microstructure('{}{}'.format(label,i+1), + {'phase': 'phase{}-tbd'.format(phase[i]), + 'texture':'{}{}'.format(label,i+1), + 'crystallite':'tbd', + 'fraction':1 + }) + + table.info_append([ + scriptID + ' ' + ' '.join(sys.argv[1:]), + "grid\ta {}\tb {}\tc {}".format(*info['grid']), + "size\tx {}\ty {}\tz {}".format(*info['size']), + "origin\tx {}\ty {}\tz {}".format(*info['origin']), + "homogenization\t{}".format(info['homogenization']), + str(mat).split('\n') + ]) + table.head_write() + + if options.average is None: + table.data = [1, 'to', format(N_microstructure)] + table.data_write() + else: + table.data = microstructure.reshape(info['grid'][1]*info['grid'][2],info['grid'][0]) + table.data_writeArray() + + + table.close() diff --git a/processing/pre/geom_fromTable.py b/processing/pre/geom_fromTable.py index ad598d5b1..8eb1ed8bf 100755 --- a/processing/pre/geom_fromTable.py +++ b/processing/pre/geom_fromTable.py @@ -39,7 +39,7 @@ parser.add_option('-q', '--quaternion', parser.add_option('--axes', dest = 'axes', type = 'string', nargs = 3, metavar = ' '.join(['string']*3), - help = 'orientation coordinate frame in terms of position coordinate frame [same]') + help = 'orientation coordinate frame in terms of position coordinate frame [+x +y +z]') parser.add_option('--homogenization', dest = 'homogenization', @@ -51,8 +51,7 @@ parser.add_option('--crystallite', help = 'crystallite index to be used [%default]') -parser.set_defaults(symmetry = [damask.Symmetry.lattices[-1]], - homogenization = 1, +parser.set_defaults(homogenization = 1, crystallite = 1, pos = 'pos', ) @@ -100,7 +99,7 @@ for name in filenames: if options.phase and table.label_dimension(options.phase) != 1: errors.append('phase column "{}" is not scalar.'.format(options.phase)) - if errors != []: + if errors != []: damask.util.croak(errors) table.close(dismiss = True) continue From e88182b0072ce7ba8461556f92d50b5a2f4049f5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Feb 2019 14:39:34 +0100 Subject: [PATCH 300/309] improved converte, now with test still needs to figure out how +P is handled --- PRIVATE | 2 +- processing/pre/geom_fromDREAM3D.py | 4 ++-- python/damask/orientation.py | 6 +++++- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/PRIVATE b/PRIVATE index 8deb37dd4..144e72981 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 8deb37dd4526fb5e1425fe1d2360508d01b6ac3e +Subproject commit 144e729811024fd5f99225fa10b6d8fa40e7d492 diff --git a/processing/pre/geom_fromDREAM3D.py b/processing/pre/geom_fromDREAM3D.py index 6c2830372..f75694ef6 100755 --- a/processing/pre/geom_fromDREAM3D.py +++ b/processing/pre/geom_fromDREAM3D.py @@ -95,7 +95,7 @@ for name in filenames: except: errors.append('Pointwise orientation data ({}) not found'.format(dataset)) - texture = [damask.Rotation.fromQuaternion(q,P=+1) for q in quats] + texture = [damask.Rotation.fromQuaternion(q,True,P=+1) for q in quats] dataset = os.path.join(group_pointwise,options.phase) try: @@ -118,7 +118,7 @@ for name in filenames: dataset = os.path.join(group_average,options.quaternion) try: - texture = [damask.Rotation.fromQuaternion(q,P=+1) for q in inFile[dataset][...][1:]] # skip first entry (unindexed) + texture = [damask.Rotation.fromQuaternion(q,True,P=+1) for q in inFile[dataset][...][1:]] # skip first entry (unindexed) except: errors.append('Average orientation data ({}) not found'.format(dataset)) diff --git a/python/damask/orientation.py b/python/damask/orientation.py index e11613020..ad9877835 100644 --- a/python/damask/orientation.py +++ b/python/damask/orientation.py @@ -301,12 +301,16 @@ class Rotation: @classmethod def fromQuaternion(cls, quaternion, + acceptHomomorph = False, P = -1): qu = quaternion if isinstance(quaternion, np.ndarray) else np.array(quaternion) if P > 0: qu[1:4] *= -1 # convert from P=1 to P=-1 if qu[0] < 0.0: - raise ValueError('Quaternion has negative first component.\n{}'.format(qu[0])) + if acceptHomomorph: + qu *= -1. + else: + raise ValueError('Quaternion has negative first component.\n{}'.format(qu[0])) if not np.isclose(np.linalg.norm(qu), 1.0): raise ValueError('Quaternion is not of unit length.\n{} {} {} {}'.format(*qu)) From 43e7e06604a69647b476dd0457bac0dc6955138a Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 24 Feb 2019 18:57:33 +0000 Subject: [PATCH 301/309] [skip ci] updated version information after successful test of v2.0.2-1892-ge88182b0 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 7d075db3e..62cfd7a8f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1837-g3bec76e7 +v2.0.2-1892-ge88182b0 From 81e27f4ff4ad6ae8b3f39cfaf677695f65f872b1 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 25 Feb 2019 21:43:22 +0000 Subject: [PATCH 302/309] [skip ci] updated version information after successful test of v2.0.2-1935-g6fab99bc --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 62cfd7a8f..47f55f88e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1892-ge88182b0 +v2.0.2-1935-g6fab99bc From e401c21266ba5daab2c6b9c7c8e5f8396710e739 Mon Sep 17 00:00:00 2001 From: Eureka Pai Date: Mon, 25 Feb 2019 18:30:45 -0500 Subject: [PATCH 303/309] dropped obsolete option --inplace from geom_check --- processing/pre/geom_check.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/processing/pre/geom_check.sh b/processing/pre/geom_check.sh index 4342f93e6..2a690918e 100755 --- a/processing/pre/geom_check.sh +++ b/processing/pre/geom_check.sh @@ -18,8 +18,8 @@ do < $geom \ | \ vtk_addRectilinearGridData \ + --vtk ${geom%.*}.vtk \ --data microstructure \ - --inplace \ - --vtk ${geom%.*}.vtk + rm ${geom%.*}.vtk done From 2089726800645babc2ec7f84e9928ca04841d0c6 Mon Sep 17 00:00:00 2001 From: Eureka Pai Date: Mon, 25 Feb 2019 18:48:40 -0500 Subject: [PATCH 304/309] corrected output extension of vtk files to reflect binary format --- processing/post/vtk_addGridData.py | 11 +++++++---- processing/post/vtk_addPointCloudData.py | 9 ++++++--- processing/post/vtk_addRectilinearGridData.py | 8 +++++--- 3 files changed, 18 insertions(+), 10 deletions(-) diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py index c458b1f07..34f01e7bf 100755 --- a/processing/post/vtk_addGridData.py +++ b/processing/post/vtk_addGridData.py @@ -53,19 +53,22 @@ parser.set_defaults(data = [], if not options.vtk: parser.error('No VTK file specified.') if not os.path.exists(options.vtk): parser.error('VTK file does not exist.') -if os.path.splitext(options.vtk)[1] == '.vtr': +vtk_file,vtk_ext = os.path.splitext(options.vtk) + +if vtk_ext == '.vtr': reader = vtk.vtkXMLRectilinearGridReader() reader.SetFileName(options.vtk) reader.Update() rGrid = reader.GetOutput() writer = vtk.vtkXMLRectilinearGridWriter() -elif os.path.splitext(options.vtk)[1] == '.vtk': +elif vtk_ext == '.vtk': reader = vtk.vtkGenericDataObjectReader() reader.SetFileName(options.vtk) reader.Update() rGrid = reader.GetRectilinearGridOutput() writer = vtk.vtkXMLRectilinearGridWriter() -elif os.path.splitext(options.vtk)[1] == '.vtu': + vtk_ext = '.vtr' +elif vtk_ext == '.vtu': reader = vtk.vtkXMLUnstructuredGridReader() reader.SetFileName(options.vtk) reader.Update() @@ -74,7 +77,7 @@ elif os.path.splitext(options.vtk)[1] == '.vtu': else: parser.error('Unsupported VTK file type extension.') -writer.SetFileName(options.vtk) +writer.SetFileName(vtk_file+vtk_ext) Npoints = rGrid.GetNumberOfPoints() Ncells = rGrid.GetNumberOfCells() diff --git a/processing/post/vtk_addPointCloudData.py b/processing/post/vtk_addPointCloudData.py index 5ab1d419e..0a1cb1231 100755 --- a/processing/post/vtk_addPointCloudData.py +++ b/processing/post/vtk_addPointCloudData.py @@ -49,16 +49,19 @@ parser.set_defaults(data = [], if not options.vtk: parser.error('no VTK file specified.') if not os.path.exists(options.vtk): parser.error('VTK file does not exist.') -if os.path.splitext(options.vtk)[1] == '.vtp': +vtk_file,vtk_ext = os.path.splitext(options.vtk) + +if vtk_ext == '.vtp': reader = vtk.vtkXMLPolyDataReader() reader.SetFileName(options.vtk) reader.Update() Polydata = reader.GetOutput() -elif os.path.splitext(options.vtk)[1] == '.vtk': +elif vtk_ext == '.vtk': reader = vtk.vtkGenericDataObjectReader() reader.SetFileName(options.vtk) reader.Update() Polydata = reader.GetPolyDataOutput() + vtk_ext = '.vtp' else: parser.error('unsupported VTK file type extension.') @@ -149,7 +152,7 @@ for name in filenames: writer = vtk.vtkXMLPolyDataWriter() writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() - writer.SetFileName(options.vtk) + writer.SetFileName(vtk_file+vtk_ext) writer.SetInputData(Polydata) writer.Write() diff --git a/processing/post/vtk_addRectilinearGridData.py b/processing/post/vtk_addRectilinearGridData.py index e445214fd..868fdc387 100755 --- a/processing/post/vtk_addRectilinearGridData.py +++ b/processing/post/vtk_addRectilinearGridData.py @@ -53,16 +53,18 @@ parser.set_defaults(data = [], if not options.vtk: parser.error('no VTK file specified.') if not os.path.exists(options.vtk): parser.error('VTK file does not exist.') -if os.path.splitext(options.vtk)[1] == '.vtr': +vtk_file,vtk_ext = os.path.splitext(options.vtk) +if vtk_ext == '.vtr': reader = vtk.vtkXMLRectilinearGridReader() reader.SetFileName(options.vtk) reader.Update() rGrid = reader.GetOutput() -elif os.path.splitext(options.vtk)[1] == '.vtk': +elif vtk_ext == '.vtk': reader = vtk.vtkGenericDataObjectReader() reader.SetFileName(options.vtk) reader.Update() rGrid = reader.GetRectilinearGridOutput() + vtk_ext = '.vtr' else: parser.error('unsupported VTK file type extension.') @@ -159,7 +161,7 @@ for name in filenames: writer = vtk.vtkXMLRectilinearGridWriter() writer.SetDataModeToBinary() writer.SetCompressorTypeToZLib() - writer.SetFileName(options.vtk) + writer.SetFileName(vtk_file+vtk_ext) writer.SetInputData(rGrid) writer.Write() From f3d28034433b20c84938f04426e7d88e7f5ca756 Mon Sep 17 00:00:00 2001 From: Eureka Pai Date: Mon, 25 Feb 2019 19:29:12 -0500 Subject: [PATCH 305/309] addMises failed for single run of either --stress or --strain --- PRIVATE | 2 +- processing/post/addMises.py | 5 ++++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index 144e72981..def4081e8 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 144e729811024fd5f99225fa10b6d8fa40e7d492 +Subproject commit def4081e837539dba7c4760abbb340553be66d3c diff --git a/processing/post/addMises.py b/processing/post/addMises.py index 35a6922c3..6593eeef8 100755 --- a/processing/post/addMises.py +++ b/processing/post/addMises.py @@ -38,9 +38,12 @@ parser.add_option('-s','--stress', action = 'extend', metavar = '', help = 'heading(s) of columns containing stress tensors') +parser.set_defaults(strain = [], + stress = [], + ) (options,filenames) = parser.parse_args() -if options.stress is None and options.strain is None: +if options.stress is [] and options.strain is []: parser.error('no data column specified...') # --- loop over input files ------------------------------------------------------------------------- From 7b5891a8d1d263e7b2bc7b44144a3d616bf17362 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 26 Feb 2019 02:05:38 +0000 Subject: [PATCH 306/309] [skip ci] updated version information after successful test of v2.0.2-1937-ge401c212 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 47f55f88e..49f0075ad 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1935-g6fab99bc +v2.0.2-1937-ge401c212 From e5b65ede89e28ce3618b86624e3537938f9e3297 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 26 Feb 2019 04:41:02 +0000 Subject: [PATCH 307/309] [skip ci] updated version information after successful test of v2.0.2-1938-g20897268 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 47f55f88e..f60e6836d 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1935-g6fab99bc +v2.0.2-1938-g20897268 From 25c235510948063dccc58c642f53aaed51e73551 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 26 Feb 2019 07:15:53 +0000 Subject: [PATCH 308/309] [skip ci] updated version information after successful test of v2.0.2-1939-gf3d28034 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 47f55f88e..80d312718 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1935-g6fab99bc +v2.0.2-1939-gf3d28034 From 4b5d1cfcfd0bb9f7961206821fb2adc28e60a972 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 26 Feb 2019 18:16:26 +0000 Subject: [PATCH 309/309] [skip ci] updated version information after successful test of v2.0.2-1961-g07eff8eb --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 49f0075ad..c938e7b0a 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1937-ge401c212 +v2.0.2-1961-g07eff8eb