From dbdc7ddfa2f545fb618b1cb2c78fed8b67a25022 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 20 Mar 2012 18:01:31 +0000 Subject: [PATCH] debug.config, debug.f90, DAMASK_abaqus_exp.f, DAMASK_abaqus_std.f: changed to new debug scheme (wasn't working) lattice.f90, FEsolving.f90: explicitly defined public functions and variables, all others are now private numerics.f90: changed output format of real numbers, now instead of 0.1eX 1.0e(X-1) is printed to screen Makefile: now using correct Optimization flags for OPTIMIZATION=AGGRESSIVE DAMASK_spectral_AL.f90: improved, but still testing. Stress BCs now seem to be handled correctly --- code/DAMASK_abaqus_exp.f | 10 +- code/DAMASK_abaqus_std.f | 8 +- code/DAMASK_spectral_AL.f90 | 49 +- code/FEsolving.f90 | 64 +- code/Makefile | 2 +- code/config/debug.config | 1 + code/debug.f90 | 8 +- code/lattice.f90 | 1246 ++++++++++++++++++----------------- code/numerics.f90 | 96 +-- 9 files changed, 771 insertions(+), 713 deletions(-) diff --git a/code/DAMASK_abaqus_exp.f b/code/DAMASK_abaqus_exp.f index 87f30000c..84172cd85 100644 --- a/code/DAMASK_abaqus_exp.f +++ b/code/DAMASK_abaqus_exp.f @@ -177,7 +177,9 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, & use math, only: invnrmMandel use debug, only: debug_info, & debug_reset, & - debug_verbosity + debug_levelBasic, & + debug_what, & + debug_abaqus use mesh, only: mesh_FEasCP use CPFEM, only: CPFEM_general,CPFEM_init_done, CPFEM_initAll use homogenization, only: materialpoint_sizeResults, materialpoint_results @@ -216,7 +218,7 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, & call CPFEM_initAll(temp,nElement(n),nMatPoint(n)) outdatedByNewInc = .false. - if ( debug_verbosity > 1 ) then + if (iand(debug_what(debug_abaqus),debug_levelBasic) /= 0) then !$OMP CRITICAL (write2out) write(6,'(i8,x,i2,x,a)') nElement(n),nMatPoint(n),'first call special case..!'; call flush(6) !$OMP END CRITICAL (write2out) @@ -225,7 +227,7 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, & else if (theTime < totalTime) then ! reached convergence outdatedByNewInc = .true. - if ( debug_verbosity > 1 ) then + if (iand(debug_what(debug_abaqus),debug_levelBasic) /= 0) then !$OMP CRITICAL (write2out) write (6,'(i8,x,i2,x,a)') nElement(n),nMatPoint(n),'lastIncConverged + outdated'; call flush(6) !$OMP END CRITICAL (write2out) @@ -247,7 +249,7 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, & theTime = totalTime ! record current starting time - if ( debug_verbosity > 1 ) then + if (iand(debug_what(debug_abaqus),debug_levelBasic) /= 0) then !$OMP CRITICAL (write2out) write(6,'(a16,x,i2,x,a,i8,x,i5,a)') 'computationMode',computationMode,'(',nElement(n),nMatPoint(n),')'; call flush(6) !$OMP END CRITICAL (write2out) diff --git a/code/DAMASK_abaqus_std.f b/code/DAMASK_abaqus_std.f index c542fe819..1337edc43 100644 --- a/code/DAMASK_abaqus_std.f +++ b/code/DAMASK_abaqus_std.f @@ -141,7 +141,9 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,& use math, only: invnrmMandel use debug, only: debug_info, & debug_reset, & - debug_verbosity + debug_levelBasic, & + debug_what, & + debug_abaqus use mesh, only: mesh_FEasCP use CPFEM, only: CPFEM_general,CPFEM_init_done, CPFEM_initAll use homogenization, only: materialpoint_sizeResults, materialpoint_results @@ -167,7 +169,7 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,& real(pReal), dimension(6,6) :: ddsdde_h integer(pInt) computationMode, i, cp_en - if (debug_verbosity > 1 .and. noel == 1 .and. npt == 1) then + if (iand(debug_what(debug_abaqus),debug_levelBasic) /= 0 .and. noel == 1 .and. npt == 1) then !$OMP CRITICAL (write2out) write(6,*) 'el',noel,'ip',npt write(6,*) 'got kinc as',kinc @@ -255,7 +257,7 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,& theInc = kinc ! record current increment number lastMode = calcMode(npt,cp_en) ! record calculationMode - if ( debug_verbosity > 1 ) then + if (iand(debug_what(debug_abaqus),debug_levelBasic) /= 0) then !$OMP CRITICAL (write2out) write(6,'(a16,x,i2,x,a,i8,a,i8,x,i5,a)') 'computationMode',computationMode,'(',cp_en,':',noel,npt,')'; call flush(6) !$OMP END CRITICAL (write2out) diff --git a/code/DAMASK_spectral_AL.f90 b/code/DAMASK_spectral_AL.f90 index 208c10c41..c2608ae73 100644 --- a/code/DAMASK_spectral_AL.f90 +++ b/code/DAMASK_spectral_AL.f90 @@ -36,7 +36,7 @@ !################################################################################################## ! used modules !################################################################################################## -program DAMASK_spectral +program DAMASK_spectral_AL use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) use DAMASK_interface @@ -83,7 +83,7 @@ program DAMASK_spectral ! variable storing information from load case file type bc_type real(pReal), dimension (3,3) :: deformation = 0.0_pReal, & ! applied velocity gradient or time derivative of deformation gradient - stress = 0.0_pReal, & ! stress BC (if applicable) + P = 0.0_pReal, & ! stress BC (if applicable) rotation = math_I3 ! rotation of BC (if applicable) real(pReal) :: time = 0.0_pReal, & ! length of increment temperature = 300.0_pReal ! isothermal starting conditions @@ -230,10 +230,10 @@ program DAMASK_spectral IO_stringValue(line,positions,j+k) /= '*' do k = 1_pInt,9_pInt if (bc(loadcase)%maskStressVector(k)) temp_valueVector(k) =& - IO_floatValue(line,positions,j+k) ! assign values for the bc(loadcase)%stress matrix + IO_floatValue(line,positions,j+k) ! assign values for the bc(loadcase)%P matrix enddo bc(loadcase)%maskStress = transpose(reshape(bc(loadcase)%maskStressVector,[ 3,3])) - bc(loadcase)%stress = math_plain9to33(temp_valueVector) + bc(loadcase)%P = math_plain9to33(temp_valueVector) case('t','time','delta') ! increment time bc(loadcase)%time = IO_floatValue(line,positions,j+1_pInt) case('temp','temperature') ! starting temperature @@ -379,7 +379,7 @@ program DAMASK_spectral write (*,'(3(3(f12.7,1x)/))',advance='no') merge(math_transpose33(bc(loadcase)%deformation),& reshape(spread(DAMASK_NaN,1,9),[ 3,3]),transpose(bc(loadcase)%maskDeformation)) write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') 'stress / GPa:',& - 1e-9_pReal*merge(math_transpose33(bc(loadcase)%stress),& + 1e-9_pReal*merge(math_transpose33(bc(loadcase)%P),& reshape(spread(DAMASK_NaN,1,9),[ 3,3]),transpose(bc(loadcase)%maskStress)) if (any(bc(loadcase)%rotation /= math_I3)) & write (*,'(a,/,3(3(f12.7,1x)/))',advance='no') ' rotation of loadframe:',& @@ -672,7 +672,7 @@ program DAMASK_spectral guessmode = 1.0_pReal ! keep guessing along former trajectory during same loadcase CPFEM_mode = 1_pInt ! winding forward iter = 0_pInt - err_crit = 2.0_pReal * err_div_tol ! go into loop + err_crit = huge(err_div_tol) ! go into loop !################################################################################################## ! convergence loop (looping over iterations) @@ -691,21 +691,19 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! stress BC handling if(size_reduced > 0_pInt) then ! calculate stress BC if applied - err_stress = maxval(abs(mask_stress * (P_av - bc(loadcase)%stress))) ! maximum deviaton (tensor norm not applicable) + err_stress = maxval(abs(mask_stress * (P_av - bc(loadcase)%P))) ! maximum deviaton (tensor norm not applicable) write (*,'(a,/,3(3(es14.7,1x)/))',advance='no') 'stress deviation =',& - math_transpose33(mask_stress * (P_av - bc(loadcase)%stress))/1.0e6_pReal - F_aim = F_aim + math_mul3333xx33(S_lastInc,bc(loadcase)%stress- P_av) + math_transpose33(mask_stress * (P_av - bc(loadcase)%P))/1.0e6_pReal + F_aim = F_aim + math_mul3333xx33(S_lastInc,bc(loadcase)%P- P_av) err_stress_tol = maxval(abs(P_av)) * err_stress_tolrel ! don't use any tensor norm because the comparison should be coherent else err_stress_tol = + huge(1.0_pReal) endif F_aim_lab = math_rotate_backward33(F_aim,bc(loadcase)%rotation) - write (*,'(a,/,3(3(es14.7,1x)/))',advance='no') 'F =',& + write (*,'(a,/,3(3(es14.7,1x)/))',advance='no') 'F aim =',& math_transpose33(F_aim) - temp33_real = 0.0_pReal - do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res(1) - temp33_real = temp33_real + F_star(i,j,k,1:3,1:3) - enddo; enddo; enddo + write (*,'(a,/,3(3(es14.7,1x)/))',advance='no') 'F* =',& + math_transpose33(F_star_av) !-------------------------------------------------------------------------------------------------- ! doing Fourier transform @@ -750,6 +748,11 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! doing inverse Fourier transform call fftw_execute_dft_c2r(plan_correction,F_fourier,F_real) ! back transform of fluct deformation gradient + ! do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res(1) + ! write (*,'(a,/,3(3(es14.7,1x)/))',advance='no') 'delta F real =',& + ! math_transpose33(F_real(i,j,k,1:3,1:3)*wgt) + ! enddo; enddo; enddo + F_real(1:res(1),1:res(2),1:res(3),1:3,1:3) = F_real(1:res(1),1:res(2),1:res(3),1:3,1:3) * wgt + & F_star(1:res(1),1:res(2),1:res(3),1:3,1:3) @@ -757,18 +760,21 @@ program DAMASK_spectral ! print '(a)', '... update stress field P(F*) .....................................' ielem = 0_pInt + temp33_Real = 0.0_pReal do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res(1) ielem = ielem + 1_pInt call CPFEM_general(3_pInt,& ! collect cycle coordinates(i,j,k,1:3), F_lastInc(i,j,k,1:3,1:3),& F_star(i,j,k,1:3,1:3),temperature(i,j,k),timeinc,ielem,1_pInt,& sigma,dsde, P, dPdF) + temp33_Real = temp33_Real + F_real(i,j,k,1:3,1:3) enddo; enddo; enddo + write (*,'(a,/,3(3(es14.7,1x)/))',advance='no') 'F =',& + math_transpose33(temp33_Real*wgt) ielem = 0_pInt err_f = 0.0_pReal F_star_av = 0.0_pReal - P_av =0.0_pReal do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res(1) ielem = ielem + 1_pInt call CPFEM_general(CPFEM_mode,& @@ -776,9 +782,12 @@ program DAMASK_spectral F_star(i,j,k,1:3,1:3),temperature(i,j,k),timeinc,ielem,1_pInt,& sigma,dsde, P,dPdF) CPFEM_mode = 2_pInt ! winding forward - P_av = P_av + P + + if (iter == 1_pInt) lambda(i,j,k,1:3,1:3) = P temp33_Real = lambda(i,j,k,1:3,1:3) - P & + math_mul3333xx33(C_inc0,F_real(i,j,k,1:3,1:3)- F_star(i,j,k,1:3,1:3)) + ! write (*,'(a,/,3(3(es14.7,1x)/))',advance='no') 'F - F* =',& + ! math_transpose33(F_real(i,j,k,1:3,1:3)- F_star(i,j,k,1:3,1:3)) F_star(i,j,k,1:3,1:3) = F_star(i,j,k,1:3,1:3) + & math_mul3333xx33(math_invSym3333(C_inc0 + dPdF), temp33_Real) lambda(i,j,k,1:3,1:3) = lambda(i,j,k,1:3,1:3) + math_mul3333xx33(C_inc0,F_real(i,j,k,1:3,1:3) & @@ -787,9 +796,7 @@ program DAMASK_spectral temp33_real = F_star(i,j,k,1:3,1:3) - F_real(i,j,k,1:3,1:3) err_f = max(err_f, sqrt(math_mul33xx33(temp33_real,temp33_real))) enddo; enddo; enddo - P_av = math_rotate_forward33(P_av * wgt,bc(loadcase)%rotation) - write (*,'(a,/,3(3(es14.7,1x)/))',advance='no') 'P(F*) =',& - math_transpose33(P_av)/1.e6_pReal + F_star_av = F_star_av *wgt write (*,'(a,/,3(3(es14.7,1x)/))',advance='no') 'F* =',& math_transpose33(F_star_av) @@ -832,7 +839,7 @@ program DAMASK_spectral enddo ! end looping when convergency is achieved print '(a)', '' print '(a)', '==================================================================' - if(err_f > err_div_tol .or. err_stress > err_stress_tol) then + if(err_crit > err_div_tol .or. err_stress > err_stress_tol) then print '(A,I5.5,A)', 'increment ', totalIncsCounter, ' NOT converged' notConvergedCounter = notConvergedCounter + 1_pInt else @@ -869,7 +876,7 @@ program DAMASK_spectral close(538) call fftw_destroy_plan(plan_lambda); call fftw_destroy_plan(plan_correction) call quit(0_pInt) -end program DAMASK_spectral +end program DAMASK_spectral_AL !******************************************************************** ! quit subroutine to satisfy IO_error diff --git a/code/FEsolving.f90 b/code/FEsolving.f90 index 2733f1ec4..b130eb65e 100644 --- a/code/FEsolving.f90 +++ b/code/FEsolving.f90 @@ -21,41 +21,46 @@ !############################################################## module FEsolving !############################################################## - use prec, only: pInt,pReal + use prec, only: & + pInt, & + pReal implicit none - integer(pInt) :: & + private + integer(pInt), public :: & cycleCounter = 0_pInt, & theInc = -1_pInt, & restartInc = 1_pInt - real(pReal) :: & + real(pReal), public :: & theTime = 0.0_pReal, & theDelta = 0.0_pReal - logical :: & - lastIncConverged = .false., & - outdatedByNewInc = .false., & + logical, public :: & outdatedFFN1 = .false., & - terminallyIll = .false., & symmetricSolver = .false., & - parallelExecution = .true., & restartWrite = .false., & restartRead = .false., & - lastMode = .true., & - cutBack = .false. - - integer(pInt), dimension(:,:), allocatable :: & + terminallyIll = .false., & + parallelExecution = .true., & + lastMode = .true. + + integer(pInt), dimension(:,:), allocatable, public :: & FEsolving_execIP - integer(pInt), dimension(2) :: & + integer(pInt), dimension(2), public :: & FEsolving_execElem - character(len=1024) :: & + character(len=1024), public :: & FEmodelGeometry - logical, dimension(:,:), allocatable :: & + logical, dimension(:,:), allocatable, public :: & calcMode + + logical, private :: & + lastIncConverged = .false., & + outdatedByNewInc = .false., & + cutBack = .false. public :: FE_init @@ -68,21 +73,26 @@ contains subroutine FE_init use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) - use debug, only: debug_what, & - debug_FEsolving, & - debug_levelBasic - use IO, only: IO_open_inputFile, & - IO_stringPos, & - IO_stringValue, & - IO_intValue, & - IO_lc, & - IO_open_logFile, & - IO_warning + use debug, only: & + debug_what, & + debug_FEsolving, & + debug_levelBasic + + use IO, only: & + IO_open_inputFile, & + IO_stringPos, & + IO_stringValue, & + IO_intValue, & + IO_lc, & + IO_open_logFile, & + IO_warning + use DAMASK_interface implicit none - integer(pInt), parameter :: fileunit = 222_pInt - integer(pInt), parameter :: maxNchunks = 6_pInt + integer(pInt), parameter :: & + fileunit = 222_pInt, & + maxNchunks = 6_pInt integer :: i, start = 0, length ! is save for FE_init (only called once) integer(pInt) :: j diff --git a/code/Makefile b/code/Makefile index 089eb9d7f..877e1b5a5 100644 --- a/code/Makefile +++ b/code/Makefile @@ -343,7 +343,7 @@ DAMASK_spectral_interface.o: DAMASK_spectral_interface.f90 \ prec.o: prec.f90 %.o : %.f90 - $(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) -c $< $(SUFFIX) + $(PREFIX) $(COMPILERNAME) $(COMPILE) -c $< $(SUFFIX) tidy: rm -rf *.o diff --git a/code/config/debug.config b/code/config/debug.config index f51ac54d0..a1c4b89d2 100644 --- a/code/config/debug.config +++ b/code/config/debug.config @@ -12,6 +12,7 @@ crystallite # crystallite.f90 possible keys: basi homogenization # homogenization_*.f90 possible keys: basic, extensive, selective CPFEM # CPFEM.f90 possible keys: basic, selective spectral # DAMASK_spectral.f90 possible keys: basic, fft, restart, divergence +abaqus # ABAQUS FEM solver possible keys: basic # # Parameters for selective element 1 # selected element for debugging (synonymous: "el", "e") diff --git a/code/debug.f90 b/code/debug.f90 index 96eacdb48..671954dc0 100644 --- a/code/debug.f90 +++ b/code/debug.f90 @@ -51,9 +51,10 @@ module debug debug_crystallite = 8_pInt, & debug_homogenization = 9_pInt, & debug_CPFEM = 10_pInt, & - debug_spectral = 11_pInt + debug_spectral = 11_pInt, & + debug_abaqus = 12_pInt - integer(pInt), dimension(11+2), public :: & ! 11 for specific, and 2 for "all" and "other" + integer(pInt), dimension(12+2), public :: & ! 11 for specific, and 2 for "all" and "other" debug_what = 0_pInt integer(pInt), public :: & @@ -193,6 +194,8 @@ subroutine debug_init what = debug_CPFEM case ('spectral') what = debug_spectral + case ('abaqus') + what = debug_abaqus case ('all') what = 12_pInt case ('other') @@ -257,6 +260,7 @@ subroutine debug_init if(i == debug_homogenization) write(6,'(a)') 'Homogenization debugging:' if(i == debug_CPFEM) write(6,'(a)') 'CPFEM debugging:' if(i == debug_spectral) write(6,'(a)') 'Spectral solver debugging:' + if(i == debug_abaqus) write(6,'(a)') 'ABAQUS FEM solver debugging:' if(iand(debug_what(i),debug_levelBasic) /= 0) write(6,'(a)') ' basic' if(iand(debug_what(i),debug_levelExtensive) /= 0) write(6,'(a)') ' extensive' diff --git a/code/lattice.f90 b/code/lattice.f90 index 7defd6780..25836f33c 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -29,528 +29,556 @@ module lattice - use prec, only: pReal,pInt + use prec, only: pReal, & + pInt implicit none + private !************************************ !* Lattice structures * !************************************ - integer(pInt) :: & - lattice_Nhexagonal, & !> # of hexagonal lattice structure (from tag CoverA_ratio) - lattice_Nstructure !> # of lattice structures (1: fcc,2: bcc,3+: hexagonal) - - integer(pInt), parameter :: & + integer(pInt), parameter, public :: & lattice_maxNslipFamily = 5_pInt, & !> max # of slip system families over lattice structures lattice_maxNtwinFamily = 4_pInt, & !> max # of twin system families over lattice structures lattice_maxNslip = 54_pInt, & !> max # of slip systems over lattice structures lattice_maxNtwin = 24_pInt, & !> max # of twin systems over lattice structures lattice_maxNinteraction = 30_pInt !> max # of interaction types (in hardening matrix part) - - integer(pInt), pointer, dimension(:,:) :: & - interactionSlipSlip, & - interactionSlipTwin, & - interactionTwinSlip, & - interactionTwinTwin - - real(pReal), allocatable, dimension(:,:,:,:) :: & - lattice_Sslip ! Schmid matrices, normal, shear direction and d x n of slip systems - - real(pReal), allocatable, dimension(:,:,:) :: & - lattice_Sslip_v, & - lattice_sn, & - lattice_sd, & - lattice_st - -! rotation and Schmid matrices, normal, shear direction and d x n of twin systems - real(pReal), allocatable, dimension(:,:,:,:) :: & - lattice_Qtwin, & - lattice_Stwin - - real(pReal), allocatable, dimension(:,:,:) :: & - lattice_Stwin_v, & - lattice_tn, & - lattice_td, & - lattice_tt - - real(pReal), allocatable, dimension(:,:) :: & - lattice_shearTwin !> characteristic twin shear - - integer(pInt), allocatable, dimension(:,:) :: & + + integer(pInt), allocatable, dimension(:,:), public :: & lattice_NslipSystem, & !> number of slip systems in each family lattice_NtwinSystem !> number of twin systems in each family - integer(pInt), allocatable, dimension(:,:,:) :: & + integer(pInt), allocatable, dimension(:,:,:), public :: & lattice_interactionSlipSlip, & !> interaction type between slip/slip lattice_interactionSlipTwin, & !> interaction type between slip/twin lattice_interactionTwinSlip, & !> interaction type between twin/slip lattice_interactionTwinTwin !> interaction type between twin/twin + real(pReal), allocatable, dimension(:,:,:,:), public :: & + lattice_Sslip !> Schmid matrices, normal, shear direction and d x n of slip systems + + real(pReal), allocatable, dimension(:,:,:), public :: & + lattice_Sslip_v, & + lattice_sn, & + lattice_sd, & + lattice_st + +! rotation and Schmid matrices, normal, shear direction and d x n of twin systems + real(pReal), allocatable, dimension(:,:,:,:), public :: & + lattice_Stwin, & + lattice_Qtwin + + real(pReal), allocatable, dimension(:,:,:), public :: & + lattice_Stwin_v, & + lattice_tn, & + lattice_td, & + lattice_tt + + real(pReal), allocatable, dimension(:,:), public :: & + lattice_shearTwin !> characteristic twin shear + + integer(pInt), private :: & + lattice_Nhexagonal, & !> # of hexagonal lattice structure (from tag CoverA_ratio) + lattice_Nstructure !> # of lattice structures (1: fcc,2: bcc,3+: hexagonal) + + integer(pInt), dimension(:,:), pointer, private :: & + interactionSlipSlip, & + interactionSlipTwin, & + interactionTwinSlip, & + interactionTwinTwin + !============================== fcc (1) ================================= - integer(pInt), parameter, dimension(lattice_maxNslipFamily) :: lattice_fcc_NslipSystem = int([12, 0, 0, 0, 0],pInt) - integer(pInt), parameter, dimension(lattice_maxNtwinFamily) :: lattice_fcc_NtwinSystem = int([12, 0, 0, 0],pInt) - integer(pInt), parameter :: lattice_fcc_Nslip = 12_pInt ! sum(lattice_fcc_NslipSystem) - integer(pInt), parameter :: lattice_fcc_Ntwin = 12_pInt ! sum(lattice_fcc_NtwinSystem) - integer(pInt) :: lattice_fcc_Nstructure = 0_pInt + integer(pInt), dimension(lattice_maxNslipFamily), parameter, private :: & + lattice_fcc_NslipSystem = int([12, 0, 0, 0, 0],pInt) + + integer(pInt), dimension(lattice_maxNtwinFamily), parameter, private :: & + lattice_fcc_NtwinSystem = int([12, 0, 0, 0],pInt) + + integer(pInt), parameter, private :: & + lattice_fcc_Nslip = 12_pInt, & ! sum(lattice_fcc_NslipSystem) + lattice_fcc_Ntwin = 12_pInt ! sum(lattice_fcc_NtwinSystem) + + integer(pInt), private :: & + lattice_fcc_Nstructure = 0_pInt - real(pReal), dimension(3+3,lattice_fcc_Nslip), parameter :: lattice_fcc_systemSlip = & - reshape(real([& -! Slip system <110>{111} Sorted according to Eisenlohr & Hantcherli - 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 & - ],pReal),[ 3_pInt + 3_pInt,lattice_fcc_Nslip]) + real(pReal), dimension(3+3,lattice_fcc_Nslip), parameter, private :: & + lattice_fcc_systemSlip = reshape(real([& + ! Slip system <110>{111} Sorted according to Eisenlohr & Hantcherli + 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 & + ],pReal),[ 3_pInt + 3_pInt,lattice_fcc_Nslip]) - real(pReal), dimension(3+3,lattice_fcc_Ntwin), parameter :: lattice_fcc_systemTwin = & - reshape(real( [& -! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli - -2, 1, 1, 1, 1, 1, & - 1,-2, 1, 1, 1, 1, & - 1, 1,-2, 1, 1, 1, & - 2,-1, 1, -1,-1, 1, & - -1, 2, 1, -1,-1, 1, & - -1,-1,-2, -1,-1, 1, & - -2,-1,-1, 1,-1,-1, & - 1, 2,-1, 1,-1,-1, & - 1,-1, 2, 1,-1,-1, & - 2, 1,-1, -1, 1,-1, & - -1,-2,-1, -1, 1,-1, & - -1, 1, 2, -1, 1,-1 & - ],pReal),[ 3_pInt + 3_pInt ,lattice_fcc_Ntwin]) + real(pReal), dimension(3+3,lattice_fcc_Ntwin), parameter, private :: & + lattice_fcc_systemTwin = reshape(real( [& + ! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli + -2, 1, 1, 1, 1, 1, & + 1,-2, 1, 1, 1, 1, & + 1, 1,-2, 1, 1, 1, & + 2,-1, 1, -1,-1, 1, & + -1, 2, 1, -1,-1, 1, & + -1,-1,-2, -1,-1, 1, & + -2,-1,-1, 1,-1,-1, & + 1, 2,-1, 1,-1,-1, & + 1,-1, 2, 1,-1,-1, & + 2, 1,-1, -1, 1,-1, & + -1,-2,-1, -1, 1,-1, & + -1, 1, 2, -1, 1,-1 & + ],pReal),[ 3_pInt + 3_pInt ,lattice_fcc_Ntwin]) - real(pReal), dimension(lattice_fcc_Ntwin), parameter :: lattice_fcc_shearTwin = & - reshape([& -! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli - 0.7071067812_pReal, & - 0.7071067812_pReal, & - 0.7071067812_pReal, & - 0.7071067812_pReal, & - 0.7071067812_pReal, & - 0.7071067812_pReal, & - 0.7071067812_pReal, & - 0.7071067812_pReal, & - 0.7071067812_pReal, & - 0.7071067812_pReal, & - 0.7071067812_pReal, & - 0.7071067812_pReal & - ],[lattice_fcc_Ntwin]) + real(pReal), dimension(lattice_fcc_Ntwin), parameter, private :: & + lattice_fcc_shearTwin = reshape([& + ! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli + 0.7071067812_pReal, & + 0.7071067812_pReal, & + 0.7071067812_pReal, & + 0.7071067812_pReal, & + 0.7071067812_pReal, & + 0.7071067812_pReal, & + 0.7071067812_pReal, & + 0.7071067812_pReal, & + 0.7071067812_pReal, & + 0.7071067812_pReal, & + 0.7071067812_pReal, & + 0.7071067812_pReal & + ],[lattice_fcc_Ntwin]) - integer(pInt), target, dimension(lattice_fcc_Nslip,lattice_fcc_Nslip) :: lattice_fcc_interactionSlipSlip = & - reshape(int( [& -! Interaction types -! 1 --- self interaction -! 2 --- coplanar interaction -! 3 --- collinear interaction -! 4 --- Hirth locks -! 5 --- glissile junctions -! 6 --- Lomer locks - 1,2,2,4,6,5,3,5,5,4,5,6, & - 2,1,2,6,4,5,5,4,6,5,3,5, & - 2,2,1,5,5,3,5,6,4,6,5,4, & - 4,6,5,1,2,2,4,5,6,3,5,5, & - 6,4,5,2,1,2,5,3,5,5,4,6, & - 5,5,3,2,2,1,6,5,4,5,6,4, & - 3,5,5,4,5,6,1,2,2,4,6,5, & - 5,4,6,5,3,5,2,1,2,6,4,5, & - 5,6,4,6,5,4,2,2,1,5,5,3, & - 4,5,6,3,5,5,4,6,5,1,2,2, & - 5,3,5,5,4,6,6,4,5,2,1,2, & - 6,5,4,5,6,4,5,5,3,2,2,1 & - ],pInt),[lattice_fcc_Nslip,lattice_fcc_Nslip]) + integer(pInt), dimension(lattice_fcc_Nslip,lattice_fcc_Nslip), target, private :: & + lattice_fcc_interactionSlipSlip = reshape(int( [& + ! Interaction types + ! 1 --- self interaction + ! 2 --- coplanar interaction + ! 3 --- collinear interaction + ! 4 --- Hirth locks + ! 5 --- glissile junctions + ! 6 --- Lomer locks + 1,2,2,4,6,5,3,5,5,4,5,6, & + 2,1,2,6,4,5,5,4,6,5,3,5, & + 2,2,1,5,5,3,5,6,4,6,5,4, & + 4,6,5,1,2,2,4,5,6,3,5,5, & + 6,4,5,2,1,2,5,3,5,5,4,6, & + 5,5,3,2,2,1,6,5,4,5,6,4, & + 3,5,5,4,5,6,1,2,2,4,6,5, & + 5,4,6,5,3,5,2,1,2,6,4,5, & + 5,6,4,6,5,4,2,2,1,5,5,3, & + 4,5,6,3,5,5,4,6,5,1,2,2, & + 5,3,5,5,4,6,6,4,5,2,1,2, & + 6,5,4,5,6,4,5,5,3,2,2,1 & + ],pInt),[lattice_fcc_Nslip,lattice_fcc_Nslip]) - integer(pInt), target, dimension(lattice_fcc_Ntwin,lattice_fcc_Nslip) :: lattice_fcc_interactionSlipTwin = & - reshape(int( [& - 1,1,1,2,2,1,1,2,2,2,1,2, & - 1,1,1,2,2,1,1,2,2,2,1,2, & - 1,1,1,2,2,1,1,2,2,2,1,2, & - 2,2,1,1,1,1,2,1,2,1,2,2, & - 2,2,1,1,1,1,2,1,2,1,2,2, & - 2,2,1,1,1,1,2,1,2,1,2,2, & - 1,2,2,2,1,2,1,1,1,2,2,1, & - 1,2,2,2,1,2,1,1,1,2,2,1, & - 1,2,2,2,1,2,1,1,1,2,2,1, & - 2,1,2,1,2,2,2,2,1,1,1,1, & - 2,1,2,1,2,2,2,2,1,1,1,1, & - 2,1,2,1,2,2,2,2,1,1,1,1 & - ],pInt),[lattice_fcc_Ntwin,lattice_fcc_Nslip]) + integer(pInt), dimension(lattice_fcc_Ntwin,lattice_fcc_Nslip), target, private :: & + lattice_fcc_interactionSlipTwin = reshape(int( [& + 1,1,1,2,2,1,1,2,2,2,1,2, & + 1,1,1,2,2,1,1,2,2,2,1,2, & + 1,1,1,2,2,1,1,2,2,2,1,2, & + 2,2,1,1,1,1,2,1,2,1,2,2, & + 2,2,1,1,1,1,2,1,2,1,2,2, & + 2,2,1,1,1,1,2,1,2,1,2,2, & + 1,2,2,2,1,2,1,1,1,2,2,1, & + 1,2,2,2,1,2,1,1,1,2,2,1, & + 1,2,2,2,1,2,1,1,1,2,2,1, & + 2,1,2,1,2,2,2,2,1,1,1,1, & + 2,1,2,1,2,2,2,2,1,1,1,1, & + 2,1,2,1,2,2,2,2,1,1,1,1 & + ],pInt),[lattice_fcc_Ntwin,lattice_fcc_Nslip]) - integer(pInt), target, dimension(lattice_fcc_Nslip,lattice_fcc_Ntwin) :: lattice_fcc_interactionTwinSlip = 0_pInt + integer(pInt), dimension(lattice_fcc_Nslip,lattice_fcc_Ntwin), target, private :: & + lattice_fcc_interactionTwinSlip = 0_pInt - integer(pInt), target, dimension(lattice_fcc_Ntwin,lattice_fcc_Ntwin) :: lattice_fcc_interactionTwinTwin = & - reshape(int( [& - 1,1,1,2,2,2,2,2,2,2,2,2, & - 1,1,1,2,2,2,2,2,2,2,2,2, & - 1,1,1,2,2,2,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1 & - ],pInt),[lattice_fcc_Ntwin,lattice_fcc_Ntwin]) + integer(pInt), dimension(lattice_fcc_Ntwin,lattice_fcc_Ntwin), target, private :: & + lattice_fcc_interactionTwinTwin = reshape(int( [& + 1,1,1,2,2,2,2,2,2,2,2,2, & + 1,1,1,2,2,2,2,2,2,2,2,2, & + 1,1,1,2,2,2,2,2,2,2,2,2, & + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1 & + ],pInt),[lattice_fcc_Ntwin,lattice_fcc_Ntwin]) !============================== bcc (2) ================================= - integer(pInt), parameter, dimension(lattice_maxNslipFamily) :: lattice_bcc_NslipSystem = int([ 12,12,24, 0, 0], pInt) - integer(pInt), parameter, dimension(lattice_maxNtwinFamily) :: lattice_bcc_NtwinSystem = int([ 12, 0, 0, 0], pInt) - integer(pInt), parameter :: lattice_bcc_Nslip = 48_pInt ! sum(lattice_bcc_NslipSystem) - integer(pInt), parameter :: lattice_bcc_Ntwin = 12_pInt ! sum(lattice_bcc_NtwinSystem) - integer(pInt) :: lattice_bcc_Nstructure = 0_pInt + integer(pInt), dimension(lattice_maxNslipFamily), parameter, private :: & + lattice_bcc_NslipSystem = int([ 12,12,24, 0, 0], pInt) + + integer(pInt), dimension(lattice_maxNtwinFamily), parameter, private :: & + lattice_bcc_NtwinSystem = int([ 12, 0, 0, 0], pInt) + + integer(pInt), parameter, private :: & + lattice_bcc_Nslip = 48_pInt ! sum(lattice_bcc_NslipSystem) + + integer(pInt), parameter, private :: & + lattice_bcc_Ntwin = 12_pInt ! sum(lattice_bcc_NtwinSystem) + + integer(pInt), private :: & + lattice_bcc_Nstructure = 0_pInt - real(pReal), dimension(3+3,lattice_bcc_Nslip), parameter :: lattice_bcc_systemSlip = & - reshape(real([& -! Slip system <111>{110} meaningful sorting? - 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, 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, & -! Slip system <111>{112} meaningful sorting ? - -1, 1, 1, 2, 1, 1, & - 1, 1, 1, -2, 1, 1, & - 1, 1,-1, 2,-1, 1, & - 1,-1, 1, 2, 1,-1, & - 1,-1, 1, 1, 2, 1, & - 1, 1,-1, -1, 2, 1, & - 1, 1, 1, 1,-2, 1, & - -1, 1, 1, 1, 2,-1, & - 1, 1,-1, 1, 1, 2, & - 1,-1, 1, -1, 1, 2, & - -1, 1, 1, 1,-1, 2, & - 1, 1, 1, 1, 1,-2, & -! Slip system <111>{123} meaningful sorting ? - 1, 1,-1, 1, 2, 3, & - 1,-1, 1, -1, 2, 3, & - -1, 1, 1, 1,-2, 3, & - 1, 1, 1, 1, 2,-3, & - 1,-1, 1, 1, 3, 2, & - 1, 1,-1, -1, 3, 2, & - 1, 1, 1, 1,-3, 2, & - -1, 1, 1, 1, 3,-2, & - 1, 1,-1, 2, 1, 3, & - 1,-1, 1, -2, 1, 3, & - -1, 1, 1, 2,-1, 3, & - 1, 1, 1, 2, 1,-3, & - 1,-1, 1, 2, 3, 1, & - 1, 1,-1, -2, 3, 1, & - 1, 1, 1, 2,-3, 1, & - -1, 1, 1, 2, 3,-1, & - -1, 1, 1, 3, 1, 2, & - 1, 1, 1, -3, 1, 2, & - 1, 1,-1, 3,-1, 2, & - 1,-1, 1, 3, 1,-2, & - -1, 1, 1, 3, 2, 1, & - 1, 1, 1, -3, 2, 1, & - 1, 1,-1, 3,-2, 1, & - 1,-1, 1, 3, 2,-1 & - ],pReal),[ 3_pInt + 3_pInt ,lattice_bcc_Nslip]) + real(pReal), dimension(3+3,lattice_bcc_Nslip), parameter, private :: & + lattice_bcc_systemSlip = reshape(real([& + ! Slip system <111>{110} meaningful sorting? + 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, 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, & + ! Slip system <111>{112} meaningful sorting ? + -1, 1, 1, 2, 1, 1, & + 1, 1, 1, -2, 1, 1, & + 1, 1,-1, 2,-1, 1, & + 1,-1, 1, 2, 1,-1, & + 1,-1, 1, 1, 2, 1, & + 1, 1,-1, -1, 2, 1, & + 1, 1, 1, 1,-2, 1, & + -1, 1, 1, 1, 2,-1, & + 1, 1,-1, 1, 1, 2, & + 1,-1, 1, -1, 1, 2, & + -1, 1, 1, 1,-1, 2, & + 1, 1, 1, 1, 1,-2, & + ! Slip system <111>{123} meaningful sorting ? + 1, 1,-1, 1, 2, 3, & + 1,-1, 1, -1, 2, 3, & + -1, 1, 1, 1,-2, 3, & + 1, 1, 1, 1, 2,-3, & + 1,-1, 1, 1, 3, 2, & + 1, 1,-1, -1, 3, 2, & + 1, 1, 1, 1,-3, 2, & + -1, 1, 1, 1, 3,-2, & + 1, 1,-1, 2, 1, 3, & + 1,-1, 1, -2, 1, 3, & + -1, 1, 1, 2,-1, 3, & + 1, 1, 1, 2, 1,-3, & + 1,-1, 1, 2, 3, 1, & + 1, 1,-1, -2, 3, 1, & + 1, 1, 1, 2,-3, 1, & + -1, 1, 1, 2, 3,-1, & + -1, 1, 1, 3, 1, 2, & + 1, 1, 1, -3, 1, 2, & + 1, 1,-1, 3,-1, 2, & + 1,-1, 1, 3, 1,-2, & + -1, 1, 1, 3, 2, 1, & + 1, 1, 1, -3, 2, 1, & + 1, 1,-1, 3,-2, 1, & + 1,-1, 1, 3, 2,-1 & + ],pReal),[ 3_pInt + 3_pInt ,lattice_bcc_Nslip]) ! twin system <111>{112} ! MISSING: not implemented yet -- now dummy copy from fcc !! - real(pReal), dimension(3+3,lattice_bcc_Ntwin), parameter :: lattice_bcc_systemTwin = & - reshape(real([& -! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli - -2, 1, 1, 1, 1, 1, & - 1,-2, 1, 1, 1, 1, & - 1, 1,-2, 1, 1, 1, & - 2,-1, 1, -1,-1, 1, & - -1, 2, 1, -1,-1, 1, & - -1,-1,-2, -1,-1, 1, & - -2,-1,-1, 1,-1,-1, & - 1, 2,-1, 1,-1,-1, & - 1,-1, 2, 1,-1,-1, & - 2, 1,-1, -1, 1,-1, & - -1,-2,-1, -1, 1,-1, & - -1, 1, 2, -1, 1,-1 & - ],pReal),[ 3_pInt + 3_pInt,lattice_bcc_Ntwin]) + real(pReal), dimension(3+3,lattice_bcc_Ntwin), parameter, private :: & + lattice_bcc_systemTwin = reshape(real([& + ! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli + -2, 1, 1, 1, 1, 1, & + 1,-2, 1, 1, 1, 1, & + 1, 1,-2, 1, 1, 1, & + 2,-1, 1, -1,-1, 1, & + -1, 2, 1, -1,-1, 1, & + -1,-1,-2, -1,-1, 1, & + -2,-1,-1, 1,-1,-1, & + 1, 2,-1, 1,-1,-1, & + 1,-1, 2, 1,-1,-1, & + 2, 1,-1, -1, 1,-1, & + -1,-2,-1, -1, 1,-1, & + -1, 1, 2, -1, 1,-1 & + ],pReal),[ 3_pInt + 3_pInt,lattice_bcc_Ntwin]) - real(pReal), dimension(lattice_bcc_Ntwin), parameter :: lattice_bcc_shearTwin = & - reshape([& -! Twin system {111}<112> just a dummy - 0.123_pReal, & - 0.123_pReal, & - 0.123_pReal, & - 0.123_pReal, & - 0.123_pReal, & - 0.123_pReal, & - 0.123_pReal, & - 0.123_pReal, & - 0.123_pReal, & - 0.123_pReal, & - 0.123_pReal, & - 0.123_pReal & - ],[lattice_bcc_Ntwin]) + real(pReal), dimension(lattice_bcc_Ntwin), parameter, private :: & + lattice_bcc_shearTwin = reshape([& + ! Twin system {111}<112> just a dummy + 0.123_pReal, & + 0.123_pReal, & + 0.123_pReal, & + 0.123_pReal, & + 0.123_pReal, & + 0.123_pReal, & + 0.123_pReal, & + 0.123_pReal, & + 0.123_pReal, & + 0.123_pReal, & + 0.123_pReal, & + 0.123_pReal & + ],[lattice_bcc_Ntwin]) !*** slip--slip interactions for BCC structures (2) *** - integer(pInt), target, dimension(lattice_bcc_Nslip,lattice_bcc_Nslip) :: lattice_bcc_interactionSlipSlip = & - reshape(int( [& - 1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2, & - 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1 & - ],pInt),[lattice_bcc_Nslip,lattice_bcc_Nslip]) + integer(pInt), dimension(lattice_bcc_Nslip,lattice_bcc_Nslip), target, private :: & + lattice_bcc_interactionSlipSlip = reshape(int( [& + 1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1 & + ],pInt),[lattice_bcc_Nslip,lattice_bcc_Nslip]) !*** slip--twin interactions for BCC structures (2) *** ! MISSING: not implemented yet - integer(pInt), target, dimension(lattice_bcc_Ntwin,lattice_bcc_Nslip) :: lattice_bcc_interactionSlipTwin = & - reshape(int( [& - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0 & - ],pInt),[lattice_bcc_Ntwin,lattice_bcc_Nslip]) + integer(pInt), dimension(lattice_bcc_Ntwin,lattice_bcc_Nslip), target, private :: & + lattice_bcc_interactionSlipTwin = reshape(int( [& + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0 & + ],pInt),[lattice_bcc_Ntwin,lattice_bcc_Nslip]) !*** twin--slip interactions for BCC structures (2) *** ! MISSING: not implemented yet - integer(pInt), target, dimension(lattice_bcc_Nslip,lattice_bcc_Ntwin) :: lattice_bcc_interactionTwinSlip = & - reshape(int( [& - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 & - ],pInt),[lattice_bcc_Nslip,lattice_bcc_Ntwin]) + integer(pInt), dimension(lattice_bcc_Nslip,lattice_bcc_Ntwin), target, private :: & + lattice_bcc_interactionTwinSlip = reshape(int( [& + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 & + ],pInt),[lattice_bcc_Nslip,lattice_bcc_Ntwin]) !*** twin-twin interactions for BCC structures (2) *** ! MISSING: not implemented yet - integer(pInt), target, dimension(lattice_bcc_Ntwin,lattice_bcc_Ntwin) :: lattice_bcc_interactionTwinTwin = & - reshape(int( [& - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,0,0 & - ],pInt),[lattice_bcc_Ntwin,lattice_bcc_Ntwin]) + integer(pInt), dimension(lattice_bcc_Ntwin,lattice_bcc_Ntwin), target, private :: & + lattice_bcc_interactionTwinTwin = reshape(int( [& + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0 & + ],pInt),[lattice_bcc_Ntwin,lattice_bcc_Ntwin]) !============================== hex (3+) ================================= - integer(pInt), parameter, dimension(lattice_maxNslipFamily) :: lattice_hex_NslipSystem = int([ 3, 3, 6,12, 6],pInt) - integer(pInt), parameter, dimension(lattice_maxNtwinFamily) :: lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt) - integer(pInt), parameter :: lattice_hex_Nslip = 30_pInt ! sum(lattice_hex_NslipSystem) - integer(pInt), parameter :: lattice_hex_Ntwin = 24_pInt ! sum(lattice_hex_NtwinSystem) - integer(pInt) :: lattice_hex_Nstructure = 0_pInt + integer(pInt), dimension(lattice_maxNslipFamily), parameter, private :: & + lattice_hex_NslipSystem = int([ 3, 3, 6,12, 6],pInt) + + integer(pInt), dimension(lattice_maxNtwinFamily), parameter, private :: & + lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt) + + integer(pInt), parameter , private :: & + lattice_hex_Nslip = 30_pInt ! sum(lattice_hex_NslipSystem) + + integer(pInt), parameter, private :: & + lattice_hex_Ntwin = 24_pInt ! sum(lattice_hex_NtwinSystem) + + integer(pInt), private :: & + lattice_hex_Nstructure = 0_pInt !* sorted by A. Alankar & P. Eisenlohr - real(pReal), dimension(4+4,lattice_hex_Nslip), parameter :: lattice_hex_systemSlip = & - reshape(real([& -! Basal systems <1120>{0001} (independent of c/a-ratio, Bravais notation (4 coordinate base)) - 2, -1, -1, 0, 0, 0, 0, 1, & - -1, 2, -1, 0, 0, 0, 0, 1, & - -1, -1, 2, 0, 0, 0, 0, 1, & -! 1st type prismatic systems <1120>{1010} (independent of c/a-ratio) - 2, -1, -1, 0, 0, 1, -1, 0, & - -1, 2, -1, 0, -1, 0, 1, 0, & - -1, -1, 2, 0, 1, -1, 0, 0, & -! 1st type 1st order pyramidal systems <1120>{1011} -- plane normals depend on the c/a-ratio - 2, -1, -1, 0, 0, 1, -1, 1, & - 1, 1, -2, 0, -1, 1, 0, 1, & - -1, 2, -1, 0, -1, 0, 1, 1, & - -2, 1, 1, 0, 0, -1, 1, 1, & - -1, -1, 2, 0, 1, -1, 0, 1, & - 1, -2, 1, 0, 1, 0, -1, 1, & -! pyramidal system: c+a slip <2113>{1011} -- plane normals depend on the c/a-ratio - -1, 2, -1, 3, 0, 1, -1, 1, & - 1, 1, -2, 3, 0, 1, -1, 1, & - -2, 1, 1, 3, -1, 1, 0, 1, & - -1, 2, -1, 3, -1, 1, 0, 1, & - -1, -1, 2, 3, -1, 0, 1, 1, & - -2, 1, 1, 3, -1, 0, 1, 1, & - 1, -2, 1, 3, 0, -1, 1, 1, & - -1, -1, 2, 3, 0, -1, 1, 1, & - 2, -1, -1, 3, 1, -1, 0, 1, & - 1, -2, 1, 3, 1, -1, 0, 1, & - 1, 1, -2, 3, 1, 0, -1, 1, & - 2, -1, -1, 3, 1, 0, -1, 1, & -! pyramidal system: c+a slip <11-2-3>{11-22} -- as for hexagonal Ice (Castelnau et al 1996, similar to twin system found below) - 2, -1, -1, -3, 2, -1, -1, 2, & ! <11.-3>{11.2} shear = 2((c/a)^2-2)/(3 c/a) - 1, 1, -2, -3, 1, 1, -2, 2, & ! not sorted, just copied from twin system - -1, 2, -1, -3, -1, 2, -1, 2, & - -2, 1, 1, -3, -2, 1, 1, 2, & - -1, -1, 2, -3, -1, -1, 2, 2, & - 1, -2, 1, -3, 1, -2, 1, 2 & - ],pReal),[ 4_pInt + 4_pInt,lattice_hex_Nslip]) + real(pReal), dimension(4+4,lattice_hex_Nslip), parameter, private :: & + lattice_hex_systemSlip = reshape(real([& + ! Basal systems <1120>{0001} (independent of c/a-ratio, Bravais notation (4 coordinate base)) + 2, -1, -1, 0, 0, 0, 0, 1, & + -1, 2, -1, 0, 0, 0, 0, 1, & + -1, -1, 2, 0, 0, 0, 0, 1, & + ! 1st type prismatic systems <1120>{1010} (independent of c/a-ratio) + 2, -1, -1, 0, 0, 1, -1, 0, & + -1, 2, -1, 0, -1, 0, 1, 0, & + -1, -1, 2, 0, 1, -1, 0, 0, & + ! 1st type 1st order pyramidal systems <1120>{1011} -- plane normals depend on the c/a-ratio + 2, -1, -1, 0, 0, 1, -1, 1, & + 1, 1, -2, 0, -1, 1, 0, 1, & + -1, 2, -1, 0, -1, 0, 1, 1, & + -2, 1, 1, 0, 0, -1, 1, 1, & + -1, -1, 2, 0, 1, -1, 0, 1, & + 1, -2, 1, 0, 1, 0, -1, 1, & + ! pyramidal system: c+a slip <2113>{1011} -- plane normals depend on the c/a-ratio + -1, 2, -1, 3, 0, 1, -1, 1, & + 1, 1, -2, 3, 0, 1, -1, 1, & + -2, 1, 1, 3, -1, 1, 0, 1, & + -1, 2, -1, 3, -1, 1, 0, 1, & + -1, -1, 2, 3, -1, 0, 1, 1, & + -2, 1, 1, 3, -1, 0, 1, 1, & + 1, -2, 1, 3, 0, -1, 1, 1, & + -1, -1, 2, 3, 0, -1, 1, 1, & + 2, -1, -1, 3, 1, -1, 0, 1, & + 1, -2, 1, 3, 1, -1, 0, 1, & + 1, 1, -2, 3, 1, 0, -1, 1, & + 2, -1, -1, 3, 1, 0, -1, 1, & + ! pyramidal system: c+a slip <11-2-3>{11-22} -- as for hexagonal Ice (Castelnau et al 1996, similar to twin system found below) + 2, -1, -1, -3, 2, -1, -1, 2, & ! <11.-3>{11.2} shear = 2((c/a)^2-2)/(3 c/a) + 1, 1, -2, -3, 1, 1, -2, 2, & ! not sorted, just copied from twin system + -1, 2, -1, -3, -1, 2, -1, 2, & + -2, 1, 1, -3, -2, 1, 1, 2, & + -1, -1, 2, -3, -1, -1, 2, 2, & + 1, -2, 1, -3, 1, -2, 1, 2 & + ],pReal),[ 4_pInt + 4_pInt,lattice_hex_Nslip]) - real(pReal), dimension(4+4,lattice_hex_Ntwin), parameter :: lattice_hex_systemTwin = & - reshape(real([& - 0, 1, -1, 1, 0, -1, 1, 2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a) - -1, 1, 0, 1, 1, -1, 0, 2, & - -1, 0, 1, 1, 1, 0, -1, 2, & !! - 0, -1, 1, 1, 0, 1, -1, 2, & - 1, -1, 0, 1, -1, 1, 0, 2, & - 1, 0, -1, 1, -1, 0, 1, 2, & - 2, -1, -1, -3, 2, -1, -1, 2, & ! <11.-3>{11.2} shear = 2((c/a)^2-2)/(3 c/a) - 1, 1, -2, -3, 1, 1, -2, 2, & !! - -1, 2, -1, -3, -1, 2, -1, 2, & - -2, 1, 1, -3, -2, 1, 1, 2, & - -1, -1, 2, -3, -1, -1, 2, 2, & - 1, -2, 1, -3, 1, -2, 1, 2, & - -2, 1, 1, 6, 2, -1, -1, 1, & ! <-1-1.6>{11.1} shear = 1/(c/a) - -1, -1, 2, 6, 1, 1, -2, 1, & !! - 1, -2, 1, 6, -1, 2, -1, 1, & - 2, -1, -1, 6, -2, 1, 1, 1, & - 1, 1, -2, 6, -1, -1, 2, 1, & - -1, 2, -1, 6, 1, -2, 1, 1, & - 1, 0, -1, -2, 1, 0, -1, 1, & !! <10.-2>{10.1} shear = (4(c/a)^2-9)/(4 sqrt(3) c/a) - -1, 0, 1, -2, -1, 0, 1, 1, & - 0, 1, -1, -2, 0, 1, -1, 1, & - 0, -1, 1, -2, 0, -1, 1, 1, & - 1, -1, 0, -2, 1, -1, 0, 1, & - -1, 1, 0, -2, -1, 1, 0, 1 & - ],pReal),[ 4_pInt + 4_pInt ,lattice_hex_Ntwin]) !* Sort? Numbering of twin system follows Prof. Tom Bieler's scheme (to be consistent with his work); but numbering in data was restarted from 1 & + real(pReal), dimension(4+4,lattice_hex_Ntwin), parameter, private :: & + lattice_hex_systemTwin = reshape(real([& + 0, 1, -1, 1, 0, -1, 1, 2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a) + -1, 1, 0, 1, 1, -1, 0, 2, & + -1, 0, 1, 1, 1, 0, -1, 2, & !! + 0, -1, 1, 1, 0, 1, -1, 2, & + 1, -1, 0, 1, -1, 1, 0, 2, & + 1, 0, -1, 1, -1, 0, 1, 2, & + 2, -1, -1, -3, 2, -1, -1, 2, & ! <11.-3>{11.2} shear = 2((c/a)^2-2)/(3 c/a) + 1, 1, -2, -3, 1, 1, -2, 2, & !! + -1, 2, -1, -3, -1, 2, -1, 2, & + -2, 1, 1, -3, -2, 1, 1, 2, & + -1, -1, 2, -3, -1, -1, 2, 2, & + 1, -2, 1, -3, 1, -2, 1, 2, & + -2, 1, 1, 6, 2, -1, -1, 1, & ! <-1-1.6>{11.1} shear = 1/(c/a) + -1, -1, 2, 6, 1, 1, -2, 1, & !! + 1, -2, 1, 6, -1, 2, -1, 1, & + 2, -1, -1, 6, -2, 1, 1, 1, & + 1, 1, -2, 6, -1, -1, 2, 1, & + -1, 2, -1, 6, 1, -2, 1, 1, & + 1, 0, -1, -2, 1, 0, -1, 1, & !! <10.-2>{10.1} shear = (4(c/a)^2-9)/(4 sqrt(3) c/a) + -1, 0, 1, -2, -1, 0, 1, 1, & + 0, 1, -1, -2, 0, 1, -1, 1, & + 0, -1, 1, -2, 0, -1, 1, 1, & + 1, -1, 0, -2, 1, -1, 0, 1, & + -1, 1, 0, -2, -1, 1, 0, 1 & + ],pReal),[ 4_pInt + 4_pInt ,lattice_hex_Ntwin]) !* Sort? Numbering of twin system follows Prof. Tom Bieler's scheme (to be consistent with his work); but numbering in data was restarted from 1 & - integer(pInt), dimension(lattice_hex_Ntwin), parameter :: lattice_hex_shearTwin = & ! indicator to formula further below - reshape(int( [& - 1, & ! {10.2}<-10.1> - 1, & - 1, & - 1, & - 1, & - 1, & - 2, & ! {11.2}<11.-3> - 2, & - 2, & - 2, & - 2, & - 2, & - 3, & ! {11.1}<-1-1.6> - 3, & - 3, & - 3, & - 3, & - 3, & - 4, & ! {10.1}<10.-2> - 4, & - 4, & - 4, & - 4, & - 4 & - ],pInt),[lattice_hex_Ntwin]) + integer(pInt), dimension(lattice_hex_Ntwin), parameter, private :: & + lattice_hex_shearTwin = reshape(int( [& ! indicator to formula further below + 1, & ! {10.2}<-10.1> + 1, & + 1, & + 1, & + 1, & + 1, & + 2, & ! {11.2}<11.-3> + 2, & + 2, & + 2, & + 2, & + 2, & + 3, & ! {11.1}<-1-1.6> + 3, & + 3, & + 3, & + 3, & + 3, & + 4, & ! {10.1}<10.-2> + 4, & + 4, & + 4, & + 4, & + 4 & + ],pInt),[lattice_hex_Ntwin]) !* four different interaction type matrix !* 1. slip-slip interaction - 30 types @@ -558,153 +586,153 @@ module lattice !* 3. twin-twin interaction - 20 types !* 4. twin-slip interaction - 16 types - integer(pInt), target, dimension(lattice_hex_Nslip,lattice_hex_Nslip) :: lattice_hex_interactionSlipSlip = & - reshape(int( [& - 1, 6, 6, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, & - 6, 1, 6, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, & - 6, 6, 1, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, & -! - 21,21,21, 2, 7, 7, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 19,19,19,19,19,19, & - 21,21,21, 7, 2, 7, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 19,19,19,19,19,19, & - 21,21,21, 7, 7, 2, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 19,19,19,19,19,19, & -! - 25,25,25, 22,22,22, 3, 8, 8, 8, 8, 8, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & - 25,25,25, 22,22,22, 8, 3, 8, 8, 8, 8, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & - 25,25,25, 22,22,22, 8, 8, 3, 8, 8, 8, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & - 25,25,25, 22,22,22, 8, 8, 8, 3, 8, 8, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & - 25,25,25, 22,22,22, 8, 8, 8, 8, 3, 8, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & - 25,25,25, 22,22,22, 8, 8, 8, 8, 8, 3, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & -! - 28,28,28, 26,26,26, 23,23,23,23,23,23, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 4, 9, 9, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 4, 9, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 4, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 4, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 9, 4, 9, 9, 9, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 9, 9, 4, 9, 9, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 9, 9, 9, 4, 9, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 4, 9, 14,14,14,14,14,14, & - 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 4, 14,14,14,14,14,14, & -! - 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 5,10,10,10,10,10, & - 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10, 5,10,10,10,10, & - 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10, 5,10,10,10, & - 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10, 5,10,10, & - 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10,10, 5,10, & - 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10,10,10, 5 & - ],pInt),[lattice_hex_Nslip,lattice_hex_Nslip]) + integer(pInt), dimension(lattice_hex_Nslip,lattice_hex_Nslip), target, private :: & + lattice_hex_interactionSlipSlip = reshape(int( [& + 1, 6, 6, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, & + 6, 1, 6, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, & + 6, 6, 1, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, & + ! + 21,21,21, 2, 7, 7, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 19,19,19,19,19,19, & + 21,21,21, 7, 2, 7, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 19,19,19,19,19,19, & + 21,21,21, 7, 7, 2, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 19,19,19,19,19,19, & + ! + 25,25,25, 22,22,22, 3, 8, 8, 8, 8, 8, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & + 25,25,25, 22,22,22, 8, 3, 8, 8, 8, 8, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & + 25,25,25, 22,22,22, 8, 8, 3, 8, 8, 8, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & + 25,25,25, 22,22,22, 8, 8, 8, 3, 8, 8, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & + 25,25,25, 22,22,22, 8, 8, 8, 8, 3, 8, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & + 25,25,25, 22,22,22, 8, 8, 8, 8, 8, 3, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & + ! + 28,28,28, 26,26,26, 23,23,23,23,23,23, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 4, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 4, 9, 9, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 4, 9, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 4, 9, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 4, 9, 9, 9, 9, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 9, 4, 9, 9, 9, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 9, 9, 4, 9, 9, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 9, 9, 9, 4, 9, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 4, 9, 14,14,14,14,14,14, & + 28,28,28, 26,26,26, 23,23,23,23,23,23, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 4, 14,14,14,14,14,14, & + ! + 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 5,10,10,10,10,10, & + 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10, 5,10,10,10,10, & + 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10, 5,10,10,10, & + 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10, 5,10,10, & + 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10,10, 5,10, & + 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10,10,10, 5 & + ],pInt),[lattice_hex_Nslip,lattice_hex_Nslip]) !* isotropic interaction at the moment - integer(pInt), target, dimension(lattice_hex_Ntwin,lattice_hex_Nslip) :: lattice_hex_interactionSlipTwin = & - reshape(int( [& - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! --> twin - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | -! v - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & ! slip - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & -! - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & -! - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & -! - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20 & - ],pInt),[lattice_hex_Ntwin,lattice_hex_Nslip]) + integer(pInt), dimension(lattice_hex_Ntwin,lattice_hex_Nslip), target, private :: & + lattice_hex_interactionSlipTwin = reshape(int( [& + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! --> twin + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | + ! v + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & ! slip + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & + ! + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + ! + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + ! + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20 & + ],pInt),[lattice_hex_Ntwin,lattice_hex_Nslip]) !* isotropic interaction at the moment - integer(pInt), target, dimension(lattice_hex_Nslip,lattice_hex_Ntwin) :: lattice_hex_interactionTwinSlip = & - reshape(int( [& - 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! --> slip - 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! | - 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! | - 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! v - 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! twin - 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & -! - 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & - 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & - 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & - 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & - 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & - 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & -! - 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & - 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & - 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & - 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & - 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & - 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & -! - 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & - 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & - 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & - 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & - 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & - 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20 & - ],pInt),[lattice_hex_Nslip,lattice_hex_Ntwin]) + integer(pInt), dimension(lattice_hex_Nslip,lattice_hex_Ntwin), target, private :: & + lattice_hex_interactionTwinSlip = reshape(int( [& + 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! --> slip + 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! | + 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! | + 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! v + 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! twin + 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & + ! + 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & + 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & + 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & + 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & + 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & + 2, 2, 2, 6, 6, 6, 10,10,10,10,10,10, 14,14,14,14,14,14,14,14,14,14,14,14, 18,18,18,18,18,18, & + ! + 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & + 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & + 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & + 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & + 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & + 3, 3, 3, 7, 7, 7, 11,11,11,11,11,11, 15,15,15,15,15,15,15,15,15,15,15,15, 19,19,19,19,19,19, & + ! + 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & + 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & + 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & + 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & + 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & + 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20 & + ],pInt),[lattice_hex_Nslip,lattice_hex_Ntwin]) - integer(pInt), target, dimension(lattice_hex_Ntwin,lattice_hex_Ntwin) :: lattice_hex_interactionTwinTwin = & - reshape(int( [& - 1, 5, 5, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & - 5, 1, 5, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & - 5, 5, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & - 5, 5, 5, 1, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & - 5, 5, 5, 5, 1, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & - 5, 5, 5, 5, 5, 1, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & -! - 15,15,15,15,15,15, 2, 6, 6, 6, 6, 6, 10,10,10,10,10,10, 13,13,13,13,13,13, & - 15,15,15,15,15,15, 6, 2, 6, 6, 6, 6, 10,10,10,10,10,10, 13,13,13,13,13,13, & - 15,15,15,15,15,15, 6, 6, 2, 6, 6, 6, 10,10,10,10,10,10, 13,13,13,13,13,13, & - 15,15,15,15,15,15, 6, 6, 6, 2, 6, 6, 10,10,10,10,10,10, 13,13,13,13,13,13, & - 15,15,15,15,15,15, 6, 6, 6, 6, 2, 6, 10,10,10,10,10,10, 13,13,13,13,13,13, & - 15,15,15,15,15,15, 6, 6, 6, 6, 6, 2, 10,10,10,10,10,10, 13,13,13,13,13,13, & -! - 18,18,18,18,18,18, 16,16,16,16,16,16, 3, 7, 7, 7, 7, 7, 11,11,11,11,11,11, & - 18,18,18,18,18,18, 16,16,16,16,16,16, 7, 3, 7, 7, 7, 7, 11,11,11,11,11,11, & - 18,18,18,18,18,18, 16,16,16,16,16,16, 7, 7, 3, 7, 7, 7, 11,11,11,11,11,11, & - 18,18,18,18,18,18, 16,16,16,16,16,16, 7, 7, 7, 3, 7, 7, 11,11,11,11,11,11, & - 18,18,18,18,18,18, 16,16,16,16,16,16, 7, 7, 7, 7, 3, 7, 11,11,11,11,11,11, & - 18,18,18,18,18,18, 16,16,16,16,16,16, 7, 7, 7, 7, 7, 3, 11,11,11,11,11,11, & -! - 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 4, 8, 8, 8, 8, 8, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 4, 8, 8, 8, 8, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 4, 8, 8, 8, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 4, 8, 8, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 8, 4, 8, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 8, 8, 4 & - ],pInt),[lattice_hex_Ntwin,lattice_hex_Ntwin]) + integer(pInt), dimension(lattice_hex_Ntwin,lattice_hex_Ntwin), target, private :: & + lattice_hex_interactionTwinTwin = reshape(int( [& + 1, 5, 5, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & + 5, 1, 5, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & + 5, 5, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & + 5, 5, 5, 1, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & + 5, 5, 5, 5, 1, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & + 5, 5, 5, 5, 5, 1, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & + ! + 15,15,15,15,15,15, 2, 6, 6, 6, 6, 6, 10,10,10,10,10,10, 13,13,13,13,13,13, & + 15,15,15,15,15,15, 6, 2, 6, 6, 6, 6, 10,10,10,10,10,10, 13,13,13,13,13,13, & + 15,15,15,15,15,15, 6, 6, 2, 6, 6, 6, 10,10,10,10,10,10, 13,13,13,13,13,13, & + 15,15,15,15,15,15, 6, 6, 6, 2, 6, 6, 10,10,10,10,10,10, 13,13,13,13,13,13, & + 15,15,15,15,15,15, 6, 6, 6, 6, 2, 6, 10,10,10,10,10,10, 13,13,13,13,13,13, & + 15,15,15,15,15,15, 6, 6, 6, 6, 6, 2, 10,10,10,10,10,10, 13,13,13,13,13,13, & + ! + 18,18,18,18,18,18, 16,16,16,16,16,16, 3, 7, 7, 7, 7, 7, 11,11,11,11,11,11, & + 18,18,18,18,18,18, 16,16,16,16,16,16, 7, 3, 7, 7, 7, 7, 11,11,11,11,11,11, & + 18,18,18,18,18,18, 16,16,16,16,16,16, 7, 7, 3, 7, 7, 7, 11,11,11,11,11,11, & + 18,18,18,18,18,18, 16,16,16,16,16,16, 7, 7, 7, 3, 7, 7, 11,11,11,11,11,11, & + 18,18,18,18,18,18, 16,16,16,16,16,16, 7, 7, 7, 7, 3, 7, 11,11,11,11,11,11, & + 18,18,18,18,18,18, 16,16,16,16,16,16, 7, 7, 7, 7, 7, 3, 11,11,11,11,11,11, & + ! + 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 4, 8, 8, 8, 8, 8, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 4, 8, 8, 8, 8, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 4, 8, 8, 8, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 4, 8, 8, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 8, 4, 8, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 8, 8, 4 & + ],pInt),[lattice_hex_Ntwin,lattice_hex_Ntwin]) + public :: & + lattice_init, & + lattice_initializeStructure, & + lattice_symmetryType -CONTAINS -!**************************************** -!* - lattice_init -!* - lattice_initializeStructure -!**************************************** +contains integer(pInt) pure function lattice_symmetryType(structID) !************************************** @@ -792,10 +820,14 @@ subroutine lattice_init allocate(lattice_NslipSystem(lattice_maxNslipFamily,lattice_Nstructure)); lattice_NslipSystem = 0_pInt allocate(lattice_NtwinSystem(lattice_maxNtwinFamily,lattice_Nstructure)); lattice_NtwinSystem = 0_pInt - allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,lattice_Nstructure)); lattice_interactionSlipSlip = 0_pInt ! other:me - allocate(lattice_interactionSlipTwin(lattice_maxNtwin,lattice_maxNslip,lattice_Nstructure)); lattice_interactionSlipTwin = 0_pInt ! other:me - allocate(lattice_interactionTwinSlip(lattice_maxNslip,lattice_maxNtwin,lattice_Nstructure)); lattice_interactionTwinSlip = 0_pInt ! other:me - allocate(lattice_interactionTwinTwin(lattice_maxNtwin,lattice_maxNtwin,lattice_Nstructure)); lattice_interactionTwinTwin = 0_pInt ! other:me + allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,lattice_Nstructure)) + lattice_interactionSlipSlip = 0_pInt ! other:me + allocate(lattice_interactionSlipTwin(lattice_maxNtwin,lattice_maxNslip,lattice_Nstructure)) + lattice_interactionSlipTwin = 0_pInt ! other:me + allocate(lattice_interactionTwinSlip(lattice_maxNslip,lattice_maxNtwin,lattice_Nstructure)) + lattice_interactionTwinSlip = 0_pInt ! other:me + allocate(lattice_interactionTwinTwin(lattice_maxNtwin,lattice_maxNtwin,lattice_Nstructure)) + lattice_interactionTwinTwin = 0_pInt ! other:me end subroutine lattice_init diff --git a/code/numerics.f90 b/code/numerics.f90 index f02b33bce..4d86be95f 100644 --- a/code/numerics.f90 +++ b/code/numerics.f90 @@ -288,67 +288,67 @@ subroutine numerics_init !$OMP CRITICAL (write2out) - write(6,'(a24,1x,e8.1)') ' relevantStrain: ',relevantStrain - write(6,'(a24,1x,e8.1)') ' defgradTolerance: ',defgradTolerance - write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness - write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum - write(6,'(a24,1x,e8.1)') ' pert_Fg: ',pert_Fg - write(6,'(a24,1x,i8)') ' pert_method: ',pert_method - write(6,'(a24,1x,i8)') ' nCryst: ',nCryst - write(6,'(a24,1x,e8.1)') ' subStepMinCryst: ',subStepMinCryst - write(6,'(a24,1x,e8.1)') ' subStepSizeCryst: ',subStepSizeCryst - write(6,'(a24,1x,e8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst - write(6,'(a24,1x,i8)') ' nState: ',nState - write(6,'(a24,1x,i8)') ' nStress: ',nStress - write(6,'(a24,1x,e8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState - write(6,'(a24,1x,e8.1)') ' rTol_crystalliteTemp: ',rTol_crystalliteTemperature - write(6,'(a24,1x,e8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress - write(6,'(a24,1x,e8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress - write(6,'(a24,2(1x,i8))')' integrator: ',numerics_integrator - write(6,'(a24,1x,L8,/)') ' analytic Jacobian: ',analyticJaco + write(6,'(a24,1x,es8.1)') ' relevantStrain: ',relevantStrain + write(6,'(a24,1x,es8.1)') ' defgradTolerance: ',defgradTolerance + write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness + write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum + write(6,'(a24,1x,es8.1)') ' pert_Fg: ',pert_Fg + write(6,'(a24,1x,i8)') ' pert_method: ',pert_method + write(6,'(a24,1x,i8)') ' nCryst: ',nCryst + write(6,'(a24,1x,es8.1)') ' subStepMinCryst: ',subStepMinCryst + write(6,'(a24,1x,es8.1)') ' subStepSizeCryst: ',subStepSizeCryst + write(6,'(a24,1x,es8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst + write(6,'(a24,1x,i8)') ' nState: ',nState + write(6,'(a24,1x,i8)') ' nStress: ',nStress + write(6,'(a24,1x,es8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState + write(6,'(a24,1x,es8.1)') ' rTol_crystalliteTemp: ',rTol_crystalliteTemperature + 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,L8,/)') ' analytic Jacobian: ',analyticJaco - write(6,'(a24,1x,i8)') ' nHomog: ',nHomog - write(6,'(a24,1x,e8.1)') ' subStepMinHomog: ',subStepMinHomog - write(6,'(a24,1x,e8.1)') ' subStepSizeHomog: ',subStepSizeHomog - write(6,'(a24,1x,e8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog - write(6,'(a24,1x,i8,/)') ' nMPstate: ',nMPstate + write(6,'(a24,1x,i8)') ' nHomog: ',nHomog + write(6,'(a24,1x,es8.1)') ' subStepMinHomog: ',subStepMinHomog + write(6,'(a24,1x,es8.1)') ' subStepSizeHomog: ',subStepSizeHomog + write(6,'(a24,1x,es8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog + write(6,'(a24,1x,i8,/)') ' nMPstate: ',nMPstate !* RGC parameters - write(6,'(a24,1x,e8.1)') ' aTol_RGC: ',absTol_RGC - write(6,'(a24,1x,e8.1)') ' rTol_RGC: ',relTol_RGC - write(6,'(a24,1x,e8.1)') ' aMax_RGC: ',absMax_RGC - write(6,'(a24,1x,e8.1)') ' rMax_RGC: ',relMax_RGC - write(6,'(a24,1x,e8.1)') ' perturbPenalty_RGC: ',pPert_RGC - write(6,'(a24,1x,e8.1)') ' relevantMismatch_RGC: ',xSmoo_RGC - write(6,'(a24,1x,e8.1)') ' viscosityrate_RGC: ',viscPower_RGC - write(6,'(a24,1x,e8.1)') ' viscositymodulus_RGC: ',viscModus_RGC - write(6,'(a24,1x,e8.1)') ' maxrelaxation_RGC: ',maxdRelax_RGC - write(6,'(a24,1x,e8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC - write(6,'(a24,1x,e8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC - write(6,'(a24,1x,e8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC + write(6,'(a24,1x,es8.1)') ' aTol_RGC: ',absTol_RGC + write(6,'(a24,1x,es8.1)') ' rTol_RGC: ',relTol_RGC + write(6,'(a24,1x,es8.1)') ' aMax_RGC: ',absMax_RGC + write(6,'(a24,1x,es8.1)') ' rMax_RGC: ',relMax_RGC + write(6,'(a24,1x,es8.1)') ' perturbPenalty_RGC: ',pPert_RGC + write(6,'(a24,1x,es8.1)') ' relevantMismatch_RGC: ',xSmoo_RGC + write(6,'(a24,1x,es8.1)') ' viscosityrate_RGC: ',viscPower_RGC + write(6,'(a24,1x,es8.1)') ' viscositymodulus_RGC: ',viscModus_RGC + write(6,'(a24,1x,es8.1)') ' maxrelaxation_RGC: ',maxdRelax_RGC + write(6,'(a24,1x,es8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC + write(6,'(a24,1x,es8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC + write(6,'(a24,1x,es8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC !* spectral parameters - write(6,'(a24,1x,e8.1)') ' err_div_tol: ',err_div_tol - write(6,'(a24,1x,e8.1)') ' err_stress_tolrel: ',err_stress_tolrel - write(6,'(a24,1x,i8)') ' itmax: ',itmax - write(6,'(a24,1x,i8)') ' itmin: ',itmin - write(6,'(a24,1x,L8)') ' memory_efficient: ',memory_efficient + write(6,'(a24,1x,es8.1)') ' err_div_tol: ',err_div_tol + write(6,'(a24,1x,es8.1)') ' err_stress_tolrel: ',err_stress_tolrel + write(6,'(a24,1x,i8)') ' itmax: ',itmax + write(6,'(a24,1x,i8)') ' itmin: ',itmin + write(6,'(a24,1x,L8)') ' memory_efficient: ',memory_efficient if(fftw_timelimit<0.0_pReal) then - write(6,'(a24,1x,L8)') ' fftw_timelimit: ',.false. + write(6,'(a24,1x,L8)') ' fftw_timelimit: ',.false. else - write(6,'(a24,1x,e8.1)') ' fftw_timelimit: ',fftw_timelimit + write(6,'(a24,1x,es8.1)') ' fftw_timelimit: ',fftw_timelimit endif - write(6,'(a24,1x,a)') ' fftw_plan_mode: ',trim(fftw_plan_mode) - write(6,'(a24,1x,i8)') ' fftw_planner_flag: ',fftw_planner_flag - write(6,'(a24,1x,e8.1)') ' rotation_tol: ',rotation_tol - write(6,'(a24,1x,L8,/)') ' divergence_correction: ',divergence_correction - write(6,'(a24,1x,L8,/)') ' update_gamma: ',update_gamma + write(6,'(a24,1x,a)') ' fftw_plan_mode: ',trim(fftw_plan_mode) + write(6,'(a24,1x,i8)') ' fftw_planner_flag: ',fftw_planner_flag + write(6,'(a24,1x,es8.1)') ' rotation_tol: ',rotation_tol + write(6,'(a24,1x,L8,/)') ' divergence_correction: ',divergence_correction + write(6,'(a24,1x,L8,/)') ' update_gamma: ',update_gamma !* Random seeding parameters - write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed + write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed !$OMP END CRITICAL (write2out)