From 01e3b646c288e1e35535491981cd8304e21f19dd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 16 May 2019 22:56:48 +0200 Subject: [PATCH] don't clutter the code with useless stuff we only need to be more strict about prefixing functions/subroutines/variables to see in which module they reside --- src/Lambert.f90 | 17 +- src/config.f90 | 42 ++-- src/crystallite.f90 | 323 +++-------------------------- src/lattice.f90 | 208 +++++-------------- src/plastic_dislotwin.f90 | 103 ++------- src/plastic_isotropic.f90 | 63 ++---- src/plastic_kinematichardening.f90 | 62 ++---- src/plastic_none.f90 | 7 +- src/plastic_phenopowerlaw.f90 | 50 ++--- src/quaternions.f90 | 5 +- src/rotations.f90 | 86 +------- 11 files changed, 184 insertions(+), 782 deletions(-) diff --git a/src/Lambert.f90 b/src/Lambert.f90 index c7b2c0d49..601cf9984 100644 --- a/src/Lambert.f90 +++ b/src/Lambert.f90 @@ -42,7 +42,8 @@ module Lambert implicit none private - real(pReal), parameter, private :: & + + real(pReal), parameter :: & 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), & @@ -55,10 +56,8 @@ module Lambert PREK = R1 * 2.0_pReal**(1.0_pReal/4.0_pReal)/BETA public :: & - LambertCubeToBall, & - LambertBallToCube - private :: & - GetPyramidOrder + Lambert_CubeToBall, & + Lambert_BallToCube contains @@ -68,7 +67,7 @@ contains !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief map from 3D cubic grid to 3D ball !-------------------------------------------------------------------------- -function LambertCubeToBall(cube) result(ball) +function Lambert_CubeToBall(cube) result(ball) real(pReal), intent(in), dimension(3) :: cube real(pReal), dimension(3) :: ball, LamXYZ, XYZ @@ -116,7 +115,7 @@ function LambertCubeToBall(cube) result(ball) endif center -end function LambertCubeToBall +end function Lambert_CubeToBall !-------------------------------------------------------------------------- @@ -124,7 +123,7 @@ end function LambertCubeToBall !> @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) +pure function Lambert_BallToCube(xyz) result(cube) real(pReal), intent(in), dimension(3) :: xyz real(pReal), dimension(3) :: cube, xyz1, xyz3 @@ -170,7 +169,7 @@ pure function LambertBallToCube(xyz) result(cube) endif center -end function LambertBallToCube +end function Lambert_BallToCube !-------------------------------------------------------------------------- diff --git a/src/config.f90 b/src/config.f90 index 6bc9e9c0b..8729014ce 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -7,21 +7,26 @@ !-------------------------------------------------------------------------------------------------- module config use prec + use DAMASK_interface + use IO + use debug use list implicit none private - type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & + + type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & config_phase, & config_microstructure, & config_homogenization, & config_texture, & config_crystallite - type(tPartitionedStringList), public, protected :: & + type(tPartitionedStringList), public, protected :: & config_numerics, & config_debug + !ToDo: bad names (how should one know that those variables are defined in config?) character(len=64), dimension(:), allocatable, public, protected :: & phase_name, & !< name of each phase homogenization_name, & !< name of each homogenization @@ -45,19 +50,9 @@ contains !> @brief reads material.config and stores its content per part !-------------------------------------------------------------------------------------------------- subroutine config_init - use DAMASK_interface, only: & - getSolverJobName - use IO, only: & - IO_read_ASCII, & - IO_error, & - IO_lc, & - IO_getTag - use debug, only: & - debug_level, & - debug_material, & - debug_levelBasic - integer :: myDebug,i + integer :: i + logical :: verbose character(len=pStringLen) :: & line, & @@ -67,7 +62,7 @@ subroutine config_init write(6,'(/,a)') ' <<<+- config init -+>>>' - myDebug = debug_level(debug_material) + verbose = iand(debug_level(debug_material),debug_levelBasic) /= 0 inquire(file=trim(getSolverJobName())//'.materialConfig',exist=fileExists) if(fileExists) then @@ -87,23 +82,23 @@ subroutine config_init case (trim('phase')) call parse_materialConfig(phase_name,config_phase,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase parsed'; flush(6) + if (verbose) write(6,'(a)') ' Phase parsed'; flush(6) case (trim('microstructure')) call parse_materialConfig(microstructure_name,config_microstructure,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6) + if (verbose) write(6,'(a)') ' Microstructure parsed'; flush(6) case (trim('crystallite')) call parse_materialConfig(crystallite_name,config_crystallite,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite parsed'; flush(6) + if (verbose) write(6,'(a)') ' Crystallite parsed'; flush(6) case (trim('homogenization')) call parse_materialConfig(homogenization_name,config_homogenization,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6) + if (verbose) write(6,'(a)') ' Homogenization parsed'; flush(6) case (trim('texture')) call parse_materialConfig(texture_name,config_texture,line,fileContent(i+1:)) - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6) + if (verbose) write(6,'(a)') ' Texture parsed'; flush(6) end select @@ -141,8 +136,6 @@ contains !! Recursion is triggered by "{path/to/inputfile}" in a line !-------------------------------------------------------------------------------------------------- recursive function read_materialConfig(fileName,cnt) result(fileContent) - use IO, only: & - IO_warning character(len=*), intent(in) :: fileName integer, intent(in), optional :: cnt !< recursion counter @@ -226,9 +219,6 @@ end function read_materialConfig subroutine parse_materialConfig(sectionNames,part,line, & fileContent) - use IO, only: & - IO_intOut - character(len=64), allocatable, dimension(:), intent(out) :: sectionNames type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part character(len=pStringLen), intent(inout) :: line @@ -298,8 +288,6 @@ end subroutine config_init !> @brief deallocates the linked lists that store the content of the configuration files !-------------------------------------------------------------------------------------------------- subroutine config_deallocate(what) - use IO, only: & - IO_error character(len=*), intent(in) :: what diff --git a/src/crystallite.f90 b/src/crystallite.f90 index dce93695a..31c859e30 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -9,36 +9,43 @@ !-------------------------------------------------------------------------------------------------- module crystallite - use prec, only: & - pReal, & - pStringLen - use rotations, only: & - rotation - use FEsolving, only: & - FEsolving_execElem, & - FEsolving_execIP - use material, only: & - homogenization_Ngrains + use prec + use IO + use config + use debug + use numerics + use rotations + use math + use mesh + use FEsolving + use material + use constitutive + use lattice use future + use plastic_nonlocal +#if defined(PETSc) || defined(DAMASK_HDF5) + use HDF5_utilities + use results +#endif implicit none private - character(len=64), dimension(:,:), allocatable, private :: & + character(len=64), dimension(:,:), allocatable :: & crystallite_output !< name of each post result output integer, public, protected :: & crystallite_maxSizePostResults !< description not available integer, dimension(:), allocatable, public, protected :: & crystallite_sizePostResults !< description not available - integer, dimension(:,:), allocatable, private :: & + integer, dimension(:,:), allocatable :: & crystallite_sizePostResult !< description not available real(pReal), dimension(:,:,:), allocatable, public :: & crystallite_dt !< requested time increment of each grain - real(pReal), dimension(:,:,:), allocatable, private :: & + real(pReal), dimension(:,:,:), allocatable :: & crystallite_subdt, & !< substepped time increment of each grain crystallite_subFrac, & !< already calculated fraction of increment crystallite_subStep !< size of next integration step - type(rotation), dimension(:,:,:), allocatable, private :: & + type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation, & !< orientation crystallite_orientation0 !< initial orientation real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & @@ -63,7 +70,7 @@ module crystallite crystallite_Li, & !< current intermediate velocitiy grad (end of converged time step) crystallite_Li0, & !< intermediate velocitiy grad at start of FE inc crystallite_partionedLi0 !< intermediate velocity grad at start of homog inc - real(pReal), dimension(:,:,:,:,:), allocatable, private :: & + real(pReal), dimension(:,:,:,:,:), allocatable :: & 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 @@ -77,7 +84,7 @@ module crystallite crystallite_dPdF !< current individual dPdF per grain (end of converged time step) logical, dimension(:,:,:), allocatable, public :: & crystallite_requested !< used by upper level (homogenization) to request crystallite calculation - logical, dimension(:,:,:), allocatable, private :: & + logical, dimension(:,:,:), allocatable :: & crystallite_converged, & !< convergence flag crystallite_todo, & !< flag to indicate need for further computation crystallite_localPlasticity !< indicates this grain to have purely local constitutive law @@ -101,16 +108,16 @@ module crystallite neighboringip_ID, & neighboringelement_ID end enum - integer(kind(undefined_ID)),dimension(:,:), allocatable, private :: & + integer(kind(undefined_ID)),dimension(:,:), allocatable :: & crystallite_outputID !< ID of each post result output - type, private :: tOutput !< new requested output (per phase) + type :: tOutput !< new requested output (per phase) character(len=65536), allocatable, dimension(:) :: & label end type tOutput - type(tOutput), allocatable, dimension(:), private :: output_constituent + type(tOutput), allocatable, dimension(:) :: output_constituent - type, private :: tNumerics + type :: tNumerics integer :: & iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp nState, & !< state loop limit @@ -138,15 +145,6 @@ module crystallite crystallite_push33ToRef, & crystallite_postResults, & crystallite_results - private :: & - integrateStress, & - integrateState, & - integrateStateFPI, & - integrateStateEuler, & - integrateStateAdaptiveEuler, & - integrateStateRK4, & - integrateStateRKCK45, & - stateJump contains @@ -155,39 +153,6 @@ contains !> @brief allocates and initialize per grain variables !-------------------------------------------------------------------------------------------------- subroutine crystallite_init -#ifdef DEBUG - use debug, only: & - debug_info, & - debug_reset, & - debug_level, & - debug_crystallite, & - debug_levelBasic -#endif - use numerics, only: & - numerics_integrator, & - worldrank, & - usePingPong - use math, only: & - math_I3, & - math_EulerToR, & - math_inv33 - use mesh, only: & - theMesh, & - mesh_element - use IO, only: & - IO_stringValue, & - IO_write_jobFile, & - IO_error - use material - use config, only: & - config_deallocate, & - config_crystallite, & - config_numerics, & - config_phase, & - crystallite_name - use constitutive, only: & - constitutive_initialFi, & - constitutive_microstructure ! derived (shortcut) quantities of given state integer, parameter :: FILEUNIT=434 logical, dimension(:,:), allocatable :: devNull @@ -478,34 +443,6 @@ end subroutine crystallite_init !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) - use prec, only: & - tol_math_check, & - dNeq0 -#ifdef DEBUG - use debug, only: & - debug_level, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective, & - debug_e, & - debug_i, & - debug_g -#endif - use IO, only: & - IO_warning, & - IO_error - use math, only: & - math_inv33 - use mesh, only: & - theMesh, & - mesh_element - use material, only: & - homogenization_Ngrains, & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress real(pReal), intent(in), optional :: & @@ -746,30 +683,6 @@ end function crystallite_stress !> @brief calculate tangent (dPdF) !-------------------------------------------------------------------------------------------------- subroutine crystallite_stressTangent - use prec, only: & - tol_math_check, & - dNeq0 - use IO, only: & - IO_warning, & - IO_error - use math, only: & - math_inv33, & - math_identity2nd, & - math_3333to99, & - math_99to3333, & - math_I3, & - math_mul3333xx3333, & - math_mul33xx33, & - math_invert2, & - math_det33 - use mesh, only: & - mesh_element - use material, only: & - homogenization_Ngrains - use constitutive, only: & - constitutive_SandItsTangents, & - constitutive_LpAndItsTangents, & - constitutive_LiAndItsTangents integer :: & c, & !< counter in integration point component loop @@ -910,19 +823,6 @@ end subroutine crystallite_stressTangent !> @brief calculates orientations !-------------------------------------------------------------------------------------------------- subroutine crystallite_orientations - use math, only: & - math_rotationalPart33, & - math_RtoQ - use material, only: & - plasticState, & - material_phase, & - homogenization_Ngrains - use mesh, only: & - mesh_element - use lattice, only: & - lattice_qDisorientation - use plastic_nonlocal, only: & - plastic_nonlocal_updateCompatibility integer & c, & !< counter in integration point component loop @@ -979,28 +879,6 @@ end function crystallite_push33ToRef !> @brief return results of particular grain !-------------------------------------------------------------------------------------------------- function crystallite_postResults(ipc, ip, el) - use math, only: & - math_det33, & - math_I3, & - inDeg - use mesh, only: & - theMesh, & - mesh_element, & - mesh_ipVolume, & - mesh_ipNeighborhood - use material, only: & - plasticState, & - sourceState, & - microstructure_crystallite, & - crystallite_Noutput, & - material_phase, & - material_texture, & - homogenization_Ngrains - use constitutive, only: & - constitutive_homogenizedC, & - constitutive_postResults - use rotations, only: & - rotation integer, intent(in):: & el, & !< element index @@ -1118,10 +996,6 @@ end function crystallite_postResults !-------------------------------------------------------------------------------------------------- subroutine crystallite_results #if defined(PETSc) || defined(DAMASK_HDF5) - use lattice - use results - use HDF5_utilities - use rotations use config, only: & config_name_phase => phase_name ! anticipate logical name @@ -1264,33 +1138,6 @@ end subroutine crystallite_results !> intermediate acceleration of the Newton-Raphson correction !-------------------------------------------------------------------------------------------------- logical function integrateStress(ipc,ip,el,timeFraction) - use, intrinsic :: & - IEEE_arithmetic - use prec, only: tol_math_check, & - dEq0 -#ifdef DEBUG - use debug, only: debug_level, & - debug_e, & - debug_i, & - debug_g, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif - - use constitutive, only: constitutive_LpAndItsTangents, & - constitutive_LiAndItsTangents, & - constitutive_SandItsTangents - use math, only: math_mul33xx33, & - math_mul3333xx3333, & - math_inv33, & - math_det33, & - math_I3, & - math_identity2nd, & - math_3333to99, & - math_33to9, & - math_9to33 integer, intent(in):: el, & ! element index ip, & ! integration point index @@ -1690,27 +1537,6 @@ end function integrateStress !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- subroutine integrateStateFPI -#ifdef DEBUG - use debug, only: debug_level, & - debug_e, & - debug_i, & - debug_g, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif - use mesh, only: & - mesh_element - use material, only: & - plasticState, & - sourceState, & - phaseAt, phasememberAt, & - phase_Nsources, & - homogenization_Ngrains - use constitutive, only: & - constitutive_plasticity_maxSizeDotState, & - constitutive_source_maxSizeDotState integer :: & NiterationState, & !< number of iterations in state loop @@ -1898,8 +1724,6 @@ end subroutine integrateStateFPI !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- subroutine integrateStateEuler - use material, only: & - plasticState call update_dotState(1.0_pReal) call update_state(1.0_pReal) @@ -1916,19 +1740,6 @@ end subroutine integrateStateEuler !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler - use mesh, only: & - theMesh, & - mesh_element - use material, only: & - homogenization_Ngrains, & - plasticState, & - sourceState, & - phaseAt, phasememberAt, & - phase_Nsources, & - homogenization_maxNgrains - use constitutive, only: & - constitutive_plasticity_maxSizeDotState, & - constitutive_source_maxSizeDotState integer :: & e, & ! element index in element loop @@ -2022,14 +1833,6 @@ end subroutine integrateStateAdaptiveEuler ! ToDo: This is totally BROKEN: RK4dotState is never used!!! !-------------------------------------------------------------------------------------------------- subroutine integrateStateRK4 - use mesh, only: & - mesh_element - use material, only: & - homogenization_Ngrains, & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt real(pReal), dimension(4), parameter :: & TIMESTEPFRACTION = [0.5_pReal, 0.5_pReal, 1.0_pReal, 1.0_pReal] ! factor giving the fraction of the original timestep used for Runge Kutta Integration @@ -2089,19 +1892,6 @@ end subroutine integrateStateRK4 !> adaptive step size (use 5th order solution to advance = "local extrapolation") !-------------------------------------------------------------------------------------------------- subroutine integrateStateRKCK45 - use mesh, only: & - mesh_element, & - theMesh - use material, only: & - homogenization_Ngrains, & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt, & - homogenization_maxNgrains - use constitutive, only: & - constitutive_plasticity_maxSizeDotState, & - constitutive_source_maxSizeDotState real(pReal), dimension(5,5), parameter :: & A = reshape([& @@ -2284,8 +2074,6 @@ end subroutine nonlocalConvergenceCheck !> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria !-------------------------------------------------------------------------------------------------- subroutine setConvergenceFlag - use mesh, only: & - mesh_element integer :: & e, & !< element index in element loop @@ -2324,8 +2112,6 @@ end subroutine setConvergenceFlag !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- subroutine update_stress(timeFraction) - use mesh, only: & - mesh_element real(pReal), intent(in) :: & timeFraction @@ -2357,8 +2143,6 @@ end subroutine update_stress !> @brief tbd !-------------------------------------------------------------------------------------------------- subroutine update_dependentState - use mesh, only: & - mesh_element use constitutive, only: & constitutive_dependentState => constitutive_microstructure @@ -2384,13 +2168,6 @@ end subroutine update_dependentState !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- subroutine update_state(timeFraction) - use material, only: & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt - use mesh, only: & - mesh_element real(pReal), intent(in) :: & timeFraction @@ -2432,17 +2209,6 @@ end subroutine update_state !> if NaN occurs, crystallite_todo is set to FALSE. Any NaN in a nonlocal propagates to all others !-------------------------------------------------------------------------------------------------- subroutine update_dotState(timeFraction) - use, intrinsic :: & - IEEE_arithmetic - use material, only: & - plasticState, & - sourceState, & - phaseAt, phasememberAt, & - phase_Nsources - use mesh, only: & - mesh_element - use constitutive, only: & - constitutive_collectDotState real(pReal), intent(in) :: & timeFraction @@ -2489,19 +2255,7 @@ end subroutine update_DotState subroutine update_deltaState - use, intrinsic :: & - IEEE_arithmetic - use prec, only: & - dNeq0 - use mesh, only: & - mesh_element - use material, only: & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt - use constitutive, only: & - constitutive_collectDeltaState + integer :: & e, & !< element index in element loop i, & !< integration point index in ip loop @@ -2566,27 +2320,6 @@ end subroutine update_deltaState !> returns true, if state jump was successfull or not needed. false indicates NaN in delta state !-------------------------------------------------------------------------------------------------- logical function stateJump(ipc,ip,el) - use, intrinsic :: & - IEEE_arithmetic - use prec, only: & - dNeq0 -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level, & - debug_crystallite, & - debug_levelExtensive, & - debug_levelSelective -#endif - use material, only: & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt - use constitutive, only: & - constitutive_collectDeltaState integer, intent(in):: & el, & ! element index diff --git a/src/lattice.f90 b/src/lattice.f90 index 1a7508984..43fc25530 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -7,8 +7,10 @@ ! and cleavage as well as interaction among the various systems !-------------------------------------------------------------------------------------------------- module lattice - use prec, only: & - pReal + use prec + use IO + use config + use math use future implicit none @@ -28,25 +30,25 @@ module lattice !-------------------------------------------------------------------------------------------------- ! face centered cubic - integer, dimension(2), parameter, private :: & + integer, dimension(2), parameter :: & LATTICE_FCC_NSLIPSYSTEM = [12, 6] !< # of slip systems per family for fcc - integer, dimension(1), parameter, private :: & + integer, dimension(1), parameter :: & LATTICE_FCC_NTWINSYSTEM = [12] !< # of twin systems per family for fcc - integer, dimension(1), parameter, private :: & + integer, dimension(1), parameter :: & LATTICE_FCC_NTRANSSYSTEM = [12] !< # of transformation systems per family for fcc - integer, dimension(2), parameter, private :: & + integer, dimension(2), parameter :: & LATTICE_FCC_NCLEAVAGESYSTEM = [3, 4] !< # of cleavage systems per family for fcc - integer, parameter, private :: & + integer, parameter :: & LATTICE_FCC_NSLIP = sum(LATTICE_FCC_NSLIPSYSTEM), & !< total # of slip systems for fcc LATTICE_FCC_NTWIN = sum(LATTICE_FCC_NTWINSYSTEM), & !< total # of twin systems for fcc LATTICE_FCC_NTRANS = sum(LATTICE_FCC_NTRANSSYSTEM), & !< total # of transformation systems for fcc LATTICE_FCC_NCLEAVAGE = sum(LATTICE_FCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for fcc - real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter :: & LATTICE_FCC_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! SCHMID-BOAS notation 0, 1,-1, 1, 1, 1, & ! B2 @@ -70,11 +72,11 @@ 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, private :: LATTICE_FCC_SLIPFAMILY_NAME = & + character(len=*), dimension(2), parameter :: LATTICE_FCC_SLIPFAMILY_NAME = & ['<0 1 -1>{1 1 1}', & '<0 1 -1>{0 1 1}'] - real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter :: & LATTICE_FCC_SYSTEMTWIN = reshape(real( [& -2, 1, 1, 1, 1, 1, & 1,-2, 1, 1, 1, 1, & @@ -90,7 +92,7 @@ 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, private :: LATTICE_FCC_TWINFAMILY_NAME = & + character(len=*), dimension(1), parameter :: LATTICE_FCC_TWINFAMILY_NAME = & ['<-2 1 1>{1 1 1}'] @@ -110,7 +112,7 @@ module lattice 10,11 & ],shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR)) - real(pReal), dimension(3+3,LATTICE_FCC_NCLEAVAGE), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_FCC_NCLEAVAGE), parameter :: & LATTICE_FCC_SYSTEMCLEAVAGE = reshape(real([& ! Cleavage direction Plane normal 0, 1, 0, 1, 0, 0, & @@ -124,21 +126,21 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered cubic - integer, dimension(2), parameter, private :: & + integer, dimension(2), parameter :: & LATTICE_BCC_NSLIPSYSTEM = [12, 12] !< # of slip systems per family for bcc - integer, dimension(1), parameter, private :: & + integer, dimension(1), parameter :: & LATTICE_BCC_NTWINSYSTEM = [12] !< # of twin systems per family for bcc - integer, dimension(2), parameter, private :: & + integer, dimension(2), parameter :: & LATTICE_BCC_NCLEAVAGESYSTEM = [3, 6] !< # of cleavage systems per family for bcc - integer, parameter, private :: & + integer, parameter :: & 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_NCLEAVAGE = sum(LATTICE_BCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for bcc - real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter :: & LATTICE_BCC_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! Slip system <111>{110} @@ -169,11 +171,11 @@ module lattice 1, 1, 1, 1, 1,-2 & ],pReal),shape(LATTICE_BCC_SYSTEMSLIP)) - character(len=*), dimension(2), parameter, private :: LATTICE_BCC_SLIPFAMILY_NAME = & + character(len=*), dimension(2), parameter :: LATTICE_BCC_SLIPFAMILY_NAME = & ['<1 -1 1>{0 1 1}', & '<1 -1 1>{2 1 1}'] - real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter :: & LATTICE_BCC_SYSTEMTWIN = reshape(real([& ! Twin system <111>{112} -1, 1, 1, 2, 1, 1, & @@ -190,10 +192,10 @@ module lattice 1, 1, 1, 1, 1,-2 & ],pReal),shape(LATTICE_BCC_SYSTEMTWIN)) - character(len=*), dimension(1), parameter, private :: LATTICE_BCC_TWINFAMILY_NAME = & + character(len=*), dimension(1), parameter :: LATTICE_BCC_TWINFAMILY_NAME = & ['<1 1 1>{2 1 1}'] - real(pReal), dimension(3+3,LATTICE_BCC_NCLEAVAGE), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCC_NCLEAVAGE), parameter :: & LATTICE_BCC_SYSTEMCLEAVAGE = reshape(real([& ! Cleavage direction Plane normal 0, 1, 0, 1, 0, 0, & @@ -209,21 +211,21 @@ module lattice !-------------------------------------------------------------------------------------------------- ! hexagonal - integer, dimension(6), parameter, private :: & + integer, dimension(6), parameter :: & LATTICE_HEX_NSLIPSYSTEM = [3, 3, 3, 6, 12, 6] !< # of slip systems per family for hex - integer, dimension(4), parameter, private :: & + integer, dimension(4), parameter :: & LATTICE_HEX_NTWINSYSTEM = [6, 6, 6, 6] !< # of slip systems per family for hex - integer, dimension(1), parameter, private :: & + integer, dimension(1), parameter :: & LATTICE_HEX_NCLEAVAGESYSTEM = [3] !< # of cleavage systems per family for hex - integer, parameter, private :: & + integer, parameter :: & LATTICE_HEX_NSLIP = sum(LATTICE_HEX_NSLIPSYSTEM), & !< total # of slip systems for hex LATTICE_HEX_NTWIN = sum(LATTICE_HEX_NTWINSYSTEM), & !< total # of twin systems for hex LATTICE_HEX_NCLEAVAGE = sum(LATTICE_HEX_NCLEAVAGESYSTEM) !< total # of cleavage systems for hex - real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter, private :: & + real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter :: & LATTICE_HEX_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! Basal systems <11.0>{00.1} (independent of c/a-ratio, Bravais notation (4 coordinate base)) @@ -267,7 +269,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, private :: LATTICE_HEX_SLIPFAMILY_NAME = & + character(len=*), dimension(6), parameter :: LATTICE_HEX_SLIPFAMILY_NAME = & ['<1 1 . 1>{0 0 . 1} ', & '<1 1 . 1>{1 0 . 0} ', & '<1 0 . 0>{1 1 . 0} ', & @@ -275,7 +277,7 @@ module lattice '<1 1 . 3>{-1 0 . 1} ', & '<1 1 . 3>{-1 -1 . 2}'] - real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter, private :: & + real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter :: & LATTICE_HEX_SYSTEMTWIN = reshape(real([& ! Compression or Tension =f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981) 1, -1, 0, 1, -1, 1, 0, 2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a) @@ -307,13 +309,13 @@ 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 - character(len=*), dimension(4), parameter, private :: LATTICE_HEX_TWINFAMILY_NAME = & + character(len=*), dimension(4), parameter :: 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} '] - real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter, private :: & + real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter :: & LATTICE_HEX_SYSTEMCLEAVAGE = reshape(real([& ! Cleavage direction Plane normal 2,-1,-1, 0, 0, 0, 0, 1, & @@ -324,13 +326,13 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered tetragonal - integer, dimension(13), parameter, private :: & + integer, dimension(13), parameter :: & LATTICE_BCT_NSLIPSYSTEM = [2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ] !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009 - integer, parameter, private :: & + integer, parameter :: & LATTICE_BCT_NSLIP = sum(LATTICE_BCT_NSLIPSYSTEM) !< total # of slip systems for bct - real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter :: & LATTICE_BCT_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! Slip family 1 {100)<001] (Bravais notation {hkl) @brief Module initialization !-------------------------------------------------------------------------------------------------- subroutine lattice_init - use IO, only: & - IO_error - use config, only: & - config_phase integer :: Nphases character(len=65536) :: & @@ -654,15 +652,7 @@ end subroutine lattice_init !> @brief !!!!!!!DEPRECTATED!!!!!! !-------------------------------------------------------------------------------------------------- subroutine lattice_initializeStructure(myPhase,CoverA) - use prec, only: & - tol_math_check - use math, only: & - math_sym3333to66, & - math_Voigt66to3333, & - math_cross - use IO, only: & - IO_error - + integer, intent(in) :: myPhase real(pReal), intent(in) :: & CoverA @@ -690,9 +680,10 @@ subroutine lattice_initializeStructure(myPhase,CoverA) call IO_error(135,el=i,ip=myPhase,ext_msg='matrix diagonal "el"ement of phase "ip"') enddo - forall (i = 1:3) & + do i = 1,3 lattice_thermalExpansion33 (1:3,1:3,i,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& lattice_thermalExpansion33 (1:3,1:3,i,myPhase)) + enddo lattice_thermalConductivity33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& lattice_thermalConductivity33 (1:3,1:3,myPhase)) @@ -763,17 +754,17 @@ pure function lattice_symmetrizeC66(struct,C66) select case(struct) case (LATTICE_iso_ID) - forall(k=1:3) + do k=1,3 forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2) lattice_symmetrizeC66(k,k) = C66(1,1) lattice_symmetrizeC66(k+3,k+3) = 0.5_pReal*(C66(1,1)-C66(1,2)) - end forall + enddo case (LATTICE_fcc_ID,LATTICE_bcc_ID) - forall(k=1:3) + do k=1,3 forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2) lattice_symmetrizeC66(k,k) = C66(1,1) lattice_symmetrizeC66(k+3,k+3) = C66(4,4) - end forall + enddo case (LATTICE_hex_ID) lattice_symmetrizeC66(1,1) = C66(1,1) lattice_symmetrizeC66(2,2) = C66(1,1) @@ -834,7 +825,9 @@ pure function lattice_symmetrize33(struct,T33) select case(struct) case (LATTICE_iso_ID,LATTICE_fcc_ID,LATTICE_bcc_ID) - forall(k=1:3) lattice_symmetrize33(k,k) = T33(1,1) + do k=1,3 + lattice_symmetrize33(k,k) = T33(1,1) + enddo case (LATTICE_hex_ID) lattice_symmetrize33(1,1) = T33(1,1) lattice_symmetrize33(2,2) = T33(1,1) @@ -854,10 +847,6 @@ end function lattice_symmetrize33 !> @brief figures whether unit quat falls into stereographic standard triangle !-------------------------------------------------------------------------------------------------- logical pure function lattice_qInSST(Q, struct) - use, intrinsic :: & - IEEE_arithmetic - use math, only: & - math_qToRodrig real(pReal), dimension(4), intent(in) :: Q ! orientation integer(kind(LATTICE_undefined_ID)), intent(in) :: struct ! lattice structure @@ -888,11 +877,6 @@ end function lattice_qInSST !> @brief calculates the disorientation for 2 unit quaternions !-------------------------------------------------------------------------------------------------- pure function lattice_qDisorientation(Q1, Q2, struct) - use prec, only: & - tol_math_check - use math, only: & - math_qMul, & - math_qConj real(pReal), dimension(4) :: lattice_qDisorientation real(pReal), dimension(4), intent(in) :: & @@ -998,8 +982,6 @@ end function lattice_qDisorientation !> @brief Characteristic shear for twinning !-------------------------------------------------------------------------------------------------- function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(characteristicShear) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -1077,14 +1059,6 @@ end function lattice_characteristicShear_Twin !> @brief Rotated elasticity matrices for twinning in 66-vector notation !-------------------------------------------------------------------------------------------------- function lattice_C66_twin(Ntwin,C66,structure,CoverA) - use IO, only: & - IO_error - use math, only: & - PI, & - math_axisAngleToR, & - math_sym3333to66, & - math_66toSym3333, & - math_rotate_forward3333 integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -1125,17 +1099,6 @@ end function lattice_C66_twin !-------------------------------------------------------------------------------------------------- function lattice_C66_trans(Ntrans,C_parent66,structure_target, & CoverA_trans,a_bcc,a_fcc) - use prec, only: & - tol_math_check - use IO, only: & - IO_error - use math, only: & - INRAD, & - MATH_I3, & - math_axisAngleToR, & - math_sym3333to66, & - math_66toSym3333, & - math_rotate_forward3333 integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family character(len=*), intent(in) :: structure_target !< lattice structure @@ -1196,13 +1159,6 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_target, & ! Gröger et al. 2008, Acta Materialia 56 (2008) 5412–5425, table 1 !-------------------------------------------------------------------------------------------------- function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSchmidMatrix) - use IO, only: & - IO_error - use math, only: & - INRAD, & - math_outer, & - math_cross, & - math_axisAngleToR integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family real(pReal), dimension(:), intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections @@ -1246,9 +1202,7 @@ end function lattice_nonSchmidMatrix !> details only active slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipBySlip(Nslip,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error - + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction character(len=*), intent(in) :: structure !< lattice structure @@ -1468,8 +1422,6 @@ end function lattice_interaction_SlipBySlip !> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TwinByTwin(Ntwin,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction @@ -1571,8 +1523,6 @@ end function lattice_interaction_TwinByTwin !> details only active trans systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TransByTrans(Ntrans,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Ntrans !< number of active trans systems per family real(pReal), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction @@ -1618,8 +1568,6 @@ end function lattice_interaction_TransByTrans !> details only active slip and twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family Ntwin !< number of active twin systems per family @@ -1760,8 +1708,6 @@ end function lattice_interaction_SlipByTwin !> details only active slip and trans systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family Ntrans !< number of active trans systems per family @@ -1818,8 +1764,6 @@ function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,structur !> details only active twin and slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Ntwin, & !< number of active twin systems per family Nslip !< number of active slip systems per family @@ -1898,13 +1842,6 @@ end function lattice_interaction_TwinBySlip !> details only active slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) - use prec, only: & - tol_math_check - use IO, only: & - IO_error - use math, only: & - math_trace33, & - math_outer integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -1957,13 +1894,6 @@ end function lattice_SchmidMatrix_slip !> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) - use prec, only: & - tol_math_check - use IO, only: & - IO_error - use math, only: & - math_trace33, & - math_outer integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -2013,8 +1943,6 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) !> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) result(SchmidMatrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family real(pReal), intent(in) :: cOverA !< c/a ratio @@ -2041,11 +1969,7 @@ end function lattice_SchmidMatrix_trans !> details only active cleavage systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix) - use math, only: & - math_outer - use IO, only: & - IO_error - + integer, dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family character(len=*), intent(in) :: structure !< lattice structure real(pReal), intent(in) :: cOverA !< c/a ratio @@ -2154,8 +2078,6 @@ end function lattice_slip_transverse !> @details: This projection is used to calculate forest hardening for edge dislocations !-------------------------------------------------------------------------------------------------- function slipProjection_transverse(Nslip,structure,cOverA) result(projection) - use math, only: & - math_inner integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -2179,8 +2101,6 @@ end function slipProjection_transverse !> @details: This projection is used to calculate forest hardening for screw dislocations !-------------------------------------------------------------------------------------------------- function slipProjection_direction(Nslip,structure,cOverA) result(projection) - use math, only: & - math_inner integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family character(len=*), intent(in) :: structure !< lattice structure @@ -2204,9 +2124,7 @@ end function slipProjection_direction !> @details Order: Direction, plane (normal), and common perpendicular !-------------------------------------------------------------------------------------------------- function coordinateSystem_slip(Nslip,structure,cOverA) result(coordinateSystem) - use IO, only: & - IO_error - + integer, 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 @@ -2249,8 +2167,6 @@ end function coordinateSystem_slip !> @brief Populates reduced interaction matrix !-------------------------------------------------------------------------------------------------- function buildInteraction(reacting_used,acting_used,reacting_max,acting_max,values,matrix) - use IO, only: & - IO_error integer, dimension(:), intent(in) :: & reacting_used, & !< # of reacting systems per family as specified in material.config @@ -2295,10 +2211,6 @@ end function buildInteraction !> @details Order: Direction, plane (normal), and common perpendicular !-------------------------------------------------------------------------------------------------- function buildCoordinateSystem(active,complete,system,structure,cOverA) - use IO, only: & - IO_error - use math, only: & - math_cross integer, dimension(:), intent(in) :: & active, & @@ -2370,16 +2282,6 @@ end function buildCoordinateSystem ! set a_bcc = 0.0 for fcc -> hex transformation !-------------------------------------------------------------------------------------------------- subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) - use prec, only: & - dEq0 - use math, only: & - math_cross, & - math_outer, & - math_axisAngleToR, & - INRAD, & - MATH_I3 - use IO, only: & - IO_error integer, dimension(:), intent(in) :: & Ntrans diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 7db1f5f7f..fd5d8b787 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -8,17 +8,26 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module plastic_dislotwin - use prec, only: & - pReal + use prec + use debug + use math + use IO + use material + use config + use lattice +#if defined(PETSc) || defined(DAMASK_HDF5) + use results +#endif implicit none private + integer, dimension(:,:), allocatable, target, public :: & plastic_dislotwin_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & plastic_dislotwin_output !< name of each post result output - real(pReal), parameter, private :: & + real(pReal), parameter :: & kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin enum, bind(c) @@ -39,7 +48,7 @@ module plastic_dislotwin f_tr_ID end enum - type, private :: tParameters + type :: tParameters real(pReal) :: & mu, & nu, & @@ -119,7 +128,7 @@ module plastic_dislotwin dipoleFormation !< flag indicating consideration of dipole formation end type !< container type for internal constitutive parameters - type, private :: tDislotwinState + type :: tDislotwinState real(pReal), dimension(:,:), pointer :: & rho_mob, & rho_dip, & @@ -128,7 +137,7 @@ module plastic_dislotwin f_tr end type tDislotwinState - type, private :: tDislotwinMicrostructure + type :: tDislotwinMicrostructure real(pReal), dimension(:,:), allocatable :: & Lambda_sl, & !* mean free path between 2 obstacles seen by a moving dislocation Lambda_tw, & !* mean free path between 2 obstacles seen by a growing twin @@ -144,11 +153,11 @@ module plastic_dislotwin !-------------------------------------------------------------------------------------------------- ! containers for parameters and state - type(tParameters), allocatable, dimension(:), private :: param - type(tDislotwinState), allocatable, dimension(:), private :: & + type(tParameters), allocatable, dimension(:) :: param + type(tDislotwinState), allocatable, dimension(:) :: & dotState, & state - type(tDislotwinMicrostructure), allocatable, dimension(:), private :: dependentState + type(tDislotwinMicrostructure), allocatable, dimension(:) :: dependentState public :: & plastic_dislotwin_init, & @@ -158,10 +167,6 @@ module plastic_dislotwin plastic_dislotwin_dotState, & plastic_dislotwin_postResults, & plastic_dislotwin_results - private :: & - kinetics_slip, & - kinetics_twin, & - kinetics_trans contains @@ -171,24 +176,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_init - use prec, only: & - pStringLen, & - dEq0, & - dNeq0, & - dNeq - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use math, only: & - math_expand,& - PI - use IO, only: & - IO_error - use material - use config, only: & - config_phase - use lattice integer :: & Ninstance, & @@ -591,10 +578,6 @@ end subroutine plastic_dislotwin_init !> @brief returns the homogenized elasticity matrix !-------------------------------------------------------------------------------------------------- function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) - use material, only: & - material_phase, & - phase_plasticityInstance, & - phasememberAt real(pReal), dimension(6,6) :: & homogenizedC @@ -634,14 +617,6 @@ end function plastic_dislotwin_homogenizedC !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) - use prec, only: & - tol_math_check, & - dNeq0 - use math, only: & - math_eigenValuesVectorsSym, & - math_outer, & - math_symmetric33, & - math_mul33xx33 real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp @@ -757,13 +732,6 @@ end subroutine plastic_dislotwin_LpAndItsTangent !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_dotState(Mp,T,instance,of) - use prec, only: & - tol_math_check, & - dEq0 - use math, only: & - math_clip, & - math_mul33xx33, & - PI real(pReal), dimension(3,3), intent(in):: & Mp !< Mandel stress @@ -854,8 +822,6 @@ end subroutine plastic_dislotwin_dotState !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_dependentState(T,instance,of) - use math, only: & - PI integer, intent(in) :: & instance, & @@ -868,13 +834,13 @@ subroutine plastic_dislotwin_dependentState(T,instance,of) real(pReal) :: & sumf_twin,SFE,sumf_trans real(pReal), dimension(param(instance)%sum_N_sl) :: & - inv_lambda_sl_sl, & !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation - inv_lambda_sl_tw, & !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation - inv_lambda_sl_tr !* 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation + inv_lambda_sl_sl, & !< 1/mean free distance between 2 forest dislocations seen by a moving dislocation + inv_lambda_sl_tw, & !< 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation + inv_lambda_sl_tr !< 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation real(pReal), dimension(param(instance)%sum_N_tw) :: & - inv_lambda_tw_tw !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin + inv_lambda_tw_tw !< 1/mean free distance between 2 twin stacks from different systems seen by a growing twin real(pReal), dimension(param(instance)%sum_N_tr) :: & - inv_lambda_tr_tr !* 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite (1/lambda_trans) + inv_lambda_tr_tr !< 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite real(pReal), dimension(:), allocatable :: & x0, & @@ -967,12 +933,6 @@ end subroutine plastic_dislotwin_dependentState !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- function plastic_dislotwin_postResults(Mp,T,instance,of) result(postResults) - use prec, only: & - tol_math_check, & - dEq0 - use math, only: & - PI, & - math_mul33xx33 real(pReal), dimension(3,3),intent(in) :: & Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation @@ -1050,8 +1010,6 @@ end function plastic_dislotwin_postResults !-------------------------------------------------------------------------------------------------- subroutine plastic_dislotwin_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) - use results, only: & - results_writeDataset integer, intent(in) :: instance character(len=*) :: group @@ -1112,11 +1070,6 @@ end subroutine plastic_dislotwin_results !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_slip(Mp,T,instance,of, & dot_gamma_sl,ddot_gamma_dtau_slip,tau_slip) - use prec, only: & - tol_math_check, & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -1190,11 +1143,6 @@ end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& dot_gamma_twin,ddot_gamma_dtau_twin) - use prec, only: & - tol_math_check, & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -1261,11 +1209,6 @@ end subroutine kinetics_twin !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& dot_gamma_tr,ddot_gamma_dtau_trans) - use prec, only: & - tol_math_check, & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index c572f0ded..46d0905dc 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -8,11 +8,19 @@ !! untextured polycrystal !-------------------------------------------------------------------------------------------------- module plastic_isotropic - use prec, only: & - pReal + use prec + use debug + use math + use IO + use material + use config +#if defined(PETSc) || defined(DAMASK_HDF5) + use results +#endif implicit none private + integer, dimension(:,:), allocatable, target, public :: & plastic_isotropic_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & @@ -25,7 +33,7 @@ module plastic_isotropic dot_gamma_ID end enum - type, private :: tParameters + type :: tParameters real(pReal) :: & M, & !< Taylor factor xi_0, & !< initial critical stress @@ -49,7 +57,7 @@ module plastic_isotropic dilatation end type tParameters - type, private :: tIsotropicState + type :: tIsotropicState real(pReal), pointer, dimension(:) :: & xi, & gamma @@ -57,8 +65,8 @@ module plastic_isotropic !-------------------------------------------------------------------------------------------------- ! containers for parameters and state - type(tParameters), allocatable, dimension(:), private :: param - type(tIsotropicState), allocatable, dimension(:), private :: & + type(tParameters), allocatable, dimension(:) :: param + type(tIsotropicState), allocatable, dimension(:) :: & dotState, & state @@ -77,25 +85,7 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_init - use prec, only: & - pStringLen - use debug, only: & -#ifdef DEBUG - debug_e, & - debug_i, & - debug_g, & - debug_levelExtensive, & -#endif - debug_level, & - debug_constitutive, & - debug_levelBasic - use IO, only: & - IO_error - use material - use config, only: & - config_phase - use lattice - + integer :: & Ninstance, & p, i, & @@ -235,16 +225,6 @@ end subroutine plastic_isotropic_init !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) -#ifdef DEBUG - use debug, only: & - debug_level, & - debug_constitutive,& - debug_levelExtensive, & - debug_levelSelective -#endif - use math, only: & - math_deviatoric33, & - math_mul33xx33 real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -307,10 +287,6 @@ end subroutine plastic_isotropic_LpAndItsTangent ! ToDo: Rename Tstar to Mi? !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of) - use math, only: & - math_I3, & - math_spherical33, & - math_mul33xx33 real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient @@ -362,11 +338,6 @@ subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of) !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_dotState(Mp,instance,of) - use prec, only: & - dEq0 - use math, only: & - math_mul33xx33, & - math_deviatoric33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -416,9 +387,6 @@ end subroutine plastic_isotropic_dotState !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- function plastic_isotropic_postResults(Mp,instance,of) result(postResults) - use math, only: & - math_mul33xx33, & - math_deviatoric33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -468,7 +436,6 @@ end function plastic_isotropic_postResults !-------------------------------------------------------------------------------------------------- subroutine plastic_isotropic_results(instance,group) #if defined(PETSc) || defined(DAMASKHDF5) - use results integer, intent(in) :: instance character(len=*), intent(in) :: group diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 861b98da3..ab68eb176 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -6,11 +6,20 @@ !! and a Voce-type kinematic hardening rule !-------------------------------------------------------------------------------------------------- module plastic_kinehardening - use prec, only: & - pReal + use prec + use debug + use math + use IO + use material + use config + use lattice +#if defined(PETSc) || defined(DAMASK_HDF5) + use results +#endif implicit none private + integer, dimension(:,:), allocatable, target, public :: & plastic_kinehardening_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & @@ -29,7 +38,7 @@ module plastic_kinehardening resolvedstress_ID end enum - type, private :: tParameters + type :: tParameters real(pReal) :: & gdot0, & !< reference shear strain rate for slip n, & !< stress exponent for slip @@ -59,7 +68,7 @@ module plastic_kinehardening outputID !< ID of each post result output end type tParameters - type, private :: tKinehardeningState + type :: tKinehardeningState real(pReal), pointer, dimension(:,:) :: & !< vectors along NipcMyInstance crss, & !< critical resolved stress crss_back, & !< critical resolved back stress @@ -71,8 +80,8 @@ module plastic_kinehardening !-------------------------------------------------------------------------------------------------- ! containers for parameters and state - type(tParameters), allocatable, dimension(:), private :: param - type(tKinehardeningState), allocatable, dimension(:), private :: & + type(tParameters), allocatable, dimension(:) :: param + type(tKinehardeningState), allocatable, dimension(:) :: & dotState, & deltaState, & state @@ -84,8 +93,6 @@ module plastic_kinehardening plastic_kinehardening_deltaState, & plastic_kinehardening_postResults, & plastic_kinehardening_results - private :: & - kinetics contains @@ -95,27 +102,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_kinehardening_init - use prec, only: & - dEq0, & - pStringLen - use debug, only: & -#ifdef DEBUG - debug_e, & - debug_i, & - debug_g, & - debug_levelExtensive, & -#endif - debug_level, & - debug_constitutive,& - debug_levelBasic - use math, only: & - math_expand - use IO, only: & - IO_error - use material - use config, only: & - config_phase - use lattice integer :: & Ninstance, & @@ -417,16 +403,6 @@ end subroutine plastic_kinehardening_dotState !> @brief calculates (instantaneous) incremental change of microstructure !-------------------------------------------------------------------------------------------------- subroutine plastic_kinehardening_deltaState(Mp,instance,of) - use prec, only: & - dNeq, & - dEq0 -#ifdef DEBUG - use debug, only: & - debug_level, & - debug_constitutive,& - debug_levelExtensive, & - debug_levelSelective -#endif real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -475,8 +451,6 @@ end subroutine plastic_kinehardening_deltaState !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- function plastic_kinehardening_postResults(Mp,instance,of) result(postResults) - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -535,8 +509,6 @@ end function plastic_kinehardening_postResults !-------------------------------------------------------------------------------------------------- subroutine plastic_kinehardening_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) - use results, only: & - results_writeDataset integer, intent(in) :: instance character(len=*) :: group @@ -585,10 +557,6 @@ end subroutine plastic_kinehardening_results !-------------------------------------------------------------------------------------------------- pure subroutine kinetics(Mp,instance,of, & gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) - use prec, only: & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress diff --git a/src/plastic_none.f90 b/src/plastic_none.f90 index 4b14266f1..894cc9a40 100644 --- a/src/plastic_none.f90 +++ b/src/plastic_none.f90 @@ -5,6 +5,8 @@ !> @brief Dummy plasticity for purely elastic material !-------------------------------------------------------------------------------------------------- module plastic_none + use material + use debug implicit none private @@ -19,11 +21,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_none_init - use debug, only: & - debug_level, & - debug_constitutive, & - debug_levelBasic - use material integer :: & Ninstance, & diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 196129f64..a31891573 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -5,11 +5,20 @@ !> @brief phenomenological crystal plasticity formulation using a powerlaw fitting !-------------------------------------------------------------------------------------------------- module plastic_phenopowerlaw - use prec, only: & - pReal + use prec + use debug + use math + use IO + use material + use config + use lattice +#if defined(PETSc) || defined(DAMASK_HDF5) + use results +#endif implicit none private + integer, dimension(:,:), allocatable, target, public :: & plastic_phenopowerlaw_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & @@ -28,7 +37,7 @@ module plastic_phenopowerlaw resolvedstress_twin_ID end enum - type, private :: tParameters + type :: tParameters real(pReal) :: & gdot0_slip, & !< reference shear strain rate for slip gdot0_twin, & !< reference shear strain rate for twin @@ -73,7 +82,7 @@ module plastic_phenopowerlaw outputID !< ID of each post result output end type tParameters - type, private :: tPhenopowerlawState + type :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & xi_slip, & xi_twin, & @@ -83,8 +92,8 @@ module plastic_phenopowerlaw !-------------------------------------------------------------------------------------------------- ! containers for parameters and state - type(tParameters), allocatable, dimension(:), private :: param - type(tPhenopowerlawState), allocatable, dimension(:), private :: & + type(tParameters), allocatable, dimension(:) :: param + type(tPhenopowerlawState), allocatable, dimension(:) :: & dotState, & state @@ -94,9 +103,6 @@ module plastic_phenopowerlaw plastic_phenopowerlaw_dotState, & plastic_phenopowerlaw_postResults, & plastic_phenopowerlaw_results - private :: & - kinetics_slip, & - kinetics_twin contains @@ -106,20 +112,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_init - use prec, only: & - pStringLen - use debug, only: & - debug_level, & - debug_constitutive,& - debug_levelBasic - use math, only: & - math_expand - use IO, only: & - IO_error - use material - use config, only: & - config_phase - use lattice integer :: & Ninstance, & @@ -484,8 +476,6 @@ end subroutine plastic_phenopowerlaw_dotState !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults) - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -552,8 +542,6 @@ end function plastic_phenopowerlaw_postResults !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) - use results, only: & - results_writeDataset integer, intent(in) :: instance character(len=*), intent(in) :: group @@ -598,10 +586,6 @@ end subroutine plastic_phenopowerlaw_results !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_slip(Mp,instance,of, & gdot_slip_pos,gdot_slip_neg,dgdot_dtau_slip_pos,dgdot_dtau_slip_neg) - use prec, only: & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -674,10 +658,6 @@ end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- pure subroutine kinetics_twin(Mp,instance,of,& gdot_twin,dgdot_dtau_twin) - use prec, only: & - dNeq0 - use math, only: & - math_mul33xx33 real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress diff --git a/src/quaternions.f90 b/src/quaternions.f90 index fa9c13f38..47490daba 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -34,8 +34,7 @@ !> @details w is the real part, (x, y, z) are the imaginary parts. !--------------------------------------------------------------------------------------------------- module quaternions - use prec, only: & - pReal + use prec use future implicit none @@ -286,8 +285,6 @@ end function div_scal__ !> equality of two quaternions !--------------------------------------------------------------------------------------------------- logical elemental function eq__(self,other) - use prec, only: & - dEq class(quaternion), intent(in) :: self,other diff --git a/src/rotations.f90 b/src/rotations.f90 index 69529ed24..3a64f27b9 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -46,12 +46,15 @@ !--------------------------------------------------------------------------------------------------- module rotations - use prec, only: & - pReal + use prec + use IO + use math + use Lambert use quaternions implicit none private + type, public :: rotation type(quaternion), private :: q contains @@ -148,8 +151,6 @@ end subroutine !> @details: rotation is based on unit quaternion or rotation matrix (fallback) !--------------------------------------------------------------------------------------------------- function rotVector(self,v,active) - use prec, only: & - dEq real(pReal), dimension(3) :: rotVector class(rotation), intent(in) :: self @@ -260,10 +261,6 @@ end function qu2om !> @brief convert unit quaternion to Euler angles !--------------------------------------------------------------------------------------------------- pure function qu2eu(qu) result(eu) - use prec, only: & - dEq0 - use math, only: & - PI type(quaternion), intent(in) :: qu real(pReal), dimension(3) :: eu @@ -294,12 +291,6 @@ end function qu2eu !> @brief convert unit quaternion to axis angle pair !--------------------------------------------------------------------------------------------------- pure function qu2ax(qu) result(ax) - use prec, only: & - dEq0, & - dNeq0 - use math, only: & - PI, & - math_clip type(quaternion), intent(in) :: qu real(pReal), dimension(4) :: ax @@ -324,13 +315,6 @@ end function qu2ax !> @brief convert unit quaternion to Rodrigues vector !--------------------------------------------------------------------------------------------------- pure function qu2ro(qu) result(ro) - use, intrinsic :: IEEE_ARITHMETIC, only: & - IEEE_value, & - IEEE_positive_inf - use prec, only: & - dEq0 - use math, only: & - math_clip type(quaternion), intent(in) :: qu real(pReal), dimension(4) :: ro @@ -358,10 +342,6 @@ end function qu2ro !> @brief convert unit quaternion to homochoric !--------------------------------------------------------------------------------------------------- pure function qu2ho(qu) result(ho) - use prec, only: & - dEq0 - use math, only: & - math_clip type(quaternion), intent(in) :: qu real(pReal), dimension(3) :: ho @@ -415,8 +395,6 @@ end function om2qu !> @brief orientation matrix to Euler angles !--------------------------------------------------------------------------------------------------- pure function om2eu(om) result(eu) - use math, only: & - PI real(pReal), intent(in), dimension(3,3) :: om real(pReal), dimension(3) :: eu @@ -441,15 +419,6 @@ end function om2eu !> @brief convert orientation matrix to axis angle pair !--------------------------------------------------------------------------------------------------- function om2ax(om) result(ax) - use prec, only: & - dEq0, & - cEq, & - dNeq0 - use IO, only: & - IO_error - use math, only: & - math_clip, & - math_trace33 real(pReal), intent(in) :: om(3,3) real(pReal) :: ax(4) @@ -560,8 +529,6 @@ end function eu2qu !> @brief Euler angles to orientation matrix !--------------------------------------------------------------------------------------------------- pure function eu2om(eu) result(om) - use prec, only: & - dEq0 real(pReal), intent(in), dimension(3) :: eu real(pReal), dimension(3,3) :: om @@ -591,11 +558,6 @@ end function eu2om !> @brief convert euler to axis angle !--------------------------------------------------------------------------------------------------- pure function eu2ax(eu) result(ax) - use prec, only: & - dEq0, & - dEq - use math, only: & - PI real(pReal), intent(in), dimension(3) :: eu real(pReal), dimension(4) :: ax @@ -625,13 +587,6 @@ end function eu2ax !> @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 - use math, only: & - PI real(pReal), intent(in), dimension(3) :: eu real(pReal), dimension(4) :: ro @@ -681,8 +636,6 @@ end function eu2cu !> @brief convert axis angle pair to quaternion !--------------------------------------------------------------------------------------------------- pure function ax2qu(ax) result(qu) - use prec, only: & - dEq0 real(pReal), intent(in), dimension(4) :: ax type(quaternion) :: qu @@ -755,13 +708,6 @@ end function ax2eu !> @brief convert axis angle pair to Rodrigues vector !--------------------------------------------------------------------------------------------------- pure function ax2ro(ax) result(ro) - use, intrinsic :: IEEE_ARITHMETIC, only: & - IEEE_value, & - IEEE_positive_inf - use prec, only: & - dEq0 - use math, only: & - PI real(pReal), intent(in), dimension(4) :: ax real(pReal), dimension(4) :: ro @@ -858,12 +804,6 @@ end function ro2eu !> @brief convert Rodrigues vector to axis angle pair !--------------------------------------------------------------------------------------------------- pure function ro2ax(ro) result(ax) - use, intrinsic :: IEEE_ARITHMETIC, only: & - IEEE_is_finite - use prec, only: & - dEq0 - use math, only: & - PI real(pReal), intent(in), dimension(4) :: ro real(pReal), dimension(4) :: ax @@ -890,12 +830,6 @@ end function ro2ax !> @brief convert Rodrigues vector to homochoric !--------------------------------------------------------------------------------------------------- pure function ro2ho(ro) result(ho) - use, intrinsic :: IEEE_ARITHMETIC, only: & - IEEE_is_finite - use prec, only: & - dEq0 - use math, only: & - PI real(pReal), intent(in), dimension(4) :: ro real(pReal), dimension(3) :: ho @@ -973,8 +907,6 @@ end function ho2eu !> @brief convert homochoric to axis angle pair !--------------------------------------------------------------------------------------------------- pure function ho2ax(ho) result(ax) - use prec, only: & - dEq0 real(pReal), intent(in), dimension(3) :: ho real(pReal), dimension(4) :: ax @@ -1029,13 +961,11 @@ end function ho2ro !> @brief convert homochoric to cubochoric !--------------------------------------------------------------------------------------------------- function ho2cu(ho) result(cu) - use Lambert, only: & - LambertBallToCube real(pReal), intent(in), dimension(3) :: ho real(pReal), dimension(3) :: cu - cu = LambertBallToCube(ho) + cu = Lambert_BallToCube(ho) end function ho2cu @@ -1115,13 +1045,11 @@ end function cu2ro !> @brief convert cubochoric to homochoric !--------------------------------------------------------------------------------------------------- function cu2ho(cu) result(ho) - use Lambert, only: & - LambertCubeToBall real(pReal), intent(in), dimension(3) :: cu real(pReal), dimension(3) :: ho - ho = LambertCubeToBall(cu) + ho = Lambert_CubeToBall(cu) end function cu2ho